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 [email protected] 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...)