Posted to tcl by auriocus at Wed Oct 08 19:32:51 GMT 2014view raw
- 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"
- }