''Here's from a news:comp.lang.tcl posting from Mark Harrison, a beautifully simple code generator: (RS)''
 
BTW, it's easy to set up a framework for classes and
abstract data types (just look at how many class systems
there are for Tcl).  Here' some skeleton code.  If they
are still going on about "design patterns" then I want
credit for the "recursively eval body" pattern. :-)

    proc class {namespace name body} {
        set methods [list]
        puts "namespace eval $namespace \{"

        # Easier to build the code and substitute in the name afterwards
        set dispatcher {    proc %N {{name ""} args} {
        variable _methodmap
        if {[info exist _methodmap($name)]} {
            return [uplevel 1 $_methodmap($name) $args]
        } elseif {[string length $name]} {
            variable _methods
            return -code error "bad option \"$name\": must be $_methods"
        } else {
            return -code error \
                    "wrong # args: should be \"%N option ?arg arg ...?\""
        }
    }}
        regsub -all %N $dispatcher [list $name] dispatcher
        puts $dispatcher
        puts {}
        eval $body
        puts {}
        set ml [linsert [join $methods ", "] end-1 "or"]
        puts "    [list variable _methods $ml]"
        puts {    variable _methodmap}
        set methodmap [list]
        foreach method $methods {
            lappend methodmap $method [list ${namespace}::_$method]
        }
        puts "    array set _methodmap [list $methodmap]"
        puts "\}"
    }
    proc variable {name} {
        puts "    variable $name ;# array indexed by name"
    }
    proc method {name arg body} {
        upvar 1 methods methods
        puts "    proc _$name {$arg} \{"
        puts "    $body"
        puts "    \}"
        lappend methods $name
    }

    # here's a test
    class struct stack {
        variable stacks
        method clear {} {}
        method peek {{count 1}} {}
        method pop {{count 1}} {}
        method push {arg1 args} {}
        method rotate {count steps} {}
        method size {} {}
    }
----
 Mark Harrison                     markh@usai.asiainfo.com
 AsiaInfo Computer Networks        http://www.markharrison.net
 Beijing / Santa Clara             http://usai.asiainfo.com:8080
----
'''DKF:''' Added a dispatcher including code to automagically generate the dispatcher's error messages.  The dispatcher is nowhere near robust enough about errors yet (rewriting the error trace is ''interesting'' to get right...)