### 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. }