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

  1. source macro.tcl
  2.  
  3. defmacro clear {cmd var} {
  4. return "set $var {}"
  5. }
  6.  
  7. defmacro first {cmd list} {
  8. return "lindex $list 0"
  9. }
  10.  
  11. defmacro K {cmd x y} {
  12. return "first \[list $x $y\]"
  13. }
  14.  
  15. defmacro yank {cmd var} {
  16. return "K \[set $var\] \[set $var {}\]"
  17. }
  18.  
  19. defmacro lremove {cmd var index} {
  20. # Danger: index is doubled
  21. return "set $var \[lreplace \[yank $var\] $index $index\]"
  22. }
  23. defmacro lremove2 {cmd var index} {
  24. return "set __tmp__ $index ; set $var \[lreplace \[yank $var\] \$__tmp__ \$__tmp__\]"
  25. }
  26.  
  27. defmacro {* + - /} {cmd args} {
  28. set cmd [namespace tail $cmd]
  29. return "expr [list [join $args " $cmd "]]"
  30. }
  31.  
  32. defmacro sete {cmd var exp} {
  33. return "set $var \[expr $exp\]"
  34. }
  35.  
  36. proc foobar {} {
  37. set x 0 ; set y 0; set a 0 ; set b 0 ; set c 0; set d 0; set e 0; set i 0
  38. set ll {1 2 3 4} ; set "_y x_" 0
  39. set x 10
  40. clear x
  41. first $x
  42. K $x $y
  43. K "x y" "y z"
  44. yank x
  45. yank "_y x_"
  46.  
  47. set ll [lreplace [yank ll] 3 3]
  48. lremove ll $i
  49. lremove2 ll $i
  50. set sum [+ $a $b [- $c $d] [llength $e]]
  51. sete sum {$a + $b + ($c - $d) + [llength $e]}
  52. }
  53.  
  54. puts "*** Compiling body ***"
  55. puts [dis proc foobar]
  56. puts "\n*** Execute body ***"
  57. foobar
  58.