Posted to tcl by auriocus at Wed Oct 08 19:32:51 GMT 2014view pretty
namespace eval ::auriocus { variable codestore {} proc macro {name margs rtargs mcode} { # breaks if one of the args is "args" # or has an odd name like spaces etc. # no fundamental problem, just laziness and quoting hell overflow set margnames [lmap m $margs {lindex $m 0}] set codegenproc ::auriocus::mc_$name proc $codegenproc $margnames $mcode set instrcode [string map \ [list %margs [list $margnames] %codegenproc $codegenproc %name $name] { set margval [lmap __v %margs {set $__v}] set arghash [list %name $margval] if {[dict exists $::auriocus::codestore $arghash]} { set expandedcode [dict get $::auriocus::codestore $arghash] } else { set expandedcode [%codegenproc {*}$margval] dict set ::auriocus::codestore $arghash $expandedcode } uplevel 1 $expandedcode } ] set combinedargs [list {*}$margs {*}$rtargs] uplevel 1 [list proc $name $combinedargs $instrcode] } } # demo if 0 { package require vectcl # simulate vexpr auriocus::macro myvexpr vcode {} { $::vectcl::compiler compile $vcode -novarrefs } } # from sugar introduction auriocus::macro clear {v} {} { list set $v {{}} } proc foobar {} { set x 10 puts "x is now $x" clear x puts "x is now $x" clear y puts "y is now $y" } # testing macro runtime parameters # auriocus::macro prefixset {var} {val} { return "set _pref_$var \$val" } proc testrtpar {} { prefixset x 20 puts "Set var: $_pref_x" }