'''memoize'''

A package that can be used to cache, load and save the values of expensive pure function calls.

'''HISTORY'''

[DDG] 2004-06-03: A fix to `memoize::save` for handling strings with spaces

[DDG] 2004-06-04: Adding `memoize::unload` to unset the `Memo` [array] or parts of it, instead of directly manipulating it via `array unset memoize::Memo` 

'''SEE ALSO'''

[memoizing], [Perl] Memoize Package [http://perl.plover.com/MiniMemoize/memoize.html] 


======
 ##############################################################################
 #  AUTHOR: Dr. Detlef Groth
 #  Copyright (c) Get it, use it, share it, improve it, but don't blame me.
 package provide memoize 0.1
 namespace eval ::memoize {
    variable Memo
 }

 proc ::memoize::memoize {} {
    variable Memo
    set cmd [info level -1]
    if {[info level] > 2 && [lindex [info level -2] 0] eq "memoize::memoize"} return
    if { ! [info exists Memo($cmd)]} {set Memo($cmd) [eval $cmd]}
    return -code return $Memo($cmd)
 }
 proc ::memoize::save {file {cmd ""}} {
    variable Memo
    set names [array names Memo -glob $cmd*]
    if [catch { set out [open $file w 0600] }] {
        error "Could not open $file!"
    } else {
        foreach name $names {
            puts $out "set {memoize::Memo($name)} {$Memo($name)}"
        }
    }
    close $out
 }

 proc ::memoize::load {file} {
    variable Memo
    if {[file readable $file]} {
        source $file
    }
 }
 proc ::memoize::unload {{cmd ""}} {
    variable Memo
    array unset Memo "$cmd*"
 }
 # testing actually longer than the code itself
 if {0} {
    # RS example    
    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 fib x {expr {$x <=1? 1 : [fib [expr {$x-1}]] + [fib [expr {$x-2}]]}}
    proc fibm x {memoize; expr {$x <=1? 1 : [fibm [expr {$x-1}]] + [fibm [expr {$x-2}]]}}
    proc fibmp x {memoize::memoize; expr {$x <=1? 1 : [fibm [expr {$x-1}]] + [fibm [expr {$x-2}]]}}
    
    fib 20 ;#= 10946
    fibm 20 ;#= 10946
    fibmp 20 ;#= 10946
    time {fib 32} ;#= 7757279 microseconds per iteration
    time {fib 32} ;#= 7763364 microseconds per iteration
    time {fib 32} ;#= 7927045 microseconds per iteration
    array unset memo
    time {fibm 32} ;#= 1365 microseconds per iteration
    time {fibm 32} ;#= 27 microseconds per iteration
    time {fibm 32} ;#= 28 microseconds per iteration
    memoize::unload
    time {fibmp 32} ;#= 97 microseconds per iteration
    time {fibmp 32} ;#= 29 microseconds per iteration
    time {fibmp 32} ;#= 28 microseconds per iteration
    memoize::save test.tmf
    memoize::unload
    memoize::load test.tmf
    time {fibmp 32} ;#= 33 microseconds per iteration
    time {fibmp 32} ;#= 29 microseconds per iteration
    time {fibmp 32} ;#= 28 microseconds per iteration
 }
======

----
[RHS] This seems like a very good candidate for [Tcllib].

[DDG] I did a feature request on the tcllib sourceforge site.
----
[SS]: This wonderful version of memoize just entered the [Jim] standard library.
The implementation uses [Jim Closures], so does not need to take state in a [global] var:

======
 proc memoize {} {{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)
 }
======

For the rest it seems identical.
I consider this a Tcl programming pearl, thanks [DDG].

<<categories>> Package | Caching