Posted to tcl by pooryorick at Thu Sep 11 01:05:55 GMT 2014view pretty

proc macro {name varnames cmd} {
    #make sure cmd is a valid list
    foreach paramname {varnames cmd} {
        if {![string is list [set $paramname]]} {
            error [list {variable not a valid list} $paramname] 
        }
    }
    while {[set newcmd cmd[incr i]] in $varnames} {}
    proc $name $varnames [string map [list @varnames@ [
        list $varnames] @cmd@ [list $cmd] @newcmd@ [list $newcmd]] {
        set @newcmd@ {}
        foreach word @cmd@ {
            foreach varname @varnames@ {
                if {$word eq $varname} {
                    lappend @newcmd@ [set $varname]
                } else {
                    lappend @newcmd@ $word
                }
            }
        }
        tailcall {*}[set @newcmd@]
    }]
}

macro double x {apply {y {
    expr {$y * 2}
}} x}

macro clear arg1 {unset arg1}

macro first list {lindex list 0}