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

  1. proc macro {name varnames cmd} {
  2. #make sure cmd is a valid list
  3. foreach paramname {varnames cmd} {
  4. if {![string is list [set $paramname]]} {
  5. error [list {variable not a valid list} $paramname]
  6. }
  7. }
  8. while {[set newcmd cmd[incr i]] in $varnames} {}
  9. proc $name $varnames [string map [list @varnames@ [
  10. list $varnames] @cmd@ [list $cmd] @newcmd@ [list $newcmd]] {
  11. set @newcmd@ {}
  12. foreach word @cmd@ {
  13. foreach varname @varnames@ {
  14. if {$word eq $varname} {
  15. lappend @newcmd@ [set $varname]
  16. } else {
  17. lappend @newcmd@ $word
  18. }
  19. }
  20. }
  21. tailcall {*}[set @newcmd@]
  22. }]
  23. }
  24.  
  25. macro double x {apply {y {
  26. expr {$y * 2}
  27. }} x}
  28.  
  29. macro clear arg1 {unset arg1}
  30.  
  31. macro first list {lindex list 0}
  32.