Posted to tcl by aspect at Wed Oct 08 10:21:59 GMT 2014view pretty

source macro.tcl

defmacro clear {cmd var} {
    return "set $var {}"
}

defmacro first {cmd list} {
    return "lindex $list 0"
}

defmacro K {cmd x y} {
    return "first \[list $x $y\]"
}

defmacro yank {cmd var} {
    return "K \[set $var\] \[set $var {}\]"
}

defmacro lremove {cmd var index} {
    # Danger: index is doubled
    return "set $var \[lreplace \[yank $var\] $index $index\]"
}
defmacro lremove2 {cmd var index} {
    return "set __tmp__ $index ; set $var \[lreplace \[yank $var\] \$__tmp__ \$__tmp__\]"
}

defmacro {* + - /} {cmd args} {
    set cmd [namespace tail $cmd]
    return "expr [list [join $args " $cmd "]]"
}

defmacro sete {cmd var exp} {
    return "set $var \[expr $exp\]"
}

proc foobar {} {
    set x 0 ; set y 0; set a 0 ; set b 0 ; set c 0; set d 0; set e 0; set i 0
    set ll {1 2 3 4} ; set "_y x_" 0
    set x 10
    clear x
    first $x
    K $x $y
    K "x y" "y z"
    yank x
    yank "_y x_"

    set ll [lreplace [yank ll] 3 3]
    lremove ll $i
    lremove2 ll $i
    set sum [+ $a $b [- $c $d] [llength $e]]
    sete sum {$a + $b + ($c - $d) + [llength $e]}
}

puts "*** Compiling body ***"
puts [dis proc foobar]
puts "\n*** Execute body ***"
foobar