various implementations of fibonacci in tcl

# Recursive functions are a bad thing if there is a lot of recursion
# to be done. Tail recursion is the way to speed up recursion and can
# sometimes express things more simply than iterative approaches while
# still being as fast as iteration.
# 
# For instance the following 3 versions of the fibonacci function use
# iterative, recursive or tail-recursive approaches. Lets see:
#
# C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -estimate 100
# 354224848179263111168 32.6
# 
# C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -iterative 100
# 354224848179261915075 153.0
# 
# C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -tailcall 100
# 354224848179261915075 550.0
# 
# C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -memoized 100
# 354224848179261915075 955.2
# 
# NOTE that I didn't dare to try -rec 100 as it is too slow and will run out
#      of stack for n=100.

# Tail-recursive
proc fibT {n} {
    proc fib' {a b n} {
        if {$n < 1} {
            return $a
        } elseif {$n == 1} {
            return $b
        } else {
            tailcall fib' $b [expr {$a + $b}] [expr {$n - 1}]
        }
    }
    return [fib' 0 1 $n]
}

# Fully recursive
proc fibR {n} {
    if {$n < 3} then {
        expr 1
    } else {
        expr {[fibR [expr {$n-1}]]+[fibR [expr {$n-2}]]}
    }
}

# Iterative
proc fibI n {
    if {$n < 2} {return $n}
    set prev 1
    set fib 1
    for {set i 2} {$i < $n} {incr i} {
        lassign [list $fib [incr fib $prev]] prev fib
    }
    return $fib
}

# Estimated version - good up to about 70
proc fibE {n} {expr {round((.5 + .5*sqrt(5)) ** $n / sqrt(5))}}

# Memoized - ie: cache the calculated numbers
# RS version...
proc memoize {} {
    global memo
    set cmd [info level -1]
    if {[info level] > 2 && [lindex [info level -2] 0] eq "memoize"} return
    if { ! [info exists memo($cmd)]} {set memo($cmd) [eval $cmd]}
    return -code return $memo($cmd)
}
proc fibM {n} {
    memoize
    expr {$n < 3 ? 1 : [fibM [expr {$n - 1}]] + [fibM [expr {$n - 2}]]}
}

# Now NEM's version ...
proc xmemoize f {
    variable $f [dict create]
    rename $f _cache_$f
    interp alias {} $f {} xremember $f
}
proc xremember {f args} {
    upvar #0 $f cache
    if {![dict exists $cache $args]} {
        dict set cache $args [uplevel 1 [linsert $args 0 _cache_$f]]
    }
    dict get $cache $args
}
proc func {name params body} { proc $name $params [list expr $body] }
func fibN n {
    $n < 2 ? $n
           : [fibN [expr {$n-1}]] +
             [fibN [expr {$n-2}]]
}
xmemoize fibN


if {!$tcl_interactive} {
    set cmd fibT
    if {[llength $argv] > 1} {
        switch -glob -- [lindex $argv 0] {
            "-t*" { set cmd fibT }
            "-i*" { set cmd fibI }
            "-r*" { set cmd fibR }
            "-e*" { set cmd fibE }
            "-m*" { set cmd fibM }
            "-n*" { set cmd fibN }
            default {
                puts "usage: fib ?-tail-recursive? ?-estimated?\
                   ?-iterative? ?-recursive? ?-memoized? number"
            }
        }
        set argv [lrange $argv 1 end]
    }
    set t [time {set r [catch [linsert $argv 0 $cmd] err]} 5]
    if {$r} {puts $errorInfo} else {puts "$err [lindex $t 0]"}
    exit $r
}