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"
}