Posted to tcl by kbk at Fri Jun 12 20:53:06 GMT 2009view raw
- namespace path ::tcl::mathop
- proc TRACE {} {
- puts [format %*s%s [info level] {} [info level [- [info level] 1]]]
- }
- proc TRACE args {}
- proc fib {n {c {{x} {set x}}}} { # apply c to nth element of fibonacci seq
- TRACE
- if {$n < 2} {
- tailcall apply $c $n
- } else {
- tailcall fib1 $n $c
- }
- }
- proc fib1 {n c} { # apply c to nth element of fibonacci sequence (n >= 2)
- TRACE
- tailcall -c $n 1 [list [list nm1 [list n $n] [list c $c]] {
- tailcall fib2 $nm1 $n $c
- }]
- }
- proc fib2 {nm1 n c} { # apply c to nth element of fibonacci sequence
- # n-1 has been completed and placed in $nm1
- TRACE
- tailcall -c $n 2 [list [list nm2 [list nm1 $nm1] [list c $c]] {
- tailcall fib3 $nm1 $nm2 $c
- }]
- }
- proc fib3 {nm1 nm2 c} { # apply c to nth element of Fibonacci sequence.
- # n-1 and n-2 have been computed and placed in nm1
- # and nm2
- TRACE
- tailcall fib $nm1 [list [list fibnm1 [list nm2 $nm2] [list c $c]] {
- tailcall fib4 $fibnm1 $nm2 $c
- }]
- }
- proc fib4 {fibnm1 nm2 c} { # apply c to nth element of Fibonacci sequence.
- # (n-1)st element is known.
- TRACE
- tailcall fib $nm2 [list [list fibnm2 [list fibnm1 $fibnm1] [list c $c]] {
- tailcall +c $fibnm1 $fibnm2 $c
- }]
- }
- proc +c {x y c} { # apply c to the sum of x and y
- TRACE
- tailcall apply $c [+ $x $y]
- }
- proc -c {x y c} { # apply c to the difference of x and y
- TRACE
- tailcall apply $c [- $x $y]
- }
- puts [fib 5]