'''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