Posted to tcl by kbk at Fri Jun 12 21:26:28 GMT 2009view raw

  1. # In this perverse implementation of the Fibonacci sequence, every function
  2. # call is either a tailcall or an invocation of [list] to construct a closure.
  3. # There is no direct recursion, instead, control is handled in continuation
  4. # passing style. Note the strange use of [lindexc] to implement a conditional.
  5.  
  6. namespace path ::tcl::mathop
  7.  
  8. proc TRACE {} {
  9. puts [format %*s%s [info level] {} [info level [- [info level] 1]]]
  10. }
  11. proc TRACE args {}
  12.  
  13. proc fib {n {c {{x} {set x}}}} { # apply c to nth element of fibonacci seq
  14. TRACE
  15. tailcall <c $n 2 [list [list nlt2 [list n $n] [list c $c]] {
  16. fib0 $nlt2 $n $c
  17. }]
  18. }
  19.  
  20. proc fib0 {nlt2 n c} { # apply c to nth element of fibonacci seq, nlt2 is (n < 2)
  21. TRACE
  22. tailcall lindexc {fib1 apply} $nlt2 [list [list f [list n $n] [list c $c]] {
  23. tailcall $f $c $n
  24. }]
  25. }
  26.  
  27. proc fib1 {c n} { # apply c to nth element of fibonacci sequence (n >= 2)
  28. TRACE
  29. tailcall -c $n 1 [list [list nm1 [list n $n] [list c $c]] {
  30. tailcall fib2 $nm1 $n $c
  31. }]
  32. }
  33.  
  34. proc fib2 {nm1 n c} { # apply c to nth element of fibonacci sequence
  35. # n-1 has been completed and placed in $nm1
  36. TRACE
  37. tailcall -c $n 2 [list [list nm2 [list nm1 $nm1] [list c $c]] {
  38. tailcall fib3 $nm1 $nm2 $c
  39. }]
  40. }
  41.  
  42. proc fib3 {nm1 nm2 c} { # apply c to nth element of Fibonacci sequence.
  43. # n-1 and n-2 have been computed and placed in nm1
  44. # and nm2
  45. TRACE
  46. tailcall fib $nm1 [list [list fibnm1 [list nm2 $nm2] [list c $c]] {
  47. tailcall fib4 $fibnm1 $nm2 $c
  48. }]
  49. }
  50.  
  51. proc fib4 {fibnm1 nm2 c} { # apply c to nth element of Fibonacci sequence.
  52. # (n-1)st element is known.
  53. TRACE
  54. tailcall fib $nm2 [list [list fibnm2 [list fibnm1 $fibnm1] [list c $c]] {
  55. tailcall +c $fibnm1 $fibnm2 $c
  56. }]
  57. }
  58.  
  59. proc lindexc {lst idx c} { # apply c to [lindex $lst $idx]
  60. TRACE
  61. tailcall apply $c [lindex $lst $idx]
  62. }
  63.  
  64. proc <c {x y c} { # apply c to the result of x<y
  65. TRACE
  66. tailcall apply $c [< $x $y]
  67. }
  68.  
  69. proc +c {x y c} { # apply c to the sum of x and y
  70. TRACE
  71. tailcall apply $c [+ $x $y]
  72. }
  73.  
  74. proc -c {x y c} { # apply c to the difference of x and y
  75. TRACE
  76. tailcall apply $c [- $x $y]
  77. }
  78.  
  79. for {set i 0} {$i <= 10} {incr i} {
  80. puts [fib $i]
  81. }