Posted to tcl by kbk at Fri Jun 12 20:53:06 GMT 2009view raw

  1. namespace path ::tcl::mathop
  2.  
  3. proc TRACE {} {
  4. puts [format %*s%s [info level] {} [info level [- [info level] 1]]]
  5. }
  6. proc TRACE args {}
  7.  
  8. proc fib {n {c {{x} {set x}}}} { # apply c to nth element of fibonacci seq
  9. TRACE
  10. if {$n < 2} {
  11. tailcall apply $c $n
  12. } else {
  13. tailcall fib1 $n $c
  14. }
  15. }
  16.  
  17. proc fib1 {n c} { # apply c to nth element of fibonacci sequence (n >= 2)
  18. TRACE
  19. tailcall -c $n 1 [list [list nm1 [list n $n] [list c $c]] {
  20. tailcall fib2 $nm1 $n $c
  21. }]
  22. }
  23.  
  24. proc fib2 {nm1 n c} { # apply c to nth element of fibonacci sequence
  25. # n-1 has been completed and placed in $nm1
  26. TRACE
  27. tailcall -c $n 2 [list [list nm2 [list nm1 $nm1] [list c $c]] {
  28. tailcall fib3 $nm1 $nm2 $c
  29. }]
  30. }
  31.  
  32. proc fib3 {nm1 nm2 c} { # apply c to nth element of Fibonacci sequence.
  33. # n-1 and n-2 have been computed and placed in nm1
  34. # and nm2
  35. TRACE
  36. tailcall fib $nm1 [list [list fibnm1 [list nm2 $nm2] [list c $c]] {
  37. tailcall fib4 $fibnm1 $nm2 $c
  38. }]
  39. }
  40.  
  41. proc fib4 {fibnm1 nm2 c} { # apply c to nth element of Fibonacci sequence.
  42. # (n-1)st element is known.
  43. TRACE
  44. tailcall fib $nm2 [list [list fibnm2 [list fibnm1 $fibnm1] [list c $c]] {
  45. tailcall +c $fibnm1 $fibnm2 $c
  46. }]
  47. }
  48.  
  49. proc +c {x y c} { # apply c to the sum of x and y
  50. TRACE
  51. tailcall apply $c [+ $x $y]
  52. }
  53.  
  54. proc -c {x y c} { # apply c to the difference of x and y
  55. TRACE
  56. tailcall apply $c [- $x $y]
  57. }
  58.  
  59. puts [fib 5]