| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Memoize.pm |
| Statements | Executed 18485 statements in 40.4ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1532 | 1 | 1 | 33.2ms | 49.3ms | Memoize::_memoizer |
| 1 | 1 | 1 | 116µs | 204µs | Memoize::memoize |
| 1 | 1 | 1 | 13µs | 65µs | Memoize::BEGIN@25 |
| 1 | 1 | 1 | 13µs | 14µs | Memoize::_make_cref |
| 1 | 1 | 1 | 10µs | 23µs | Memoize::BEGIN@28 |
| 1 | 1 | 1 | 8µs | 25µs | Memoize::BEGIN@26 |
| 1 | 1 | 1 | 8µs | 49µs | Memoize::BEGIN@27 |
| 1 | 1 | 1 | 8µs | 12µs | Memoize::BEGIN@95 |
| 2 | 1 | 1 | 7µs | 7µs | Memoize::_my_tie |
| 1 | 1 | 1 | 7µs | 9µs | Memoize::BEGIN@225 |
| 1 | 1 | 1 | 7µs | 9µs | Memoize::BEGIN@284 |
| 1 | 1 | 1 | 7µs | 9µs | Memoize::BEGIN@32 |
| 1 | 1 | 1 | 6µs | 8µs | Memoize::BEGIN@321 |
| 2 | 2 | 1 | 2µs | 2µs | Memoize::CORE:match (opcode) |
| 0 | 0 | 0 | 0s | 0s | Memoize::_crap_out |
| 0 | 0 | 0 | 0s | 0s | Memoize::flush_cache |
| 0 | 0 | 0 | 0s | 0s | Memoize::unmemoize |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # -*- mode: perl; perl-indent-level: 2; -*- | ||||
| 2 | # Memoize.pm | ||||
| 3 | # | ||||
| 4 | # Transparent memoization of idempotent functions | ||||
| 5 | # | ||||
| 6 | # Copyright 1998, 1999, 2000, 2001, 2012 M. J. Dominus. | ||||
| 7 | # You may copy and distribute this program under the | ||||
| 8 | # same terms as Perl itself. If in doubt, | ||||
| 9 | # write to mjd-perl-memoize+@plover.com for a license. | ||||
| 10 | |||||
| 11 | package Memoize; | ||||
| 12 | 1 | 700ns | $VERSION = '1.03'; | ||
| 13 | |||||
| 14 | # Compile-time constants | ||||
| 15 | sub SCALAR () { 0 } | ||||
| 16 | sub LIST () { 1 } | ||||
| 17 | |||||
| 18 | |||||
| 19 | # | ||||
| 20 | # Usage memoize(functionname/ref, | ||||
| 21 | # { NORMALIZER => coderef, INSTALL => name, | ||||
| 22 | # LIST_CACHE => descriptor, SCALAR_CACHE => descriptor } | ||||
| 23 | # | ||||
| 24 | |||||
| 25 | 3 | 20µs | 2 | 116µs | # spent 65µs (13+51) within Memoize::BEGIN@25 which was called:
# once (13µs+51µs) by Tapper::Model::BEGIN@24 at line 25 # spent 65µs making 1 call to Memoize::BEGIN@25
# spent 51µs making 1 call to Exporter::import |
| 26 | 3 | 21µs | 2 | 41µs | # spent 25µs (8+16) within Memoize::BEGIN@26 which was called:
# once (8µs+16µs) by Tapper::Model::BEGIN@24 at line 26 # spent 25µs making 1 call to Memoize::BEGIN@26
# spent 16µs making 1 call to Exporter::import |
| 27 | 3 | 18µs | 2 | 90µs | # spent 49µs (8+41) within Memoize::BEGIN@27 which was called:
# once (8µs+41µs) by Tapper::Model::BEGIN@24 at line 27 # spent 49µs making 1 call to Memoize::BEGIN@27
# spent 41µs making 1 call to vars::import |
| 28 | 3 | 43µs | 2 | 36µs | # spent 23µs (10+13) within Memoize::BEGIN@28 which was called:
# once (10µs+13µs) by Tapper::Model::BEGIN@24 at line 28 # spent 23µs making 1 call to Memoize::BEGIN@28
# spent 13µs making 1 call to Config::import |
| 29 | 1 | 10µs | @ISA = qw(Exporter); | ||
| 30 | 1 | 500ns | @EXPORT = qw(memoize); | ||
| 31 | 1 | 600ns | @EXPORT_OK = qw(unmemoize flush_cache); | ||
| 32 | 3 | 231µs | 2 | 11µs | # spent 9µs (7+2) within Memoize::BEGIN@32 which was called:
# once (7µs+2µs) by Tapper::Model::BEGIN@24 at line 32 # spent 9µs making 1 call to Memoize::BEGIN@32
# spent 2µs making 1 call to strict::import |
| 33 | |||||
| 34 | 1 | 300ns | my %memotable; | ||
| 35 | 1 | 100ns | my %revmemotable; | ||
| 36 | 1 | 1µs | my @CONTEXT_TAGS = qw(MERGE TIE MEMORY FAULT HASH); | ||
| 37 | 1 | 7µs | my %IS_CACHE_TAG = map {($_ => 1)} @CONTEXT_TAGS; | ||
| 38 | |||||
| 39 | # Raise an error if the user tries to specify one of thesepackage as a | ||||
| 40 | # tie for LIST_CACHE | ||||
| 41 | |||||
| 42 | 1 | 5µs | my %scalar_only = map {($_ => 1)} qw(DB_File GDBM_File SDBM_File ODBM_File NDBM_File); | ||
| 43 | |||||
| 44 | # spent 204µs (116+89) within Memoize::memoize which was called:
# once (116µs+89µs) by Tapper::MCP::Scheduler::Controller::BEGIN@8 at line 31 of Tapper/Model.pm | ||||
| 45 | 1 | 600ns | my $fn = shift; | ||
| 46 | 1 | 1µs | my %options = @_; | ||
| 47 | 1 | 900ns | my $options = \%options; | ||
| 48 | |||||
| 49 | 1 | 1µs | unless (defined($fn) && | ||
| 50 | (ref $fn eq 'CODE' || ref $fn eq '')) { | ||||
| 51 | croak "Usage: memoize 'functionname'|coderef {OPTIONS}"; | ||||
| 52 | } | ||||
| 53 | |||||
| 54 | 1 | 600ns | my $uppack = caller; # TCL me Elmo! | ||
| 55 | 1 | 200ns | my $cref; # Code reference to original function | ||
| 56 | 1 | 900ns | my $name = (ref $fn ? undef : $fn); | ||
| 57 | |||||
| 58 | # Convert function names to code references | ||||
| 59 | 1 | 2µs | 1 | 14µs | $cref = &_make_cref($fn, $uppack); # spent 14µs making 1 call to Memoize::_make_cref |
| 60 | |||||
| 61 | # Locate function prototype, if any | ||||
| 62 | 1 | 700ns | my $proto = prototype $cref; | ||
| 63 | 1 | 600ns | if (defined $proto) { $proto = "($proto)" } | ||
| 64 | 1 | 500ns | else { $proto = "" } | ||
| 65 | |||||
| 66 | # I would like to get rid of the eval, but there seems not to be any | ||||
| 67 | # other way to set the prototype properly. The switch here for | ||||
| 68 | # 'usethreads' works around a bug in threadperl having to do with | ||||
| 69 | # magic goto. It would be better to fix the bug and use the magic | ||||
| 70 | # goto version everywhere. | ||||
| 71 | 1 | 51µs | 1 | 67µs | my $wrapper = # spent 67µs making 1 call to Config::FETCH # spent 18.2ms executing statements in string eval # includes 13.4ms spent executing 1532 calls to 1 sub defined therein. |
| 72 | $Config{usethreads} | ||||
| 73 | ? eval "sub $proto { &_memoizer(\$cref, \@_); }" | ||||
| 74 | : eval "sub $proto { unshift \@_, \$cref; goto &_memoizer; }"; | ||||
| 75 | |||||
| 76 | 1 | 700ns | my $normalizer = $options{NORMALIZER}; | ||
| 77 | 1 | 500ns | if (defined $normalizer && ! ref $normalizer) { | ||
| 78 | $normalizer = _make_cref($normalizer, $uppack); | ||||
| 79 | } | ||||
| 80 | |||||
| 81 | 1 | 300ns | my $install_name; | ||
| 82 | 1 | 1µs | if (defined $options->{INSTALL}) { | ||
| 83 | # INSTALL => name | ||||
| 84 | $install_name = $options->{INSTALL}; | ||||
| 85 | } elsif (! exists $options->{INSTALL}) { | ||||
| 86 | # No INSTALL option provided; use original name if possible | ||||
| 87 | $install_name = $name; | ||||
| 88 | } else { | ||||
| 89 | # INSTALL => undef means don't install | ||||
| 90 | } | ||||
| 91 | |||||
| 92 | 1 | 600ns | if (defined $install_name) { | ||
| 93 | 1 | 5µs | 1 | 700ns | $install_name = $uppack . '::' . $install_name # spent 700ns making 1 call to Memoize::CORE:match |
| 94 | unless $install_name =~ /::/; | ||||
| 95 | 3 | 540µs | 2 | 16µs | # spent 12µs (8+4) within Memoize::BEGIN@95 which was called:
# once (8µs+4µs) by Tapper::Model::BEGIN@24 at line 95 # spent 12µs making 1 call to Memoize::BEGIN@95
# spent 4µs making 1 call to strict::unimport |
| 96 | 1 | 3µs | local($^W) = 0; # ``Subroutine $install_name redefined at ...'' | ||
| 97 | 1 | 2µs | *{$install_name} = $wrapper; # Install memoized version | ||
| 98 | } | ||||
| 99 | |||||
| 100 | 1 | 3µs | $revmemotable{$wrapper} = "" . $cref; # Turn code ref into hash key | ||
| 101 | |||||
| 102 | # These will be the caches | ||||
| 103 | 1 | 500ns | my %caches; | ||
| 104 | 1 | 1µs | for my $context (qw(SCALAR LIST)) { | ||
| 105 | # suppress subsequent 'uninitialized value' warnings | ||||
| 106 | 2 | 3µs | $options{"${context}_CACHE"} ||= ''; | ||
| 107 | |||||
| 108 | 2 | 1µs | my $cache_opt = $options{"${context}_CACHE"}; | ||
| 109 | 2 | 600ns | my @cache_opt_args; | ||
| 110 | 2 | 500ns | if (ref $cache_opt) { | ||
| 111 | @cache_opt_args = @$cache_opt; | ||||
| 112 | $cache_opt = shift @cache_opt_args; | ||||
| 113 | } | ||||
| 114 | 2 | 5µs | if ($cache_opt eq 'FAULT') { # no cache | ||
| 115 | $caches{$context} = undef; | ||||
| 116 | } elsif ($cache_opt eq 'HASH') { # user-supplied hash | ||||
| 117 | my $cache = $cache_opt_args[0]; | ||||
| 118 | my $package = ref(tied %$cache); | ||||
| 119 | if ($context eq 'LIST' && $scalar_only{$package}) { | ||||
| 120 | croak("You can't use $package for LIST_CACHE because it can only store scalars"); | ||||
| 121 | } | ||||
| 122 | $caches{$context} = $cache; | ||||
| 123 | } elsif ($cache_opt eq '' || $IS_CACHE_TAG{$cache_opt}) { | ||||
| 124 | # default is that we make up an in-memory hash | ||||
| 125 | $caches{$context} = {}; | ||||
| 126 | # (this might get tied later, or MERGEd away) | ||||
| 127 | } else { | ||||
| 128 | croak "Unrecognized option to `${context}_CACHE': `$cache_opt' should be one of (@CONTEXT_TAGS); aborting"; | ||||
| 129 | } | ||||
| 130 | } | ||||
| 131 | |||||
| 132 | # Perhaps I should check here that you didn't supply *both* merge | ||||
| 133 | # options. But if you did, it does do something reasonable: They | ||||
| 134 | # both get merged to the same in-memory hash. | ||||
| 135 | 1 | 1µs | if ($options{SCALAR_CACHE} eq 'MERGE' || $options{LIST_CACHE} eq 'MERGE') { | ||
| 136 | $options{MERGED} = 1; | ||||
| 137 | $caches{SCALAR} = $caches{LIST}; | ||||
| 138 | } | ||||
| 139 | |||||
| 140 | # Now deal with the TIE options | ||||
| 141 | { | ||||
| 142 | 2 | 900ns | my $context; | ||
| 143 | 1 | 900ns | foreach $context (qw(SCALAR LIST)) { | ||
| 144 | # If the relevant option wasn't `TIE', this call does nothing. | ||||
| 145 | 2 | 4µs | 2 | 7µs | _my_tie($context, $caches{$context}, $options); # Croaks on failure # spent 7µs making 2 calls to Memoize::_my_tie, avg 4µs/call |
| 146 | } | ||||
| 147 | } | ||||
| 148 | |||||
| 149 | # We should put some more stuff in here eventually. | ||||
| 150 | # We've been saying that for serveral versions now. | ||||
| 151 | # And you know what? More stuff keeps going in! | ||||
| 152 | 1 | 5µs | $memotable{$cref} = | ||
| 153 | { | ||||
| 154 | O => $options, # Short keys here for things we need to access frequently | ||||
| 155 | N => $normalizer, | ||||
| 156 | U => $cref, | ||||
| 157 | MEMOIZED => $wrapper, | ||||
| 158 | PACKAGE => $uppack, | ||||
| 159 | NAME => $install_name, | ||||
| 160 | S => $caches{SCALAR}, | ||||
| 161 | L => $caches{LIST}, | ||||
| 162 | }; | ||||
| 163 | |||||
| 164 | 1 | 4µs | $wrapper # Return just memoized version | ||
| 165 | } | ||||
| 166 | |||||
| 167 | # This function tries to load a tied hash class and tie the hash to it. | ||||
| 168 | # spent 7µs within Memoize::_my_tie which was called 2 times, avg 4µs/call:
# 2 times (7µs+0s) by Memoize::memoize at line 145, avg 4µs/call | ||||
| 169 | 2 | 2µs | my ($context, $hash, $options) = @_; | ||
| 170 | 2 | 2µs | my $fullopt = $options->{"${context}_CACHE"}; | ||
| 171 | |||||
| 172 | # We already checked to make sure that this works. | ||||
| 173 | 2 | 800ns | my $shortopt = (ref $fullopt) ? $fullopt->[0] : $fullopt; | ||
| 174 | |||||
| 175 | 2 | 5µs | return unless defined $shortopt && $shortopt eq 'TIE'; | ||
| 176 | carp("TIE option to memoize() is deprecated; use HASH instead") | ||||
| 177 | if $^W; | ||||
| 178 | |||||
| 179 | my @args = ref $fullopt ? @$fullopt : (); | ||||
| 180 | shift @args; | ||||
| 181 | my $module = shift @args; | ||||
| 182 | if ($context eq 'LIST' && $scalar_only{$module}) { | ||||
| 183 | croak("You can't use $module for LIST_CACHE because it can only store scalars"); | ||||
| 184 | } | ||||
| 185 | my $modulefile = $module . '.pm'; | ||||
| 186 | $modulefile =~ s{::}{/}g; | ||||
| 187 | eval { require $modulefile }; | ||||
| 188 | if ($@) { | ||||
| 189 | croak "Memoize: Couldn't load hash tie module `$module': $@; aborting"; | ||||
| 190 | } | ||||
| 191 | my $rc = (tie %$hash => $module, @args); | ||||
| 192 | unless ($rc) { | ||||
| 193 | croak "Memoize: Couldn't tie hash to `$module': $!; aborting"; | ||||
| 194 | } | ||||
| 195 | 1; | ||||
| 196 | } | ||||
| 197 | |||||
| 198 | sub flush_cache { | ||||
| 199 | my $func = _make_cref($_[0], scalar caller); | ||||
| 200 | my $info = $memotable{$revmemotable{$func}}; | ||||
| 201 | die "$func not memoized" unless defined $info; | ||||
| 202 | for my $context (qw(S L)) { | ||||
| 203 | my $cache = $info->{$context}; | ||||
| 204 | if (tied %$cache && ! (tied %$cache)->can('CLEAR')) { | ||||
| 205 | my $funcname = defined($info->{NAME}) ? | ||||
| 206 | "function $info->{NAME}" : "anonymous function $func"; | ||||
| 207 | my $context = {S => 'scalar', L => 'list'}->{$context}; | ||||
| 208 | croak "Tied cache hash for $context-context $funcname does not support flushing"; | ||||
| 209 | } else { | ||||
| 210 | %$cache = (); | ||||
| 211 | } | ||||
| 212 | } | ||||
| 213 | } | ||||
| 214 | |||||
| 215 | # This is the function that manages the memo tables. | ||||
| 216 | # spent 49.3ms (33.2+16.0) within Memoize::_memoizer which was called 1532 times, avg 32µs/call:
# 1532 times (33.2ms+16.0ms) by Tapper::MCP::Scheduler::Algorithm::__ANON__[lib/Tapper/MCP/Scheduler/Algorithm.pm:12] or Tapper::MCP::Scheduler::Controller::get_next_job or Tapper::MCP::Scheduler::Controller::mark_job_as_running or Tapper::MCP::Scheduler::PrioQueue::get_testrequests or Tapper::Model::free_hosts_with_features or Tapper::Model::get_hardware_overview or main::RUNTIME or main::toggle_host_free at line 1 of (eval 256)[Memoize.pm:71], avg 32µs/call | ||||
| 217 | 1532 | 1.57ms | my $orig = shift; # stringized version of ref to original func. | ||
| 218 | 1532 | 3.99ms | my $info = $memotable{$orig}; | ||
| 219 | 1532 | 2.15ms | my $normalizer = $info->{N}; | ||
| 220 | |||||
| 221 | 1532 | 642µs | my $argstr; | ||
| 222 | 1532 | 1.32ms | my $context = (wantarray() ? LIST : SCALAR); | ||
| 223 | |||||
| 224 | 1532 | 1.73ms | if (defined $normalizer) { | ||
| 225 | 3 | 265µs | 2 | 11µs | # spent 9µs (7+2) within Memoize::BEGIN@225 which was called:
# once (7µs+2µs) by Tapper::Model::BEGIN@24 at line 225 # spent 9µs making 1 call to Memoize::BEGIN@225
# spent 2µs making 1 call to strict::unimport |
| 226 | if ($context == SCALAR) { | ||||
| 227 | $argstr = &{$normalizer}(@_); | ||||
| 228 | } elsif ($context == LIST) { | ||||
| 229 | ($argstr) = &{$normalizer}(@_); | ||||
| 230 | } else { | ||||
| 231 | croak "Internal error \#41; context was neither LIST nor SCALAR\n"; | ||||
| 232 | } | ||||
| 233 | } else { # Default normalizer | ||||
| 234 | 1532 | 5.56ms | local $^W = 0; | ||
| 235 | 1532 | 3.97ms | $argstr = join chr(28),@_; | ||
| 236 | } | ||||
| 237 | |||||
| 238 | 1532 | 1.36ms | if ($context == SCALAR) { | ||
| 239 | 1532 | 1.66ms | my $cache = $info->{S}; | ||
| 240 | 1532 | 683µs | _crap_out($info->{NAME}, 'scalar') unless $cache; | ||
| 241 | 1532 | 14.0ms | if (exists $cache->{$argstr}) { | ||
| 242 | return $info->{O}{MERGED} | ||||
| 243 | ? $cache->{$argstr}[0] : $cache->{$argstr}; | ||||
| 244 | } else { | ||||
| 245 | 1 | 6µs | 1 | 16.0ms | my $val = &{$info->{U}}(@_); # spent 16.0ms making 1 call to Tapper::Model::model |
| 246 | # Scalars are considered to be lists; store appropriately | ||||
| 247 | 1 | 3µs | if ($info->{O}{MERGED}) { | ||
| 248 | $cache->{$argstr} = [$val]; | ||||
| 249 | } else { | ||||
| 250 | 1 | 2µs | $cache->{$argstr} = $val; | ||
| 251 | } | ||||
| 252 | 1 | 500ns | $val; | ||
| 253 | } | ||||
| 254 | } elsif ($context == LIST) { | ||||
| 255 | my $cache = $info->{L}; | ||||
| 256 | _crap_out($info->{NAME}, 'list') unless $cache; | ||||
| 257 | if (exists $cache->{$argstr}) { | ||||
| 258 | return @{$cache->{$argstr}}; | ||||
| 259 | } else { | ||||
| 260 | my @q = &{$info->{U}}(@_); | ||||
| 261 | $cache->{$argstr} = \@q; | ||||
| 262 | @q; | ||||
| 263 | } | ||||
| 264 | } else { | ||||
| 265 | croak "Internal error \#42; context was neither LIST nor SCALAR\n"; | ||||
| 266 | } | ||||
| 267 | } | ||||
| 268 | |||||
| 269 | sub unmemoize { | ||||
| 270 | my $f = shift; | ||||
| 271 | my $uppack = caller; | ||||
| 272 | my $cref = _make_cref($f, $uppack); | ||||
| 273 | |||||
| 274 | unless (exists $revmemotable{$cref}) { | ||||
| 275 | croak "Could not unmemoize function `$f', because it was not memoized to begin with"; | ||||
| 276 | } | ||||
| 277 | |||||
| 278 | my $tabent = $memotable{$revmemotable{$cref}}; | ||||
| 279 | unless (defined $tabent) { | ||||
| 280 | croak "Could not figure out how to unmemoize function `$f'"; | ||||
| 281 | } | ||||
| 282 | my $name = $tabent->{NAME}; | ||||
| 283 | if (defined $name) { | ||||
| 284 | 3 | 96µs | 2 | 11µs | # spent 9µs (7+2) within Memoize::BEGIN@284 which was called:
# once (7µs+2µs) by Tapper::Model::BEGIN@24 at line 284 # spent 9µs making 1 call to Memoize::BEGIN@284
# spent 2µs making 1 call to strict::unimport |
| 285 | local($^W) = 0; # ``Subroutine $install_name redefined at ...'' | ||||
| 286 | *{$name} = $tabent->{U}; # Replace with original function | ||||
| 287 | } | ||||
| 288 | undef $memotable{$revmemotable{$cref}}; | ||||
| 289 | undef $revmemotable{$cref}; | ||||
| 290 | |||||
| 291 | # This removes the last reference to the (possibly tied) memo tables | ||||
| 292 | # my ($old_function, $memotabs) = @{$tabent}{'U','S','L'}; | ||||
| 293 | # undef $tabent; | ||||
| 294 | |||||
| 295 | # # Untie the memo tables if they were tied. | ||||
| 296 | # my $i; | ||||
| 297 | # for $i (0,1) { | ||||
| 298 | # if (tied %{$memotabs->[$i]}) { | ||||
| 299 | # warn "Untying hash #$i\n"; | ||||
| 300 | # untie %{$memotabs->[$i]}; | ||||
| 301 | # } | ||||
| 302 | # } | ||||
| 303 | |||||
| 304 | $tabent->{U}; | ||||
| 305 | } | ||||
| 306 | |||||
| 307 | # spent 14µs (13+800ns) within Memoize::_make_cref which was called:
# once (13µs+800ns) by Memoize::memoize at line 59 | ||||
| 308 | 1 | 600ns | my $fn = shift; | ||
| 309 | 1 | 300ns | my $uppack = shift; | ||
| 310 | 1 | 300ns | my $cref; | ||
| 311 | 1 | 200ns | my $name; | ||
| 312 | |||||
| 313 | 1 | 900ns | if (ref $fn eq 'CODE') { | ||
| 314 | $cref = $fn; | ||||
| 315 | } elsif (! ref $fn) { | ||||
| 316 | 1 | 6µs | 1 | 800ns | if ($fn =~ /::/) { # spent 800ns making 1 call to Memoize::CORE:match |
| 317 | $name = $fn; | ||||
| 318 | } else { | ||||
| 319 | 1 | 1µs | $name = $uppack . '::' . $fn; | ||
| 320 | } | ||||
| 321 | 3 | 372µs | 2 | 10µs | # spent 8µs (6+2) within Memoize::BEGIN@321 which was called:
# once (6µs+2µs) by Tapper::Model::BEGIN@24 at line 321 # spent 8µs making 1 call to Memoize::BEGIN@321
# spent 2µs making 1 call to strict::unimport |
| 322 | 1 | 1µs | if (defined $name and !defined(&$name)) { | ||
| 323 | croak "Cannot operate on nonexistent function `$fn'"; | ||||
| 324 | } | ||||
| 325 | # $cref = \&$name; | ||||
| 326 | 1 | 1µs | $cref = *{$name}{CODE}; | ||
| 327 | } else { | ||||
| 328 | my $parent = (caller(1))[3]; # Function that called _make_cref | ||||
| 329 | croak "Usage: argument 1 to `$parent' must be a function name or reference.\n"; | ||||
| 330 | } | ||||
| 331 | 1 | 300ns | $DEBUG and warn "${name}($fn) => $cref in _make_cref\n"; | ||
| 332 | 1 | 3µs | $cref; | ||
| 333 | } | ||||
| 334 | |||||
| 335 | sub _crap_out { | ||||
| 336 | my ($funcname, $context) = @_; | ||||
| 337 | if (defined $funcname) { | ||||
| 338 | croak "Function `$funcname' called in forbidden $context context; faulting"; | ||||
| 339 | } else { | ||||
| 340 | croak "Anonymous function called in forbidden $context context; faulting"; | ||||
| 341 | } | ||||
| 342 | } | ||||
| 343 | |||||
| 344 | 1 | 9µs | 1; | ||
| 345 | |||||
| - - | |||||
| 350 | =head1 NAME | ||||
| 351 | |||||
| 352 | Memoize - Make functions faster by trading space for time | ||||
| 353 | |||||
| 354 | =head1 SYNOPSIS | ||||
| 355 | |||||
| 356 | # This is the documentation for Memoize 1.03 | ||||
| 357 | use Memoize; | ||||
| 358 | memoize('slow_function'); | ||||
| 359 | slow_function(arguments); # Is faster than it was before | ||||
| 360 | |||||
| 361 | |||||
| 362 | This is normally all you need to know. However, many options are available: | ||||
| 363 | |||||
| 364 | memoize(function, options...); | ||||
| 365 | |||||
| 366 | Options include: | ||||
| 367 | |||||
| 368 | NORMALIZER => function | ||||
| 369 | INSTALL => new_name | ||||
| 370 | |||||
| 371 | SCALAR_CACHE => 'MEMORY' | ||||
| 372 | SCALAR_CACHE => ['HASH', \%cache_hash ] | ||||
| 373 | SCALAR_CACHE => 'FAULT' | ||||
| 374 | SCALAR_CACHE => 'MERGE' | ||||
| 375 | |||||
| 376 | LIST_CACHE => 'MEMORY' | ||||
| 377 | LIST_CACHE => ['HASH', \%cache_hash ] | ||||
| 378 | LIST_CACHE => 'FAULT' | ||||
| 379 | LIST_CACHE => 'MERGE' | ||||
| 380 | |||||
| 381 | =head1 DESCRIPTION | ||||
| 382 | |||||
| 383 | `Memoizing' a function makes it faster by trading space for time. It | ||||
| 384 | does this by caching the return values of the function in a table. | ||||
| 385 | If you call the function again with the same arguments, C<memoize> | ||||
| 386 | jumps in and gives you the value out of the table, instead of letting | ||||
| 387 | the function compute the value all over again. | ||||
| 388 | |||||
| 389 | Here is an extreme example. Consider the Fibonacci sequence, defined | ||||
| 390 | by the following function: | ||||
| 391 | |||||
| 392 | # Compute Fibonacci numbers | ||||
| 393 | sub fib { | ||||
| 394 | my $n = shift; | ||||
| 395 | return $n if $n < 2; | ||||
| 396 | fib($n-1) + fib($n-2); | ||||
| 397 | } | ||||
| 398 | |||||
| 399 | This function is very slow. Why? To compute fib(14), it first wants | ||||
| 400 | to compute fib(13) and fib(12), and add the results. But to compute | ||||
| 401 | fib(13), it first has to compute fib(12) and fib(11), and then it | ||||
| 402 | comes back and computes fib(12) all over again even though the answer | ||||
| 403 | is the same. And both of the times that it wants to compute fib(12), | ||||
| 404 | it has to compute fib(11) from scratch, and then it has to do it | ||||
| 405 | again each time it wants to compute fib(13). This function does so | ||||
| 406 | much recomputing of old results that it takes a really long time to | ||||
| 407 | run---fib(14) makes 1,200 extra recursive calls to itself, to compute | ||||
| 408 | and recompute things that it already computed. | ||||
| 409 | |||||
| 410 | This function is a good candidate for memoization. If you memoize the | ||||
| 411 | `fib' function above, it will compute fib(14) exactly once, the first | ||||
| 412 | time it needs to, and then save the result in a table. Then if you | ||||
| 413 | ask for fib(14) again, it gives you the result out of the table. | ||||
| 414 | While computing fib(14), instead of computing fib(12) twice, it does | ||||
| 415 | it once; the second time it needs the value it gets it from the table. | ||||
| 416 | It doesn't compute fib(11) four times; it computes it once, getting it | ||||
| 417 | from the table the next three times. Instead of making 1,200 | ||||
| 418 | recursive calls to `fib', it makes 15. This makes the function about | ||||
| 419 | 150 times faster. | ||||
| 420 | |||||
| 421 | You could do the memoization yourself, by rewriting the function, like | ||||
| 422 | this: | ||||
| 423 | |||||
| 424 | # Compute Fibonacci numbers, memoized version | ||||
| 425 | { my @fib; | ||||
| 426 | sub fib { | ||||
| 427 | my $n = shift; | ||||
| 428 | return $fib[$n] if defined $fib[$n]; | ||||
| 429 | return $fib[$n] = $n if $n < 2; | ||||
| 430 | $fib[$n] = fib($n-1) + fib($n-2); | ||||
| 431 | } | ||||
| 432 | } | ||||
| 433 | |||||
| 434 | Or you could use this module, like this: | ||||
| 435 | |||||
| 436 | use Memoize; | ||||
| 437 | memoize('fib'); | ||||
| 438 | |||||
| 439 | # Rest of the fib function just like the original version. | ||||
| 440 | |||||
| 441 | This makes it easy to turn memoizing on and off. | ||||
| 442 | |||||
| 443 | Here's an even simpler example: I wrote a simple ray tracer; the | ||||
| 444 | program would look in a certain direction, figure out what it was | ||||
| 445 | looking at, and then convert the `color' value (typically a string | ||||
| 446 | like `red') of that object to a red, green, and blue pixel value, like | ||||
| 447 | this: | ||||
| 448 | |||||
| 449 | for ($direction = 0; $direction < 300; $direction++) { | ||||
| 450 | # Figure out which object is in direction $direction | ||||
| 451 | $color = $object->{color}; | ||||
| 452 | ($r, $g, $b) = @{&ColorToRGB($color)}; | ||||
| 453 | ... | ||||
| 454 | } | ||||
| 455 | |||||
| 456 | Since there are relatively few objects in a picture, there are only a | ||||
| 457 | few colors, which get looked up over and over again. Memoizing | ||||
| 458 | C<ColorToRGB> sped up the program by several percent. | ||||
| 459 | |||||
| 460 | =head1 DETAILS | ||||
| 461 | |||||
| 462 | This module exports exactly one function, C<memoize>. The rest of the | ||||
| 463 | functions in this package are None of Your Business. | ||||
| 464 | |||||
| 465 | You should say | ||||
| 466 | |||||
| 467 | memoize(function) | ||||
| 468 | |||||
| 469 | where C<function> is the name of the function you want to memoize, or | ||||
| 470 | a reference to it. C<memoize> returns a reference to the new, | ||||
| 471 | memoized version of the function, or C<undef> on a non-fatal error. | ||||
| 472 | At present, there are no non-fatal errors, but there might be some in | ||||
| 473 | the future. | ||||
| 474 | |||||
| 475 | If C<function> was the name of a function, then C<memoize> hides the | ||||
| 476 | old version and installs the new memoized version under the old name, | ||||
| 477 | so that C<&function(...)> actually invokes the memoized version. | ||||
| 478 | |||||
| 479 | =head1 OPTIONS | ||||
| 480 | |||||
| 481 | There are some optional options you can pass to C<memoize> to change | ||||
| 482 | the way it behaves a little. To supply options, invoke C<memoize> | ||||
| 483 | like this: | ||||
| 484 | |||||
| 485 | memoize(function, NORMALIZER => function, | ||||
| 486 | INSTALL => newname, | ||||
| 487 | SCALAR_CACHE => option, | ||||
| 488 | LIST_CACHE => option | ||||
| 489 | ); | ||||
| 490 | |||||
| 491 | Each of these options is optional; you can include some, all, or none | ||||
| 492 | of them. | ||||
| 493 | |||||
| 494 | =head2 INSTALL | ||||
| 495 | |||||
| 496 | If you supply a function name with C<INSTALL>, memoize will install | ||||
| 497 | the new, memoized version of the function under the name you give. | ||||
| 498 | For example, | ||||
| 499 | |||||
| 500 | memoize('fib', INSTALL => 'fastfib') | ||||
| 501 | |||||
| 502 | installs the memoized version of C<fib> as C<fastfib>; without the | ||||
| 503 | C<INSTALL> option it would have replaced the old C<fib> with the | ||||
| 504 | memoized version. | ||||
| 505 | |||||
| 506 | To prevent C<memoize> from installing the memoized version anywhere, use | ||||
| 507 | C<INSTALL =E<gt> undef>. | ||||
| 508 | |||||
| 509 | =head2 NORMALIZER | ||||
| 510 | |||||
| 511 | Suppose your function looks like this: | ||||
| 512 | |||||
| 513 | # Typical call: f('aha!', A => 11, B => 12); | ||||
| 514 | sub f { | ||||
| 515 | my $a = shift; | ||||
| 516 | my %hash = @_; | ||||
| 517 | $hash{B} ||= 2; # B defaults to 2 | ||||
| 518 | $hash{C} ||= 7; # C defaults to 7 | ||||
| 519 | |||||
| 520 | # Do something with $a, %hash | ||||
| 521 | } | ||||
| 522 | |||||
| 523 | Now, the following calls to your function are all completely equivalent: | ||||
| 524 | |||||
| 525 | f(OUCH); | ||||
| 526 | f(OUCH, B => 2); | ||||
| 527 | f(OUCH, C => 7); | ||||
| 528 | f(OUCH, B => 2, C => 7); | ||||
| 529 | f(OUCH, C => 7, B => 2); | ||||
| 530 | (etc.) | ||||
| 531 | |||||
| 532 | However, unless you tell C<Memoize> that these calls are equivalent, | ||||
| 533 | it will not know that, and it will compute the values for these | ||||
| 534 | invocations of your function separately, and store them separately. | ||||
| 535 | |||||
| 536 | To prevent this, supply a C<NORMALIZER> function that turns the | ||||
| 537 | program arguments into a string in a way that equivalent arguments | ||||
| 538 | turn into the same string. A C<NORMALIZER> function for C<f> above | ||||
| 539 | might look like this: | ||||
| 540 | |||||
| 541 | sub normalize_f { | ||||
| 542 | my $a = shift; | ||||
| 543 | my %hash = @_; | ||||
| 544 | $hash{B} ||= 2; | ||||
| 545 | $hash{C} ||= 7; | ||||
| 546 | |||||
| 547 | join(',', $a, map ($_ => $hash{$_}) sort keys %hash); | ||||
| 548 | } | ||||
| 549 | |||||
| 550 | Each of the argument lists above comes out of the C<normalize_f> | ||||
| 551 | function looking exactly the same, like this: | ||||
| 552 | |||||
| 553 | OUCH,B,2,C,7 | ||||
| 554 | |||||
| 555 | You would tell C<Memoize> to use this normalizer this way: | ||||
| 556 | |||||
| 557 | memoize('f', NORMALIZER => 'normalize_f'); | ||||
| 558 | |||||
| 559 | C<memoize> knows that if the normalized version of the arguments is | ||||
| 560 | the same for two argument lists, then it can safely look up the value | ||||
| 561 | that it computed for one argument list and return it as the result of | ||||
| 562 | calling the function with the other argument list, even if the | ||||
| 563 | argument lists look different. | ||||
| 564 | |||||
| 565 | The default normalizer just concatenates the arguments with character | ||||
| 566 | 28 in between. (In ASCII, this is called FS or control-\.) This | ||||
| 567 | always works correctly for functions with only one string argument, | ||||
| 568 | and also when the arguments never contain character 28. However, it | ||||
| 569 | can confuse certain argument lists: | ||||
| 570 | |||||
| 571 | normalizer("a\034", "b") | ||||
| 572 | normalizer("a", "\034b") | ||||
| 573 | normalizer("a\034\034b") | ||||
| 574 | |||||
| 575 | for example. | ||||
| 576 | |||||
| 577 | Since hash keys are strings, the default normalizer will not | ||||
| 578 | distinguish between C<undef> and the empty string. It also won't work | ||||
| 579 | when the function's arguments are references. For example, consider a | ||||
| 580 | function C<g> which gets two arguments: A number, and a reference to | ||||
| 581 | an array of numbers: | ||||
| 582 | |||||
| 583 | g(13, [1,2,3,4,5,6,7]); | ||||
| 584 | |||||
| 585 | The default normalizer will turn this into something like | ||||
| 586 | C<"13\034ARRAY(0x436c1f)">. That would be all right, except that a | ||||
| 587 | subsequent array of numbers might be stored at a different location | ||||
| 588 | even though it contains the same data. If this happens, C<Memoize> | ||||
| 589 | will think that the arguments are different, even though they are | ||||
| 590 | equivalent. In this case, a normalizer like this is appropriate: | ||||
| 591 | |||||
| 592 | sub normalize { join ' ', $_[0], @{$_[1]} } | ||||
| 593 | |||||
| 594 | For the example above, this produces the key "13 1 2 3 4 5 6 7". | ||||
| 595 | |||||
| 596 | Another use for normalizers is when the function depends on data other | ||||
| 597 | than those in its arguments. Suppose you have a function which | ||||
| 598 | returns a value which depends on the current hour of the day: | ||||
| 599 | |||||
| 600 | sub on_duty { | ||||
| 601 | my ($problem_type) = @_; | ||||
| 602 | my $hour = (localtime)[2]; | ||||
| 603 | open my $fh, "$DIR/$problem_type" or die...; | ||||
| 604 | my $line; | ||||
| 605 | while ($hour-- > 0) | ||||
| 606 | $line = <$fh>; | ||||
| 607 | } | ||||
| 608 | return $line; | ||||
| 609 | } | ||||
| 610 | |||||
| 611 | At 10:23, this function generates the 10th line of a data file; at | ||||
| 612 | 3:45 PM it generates the 15th line instead. By default, C<Memoize> | ||||
| 613 | will only see the $problem_type argument. To fix this, include the | ||||
| 614 | current hour in the normalizer: | ||||
| 615 | |||||
| 616 | sub normalize { join ' ', (localtime)[2], @_ } | ||||
| 617 | |||||
| 618 | The calling context of the function (scalar or list context) is | ||||
| 619 | propagated to the normalizer. This means that if the memoized | ||||
| 620 | function will treat its arguments differently in list context than it | ||||
| 621 | would in scalar context, you can have the normalizer function select | ||||
| 622 | its behavior based on the results of C<wantarray>. Even if called in | ||||
| 623 | a list context, a normalizer should still return a single string. | ||||
| 624 | |||||
| 625 | =head2 C<SCALAR_CACHE>, C<LIST_CACHE> | ||||
| 626 | |||||
| 627 | Normally, C<Memoize> caches your function's return values into an | ||||
| 628 | ordinary Perl hash variable. However, you might like to have the | ||||
| 629 | values cached on the disk, so that they persist from one run of your | ||||
| 630 | program to the next, or you might like to associate some other | ||||
| 631 | interesting semantics with the cached values. | ||||
| 632 | |||||
| 633 | There's a slight complication under the hood of C<Memoize>: There are | ||||
| 634 | actually I<two> caches, one for scalar values and one for list values. | ||||
| 635 | When your function is called in scalar context, its return value is | ||||
| 636 | cached in one hash, and when your function is called in list context, | ||||
| 637 | its value is cached in the other hash. You can control the caching | ||||
| 638 | behavior of both contexts independently with these options. | ||||
| 639 | |||||
| 640 | The argument to C<LIST_CACHE> or C<SCALAR_CACHE> must either be one of | ||||
| 641 | the following four strings: | ||||
| 642 | |||||
| 643 | MEMORY | ||||
| 644 | FAULT | ||||
| 645 | MERGE | ||||
| 646 | HASH | ||||
| 647 | |||||
| 648 | or else it must be a reference to an array whose first element is one of | ||||
| 649 | these four strings, such as C<[HASH, arguments...]>. | ||||
| 650 | |||||
| 651 | =over 4 | ||||
| 652 | |||||
| 653 | =item C<MEMORY> | ||||
| 654 | |||||
| 655 | C<MEMORY> means that return values from the function will be cached in | ||||
| 656 | an ordinary Perl hash variable. The hash variable will not persist | ||||
| 657 | after the program exits. This is the default. | ||||
| 658 | |||||
| 659 | =item C<HASH> | ||||
| 660 | |||||
| 661 | C<HASH> allows you to specify that a particular hash that you supply | ||||
| 662 | will be used as the cache. You can tie this hash beforehand to give | ||||
| 663 | it any behavior you want. | ||||
| 664 | |||||
| 665 | A tied hash can have any semantics at all. It is typically tied to an | ||||
| 666 | on-disk database, so that cached values are stored in the database and | ||||
| 667 | retrieved from it again when needed, and the disk file typically | ||||
| 668 | persists after your program has exited. See C<perltie> for more | ||||
| 669 | complete details about C<tie>. | ||||
| 670 | |||||
| 671 | A typical example is: | ||||
| 672 | |||||
| 673 | use DB_File; | ||||
| 674 | tie my %cache => 'DB_File', $filename, O_RDWR|O_CREAT, 0666; | ||||
| 675 | memoize 'function', SCALAR_CACHE => [HASH => \%cache]; | ||||
| 676 | |||||
| 677 | This has the effect of storing the cache in a C<DB_File> database | ||||
| 678 | whose name is in C<$filename>. The cache will persist after the | ||||
| 679 | program has exited. Next time the program runs, it will find the | ||||
| 680 | cache already populated from the previous run of the program. Or you | ||||
| 681 | can forcibly populate the cache by constructing a batch program that | ||||
| 682 | runs in the background and populates the cache file. Then when you | ||||
| 683 | come to run your real program the memoized function will be fast | ||||
| 684 | because all its results have been precomputed. | ||||
| 685 | |||||
| 686 | Another reason to use C<HASH> is to provide your own hash variable. | ||||
| 687 | You can then inspect or modify the contents of the hash to gain finer | ||||
| 688 | control over the cache management. | ||||
| 689 | |||||
| 690 | =item C<TIE> | ||||
| 691 | |||||
| 692 | This option is no longer supported. It is still documented only to | ||||
| 693 | aid in the debugging of old programs that use it. Old programs should | ||||
| 694 | be converted to use the C<HASH> option instead. | ||||
| 695 | |||||
| 696 | memoize ... ['TIE', PACKAGE, ARGS...] | ||||
| 697 | |||||
| 698 | is merely a shortcut for | ||||
| 699 | |||||
| 700 | require PACKAGE; | ||||
| 701 | { tie my %cache, PACKAGE, ARGS...; | ||||
| 702 | memoize ... [HASH => \%cache]; | ||||
| 703 | } | ||||
| 704 | |||||
| 705 | =item C<FAULT> | ||||
| 706 | |||||
| 707 | C<FAULT> means that you never expect to call the function in scalar | ||||
| 708 | (or list) context, and that if C<Memoize> detects such a call, it | ||||
| 709 | should abort the program. The error message is one of | ||||
| 710 | |||||
| 711 | `foo' function called in forbidden list context at line ... | ||||
| 712 | `foo' function called in forbidden scalar context at line ... | ||||
| 713 | |||||
| 714 | =item C<MERGE> | ||||
| 715 | |||||
| 716 | C<MERGE> normally means that the memoized function does not | ||||
| 717 | distinguish between list and sclar context, and that return values in | ||||
| 718 | both contexts should be stored together. Both C<LIST_CACHE =E<gt> | ||||
| 719 | MERGE> and C<SCALAR_CACHE =E<gt> MERGE> mean the same thing. | ||||
| 720 | |||||
| 721 | Consider this function: | ||||
| 722 | |||||
| 723 | sub complicated { | ||||
| 724 | # ... time-consuming calculation of $result | ||||
| 725 | return $result; | ||||
| 726 | } | ||||
| 727 | |||||
| 728 | The C<complicated> function will return the same numeric C<$result> | ||||
| 729 | regardless of whether it is called in list or in scalar context. | ||||
| 730 | |||||
| 731 | Normally, the following code will result in two calls to C<complicated>, even | ||||
| 732 | if C<complicated> is memoized: | ||||
| 733 | |||||
| 734 | $x = complicated(142); | ||||
| 735 | ($y) = complicated(142); | ||||
| 736 | $z = complicated(142); | ||||
| 737 | |||||
| 738 | The first call will cache the result, say 37, in the scalar cache; the | ||||
| 739 | second will cach the list C<(37)> in the list cache. The third call | ||||
| 740 | doesn't call the real C<complicated> function; it gets the value 37 | ||||
| 741 | from the scalar cache. | ||||
| 742 | |||||
| 743 | Obviously, the second call to C<complicated> is a waste of time, and | ||||
| 744 | storing its return value is a waste of space. Specifying C<LIST_CACHE | ||||
| 745 | =E<gt> MERGE> will make C<memoize> use the same cache for scalar and | ||||
| 746 | list context return values, so that the second call uses the scalar | ||||
| 747 | cache that was populated by the first call. C<complicated> ends up | ||||
| 748 | being called only once, and both subsequent calls return C<3> from the | ||||
| 749 | cache, regardless of the calling context. | ||||
| 750 | |||||
| 751 | =head3 List values in scalar context | ||||
| 752 | |||||
| 753 | Consider this function: | ||||
| 754 | |||||
| 755 | sub iota { return reverse (1..$_[0]) } | ||||
| 756 | |||||
| 757 | This function normally returns a list. Suppose you memoize it and | ||||
| 758 | merge the caches: | ||||
| 759 | |||||
| 760 | memoize 'iota', SCALAR_CACHE => 'MERGE'; | ||||
| 761 | |||||
| 762 | @i7 = iota(7); | ||||
| 763 | $i7 = iota(7); | ||||
| 764 | |||||
| 765 | Here the first call caches the list (1,2,3,4,5,6,7). The second call | ||||
| 766 | does not really make sense. C<Memoize> cannot guess what behavior | ||||
| 767 | C<iota> should have in scalar context without actually calling it in | ||||
| 768 | scalar context. Normally C<Memoize> I<would> call C<iota> in scalar | ||||
| 769 | context and cache the result, but the C<SCALAR_CACHE =E<gt> 'MERGE'> | ||||
| 770 | option says not to do that, but to use the cache list-context value | ||||
| 771 | instead. But it cannot return a list of seven elements in a scalar | ||||
| 772 | context. In this case C<$i7> will receive the B<first element> of the | ||||
| 773 | cached list value, namely 7. | ||||
| 774 | |||||
| 775 | =head3 Merged disk caches | ||||
| 776 | |||||
| 777 | Another use for C<MERGE> is when you want both kinds of return values | ||||
| 778 | stored in the same disk file; this saves you from having to deal with | ||||
| 779 | two disk files instead of one. You can use a normalizer function to | ||||
| 780 | keep the two sets of return values separate. For example: | ||||
| 781 | |||||
| 782 | tie my %cache => 'MLDBM', 'DB_File', $filename, ...; | ||||
| 783 | |||||
| 784 | memoize 'myfunc', | ||||
| 785 | NORMALIZER => 'n', | ||||
| 786 | SCALAR_CACHE => [HASH => \%cache], | ||||
| 787 | LIST_CACHE => 'MERGE', | ||||
| 788 | ; | ||||
| 789 | |||||
| 790 | sub n { | ||||
| 791 | my $context = wantarray() ? 'L' : 'S'; | ||||
| 792 | # ... now compute the hash key from the arguments ... | ||||
| 793 | $hashkey = "$context:$hashkey"; | ||||
| 794 | } | ||||
| 795 | |||||
| 796 | This normalizer function will store scalar context return values in | ||||
| 797 | the disk file under keys that begin with C<S:>, and list context | ||||
| 798 | return values under keys that begin with C<L:>. | ||||
| 799 | |||||
| 800 | =back | ||||
| 801 | |||||
| 802 | =head1 OTHER FACILITIES | ||||
| 803 | |||||
| 804 | =head2 C<unmemoize> | ||||
| 805 | |||||
| 806 | There's an C<unmemoize> function that you can import if you want to. | ||||
| 807 | Why would you want to? Here's an example: Suppose you have your cache | ||||
| 808 | tied to a DBM file, and you want to make sure that the cache is | ||||
| 809 | written out to disk if someone interrupts the program. If the program | ||||
| 810 | exits normally, this will happen anyway, but if someone types | ||||
| 811 | control-C or something then the program will terminate immediately | ||||
| 812 | without synchronizing the database. So what you can do instead is | ||||
| 813 | |||||
| 814 | $SIG{INT} = sub { unmemoize 'function' }; | ||||
| 815 | |||||
| 816 | C<unmemoize> accepts a reference to, or the name of a previously | ||||
| 817 | memoized function, and undoes whatever it did to provide the memoized | ||||
| 818 | version in the first place, including making the name refer to the | ||||
| 819 | unmemoized version if appropriate. It returns a reference to the | ||||
| 820 | unmemoized version of the function. | ||||
| 821 | |||||
| 822 | If you ask it to unmemoize a function that was never memoized, it | ||||
| 823 | croaks. | ||||
| 824 | |||||
| 825 | =head2 C<flush_cache> | ||||
| 826 | |||||
| 827 | C<flush_cache(function)> will flush out the caches, discarding I<all> | ||||
| 828 | the cached data. The argument may be a function name or a reference | ||||
| 829 | to a function. For finer control over when data is discarded or | ||||
| 830 | expired, see the documentation for C<Memoize::Expire>, included in | ||||
| 831 | this package. | ||||
| 832 | |||||
| 833 | Note that if the cache is a tied hash, C<flush_cache> will attempt to | ||||
| 834 | invoke the C<CLEAR> method on the hash. If there is no C<CLEAR> | ||||
| 835 | method, this will cause a run-time error. | ||||
| 836 | |||||
| 837 | An alternative approach to cache flushing is to use the C<HASH> option | ||||
| 838 | (see above) to request that C<Memoize> use a particular hash variable | ||||
| 839 | as its cache. Then you can examine or modify the hash at any time in | ||||
| 840 | any way you desire. You may flush the cache by using C<%hash = ()>. | ||||
| 841 | |||||
| 842 | =head1 CAVEATS | ||||
| 843 | |||||
| 844 | Memoization is not a cure-all: | ||||
| 845 | |||||
| 846 | =over 4 | ||||
| 847 | |||||
| 848 | =item * | ||||
| 849 | |||||
| 850 | Do not memoize a function whose behavior depends on program | ||||
| 851 | state other than its own arguments, such as global variables, the time | ||||
| 852 | of day, or file input. These functions will not produce correct | ||||
| 853 | results when memoized. For a particularly easy example: | ||||
| 854 | |||||
| 855 | sub f { | ||||
| 856 | time; | ||||
| 857 | } | ||||
| 858 | |||||
| 859 | This function takes no arguments, and as far as C<Memoize> is | ||||
| 860 | concerned, it always returns the same result. C<Memoize> is wrong, of | ||||
| 861 | course, and the memoized version of this function will call C<time> once | ||||
| 862 | to get the current time, and it will return that same time | ||||
| 863 | every time you call it after that. | ||||
| 864 | |||||
| 865 | =item * | ||||
| 866 | |||||
| 867 | Do not memoize a function with side effects. | ||||
| 868 | |||||
| 869 | sub f { | ||||
| 870 | my ($a, $b) = @_; | ||||
| 871 | my $s = $a + $b; | ||||
| 872 | print "$a + $b = $s.\n"; | ||||
| 873 | } | ||||
| 874 | |||||
| 875 | This function accepts two arguments, adds them, and prints their sum. | ||||
| 876 | Its return value is the numuber of characters it printed, but you | ||||
| 877 | probably didn't care about that. But C<Memoize> doesn't understand | ||||
| 878 | that. If you memoize this function, you will get the result you | ||||
| 879 | expect the first time you ask it to print the sum of 2 and 3, but | ||||
| 880 | subsequent calls will return 1 (the return value of | ||||
| 881 | C<print>) without actually printing anything. | ||||
| 882 | |||||
| 883 | =item * | ||||
| 884 | |||||
| 885 | Do not memoize a function that returns a data structure that is | ||||
| 886 | modified by its caller. | ||||
| 887 | |||||
| 888 | Consider these functions: C<getusers> returns a list of users somehow, | ||||
| 889 | and then C<main> throws away the first user on the list and prints the | ||||
| 890 | rest: | ||||
| 891 | |||||
| 892 | sub main { | ||||
| 893 | my $userlist = getusers(); | ||||
| 894 | shift @$userlist; | ||||
| 895 | foreach $u (@$userlist) { | ||||
| 896 | print "User $u\n"; | ||||
| 897 | } | ||||
| 898 | } | ||||
| 899 | |||||
| 900 | sub getusers { | ||||
| 901 | my @users; | ||||
| 902 | # Do something to get a list of users; | ||||
| 903 | \@users; # Return reference to list. | ||||
| 904 | } | ||||
| 905 | |||||
| 906 | If you memoize C<getusers> here, it will work right exactly once. The | ||||
| 907 | reference to the users list will be stored in the memo table. C<main> | ||||
| 908 | will discard the first element from the referenced list. The next | ||||
| 909 | time you invoke C<main>, C<Memoize> will not call C<getusers>; it will | ||||
| 910 | just return the same reference to the same list it got last time. But | ||||
| 911 | this time the list has already had its head removed; C<main> will | ||||
| 912 | erroneously remove another element from it. The list will get shorter | ||||
| 913 | and shorter every time you call C<main>. | ||||
| 914 | |||||
| 915 | Similarly, this: | ||||
| 916 | |||||
| 917 | $u1 = getusers(); | ||||
| 918 | $u2 = getusers(); | ||||
| 919 | pop @$u1; | ||||
| 920 | |||||
| 921 | will modify $u2 as well as $u1, because both variables are references | ||||
| 922 | to the same array. Had C<getusers> not been memoized, $u1 and $u2 | ||||
| 923 | would have referred to different arrays. | ||||
| 924 | |||||
| 925 | =item * | ||||
| 926 | |||||
| 927 | Do not memoize a very simple function. | ||||
| 928 | |||||
| 929 | Recently someone mentioned to me that the Memoize module made his | ||||
| 930 | program run slower instead of faster. It turned out that he was | ||||
| 931 | memoizing the following function: | ||||
| 932 | |||||
| 933 | sub square { | ||||
| 934 | $_[0] * $_[0]; | ||||
| 935 | } | ||||
| 936 | |||||
| 937 | I pointed out that C<Memoize> uses a hash, and that looking up a | ||||
| 938 | number in the hash is necessarily going to take a lot longer than a | ||||
| 939 | single multiplication. There really is no way to speed up the | ||||
| 940 | C<square> function. | ||||
| 941 | |||||
| 942 | Memoization is not magical. | ||||
| 943 | |||||
| 944 | =back | ||||
| 945 | |||||
| 946 | =head1 PERSISTENT CACHE SUPPORT | ||||
| 947 | |||||
| 948 | You can tie the cache tables to any sort of tied hash that you want | ||||
| 949 | to, as long as it supports C<TIEHASH>, C<FETCH>, C<STORE>, and | ||||
| 950 | C<EXISTS>. For example, | ||||
| 951 | |||||
| 952 | tie my %cache => 'GDBM_File', $filename, O_RDWR|O_CREAT, 0666; | ||||
| 953 | memoize 'function', SCALAR_CACHE => [HASH => \%cache]; | ||||
| 954 | |||||
| 955 | works just fine. For some storage methods, you need a little glue. | ||||
| 956 | |||||
| 957 | C<SDBM_File> doesn't supply an C<EXISTS> method, so included in this | ||||
| 958 | package is a glue module called C<Memoize::SDBM_File> which does | ||||
| 959 | provide one. Use this instead of plain C<SDBM_File> to store your | ||||
| 960 | cache table on disk in an C<SDBM_File> database: | ||||
| 961 | |||||
| 962 | tie my %cache => 'Memoize::SDBM_File', $filename, O_RDWR|O_CREAT, 0666; | ||||
| 963 | memoize 'function', SCALAR_CACHE => [HASH => \%cache]; | ||||
| 964 | |||||
| 965 | C<NDBM_File> has the same problem and the same solution. (Use | ||||
| 966 | C<Memoize::NDBM_File instead of plain NDBM_File.>) | ||||
| 967 | |||||
| 968 | C<Storable> isn't a tied hash class at all. You can use it to store a | ||||
| 969 | hash to disk and retrieve it again, but you can't modify the hash while | ||||
| 970 | it's on the disk. So if you want to store your cache table in a | ||||
| 971 | C<Storable> database, use C<Memoize::Storable>, which puts a hashlike | ||||
| 972 | front-end onto C<Storable>. The hash table is actually kept in | ||||
| 973 | memory, and is loaded from your C<Storable> file at the time you | ||||
| 974 | memoize the function, and stored back at the time you unmemoize the | ||||
| 975 | function (or when your program exits): | ||||
| 976 | |||||
| 977 | tie my %cache => 'Memoize::Storable', $filename; | ||||
| 978 | memoize 'function', SCALAR_CACHE => [HASH => \%cache]; | ||||
| 979 | |||||
| 980 | tie my %cache => 'Memoize::Storable', $filename, 'nstore'; | ||||
| 981 | memoize 'function', SCALAR_CACHE => [HASH => \%cache]; | ||||
| 982 | |||||
| 983 | Include the `nstore' option to have the C<Storable> database written | ||||
| 984 | in `network order'. (See L<Storable> for more details about this.) | ||||
| 985 | |||||
| 986 | The C<flush_cache()> function will raise a run-time error unless the | ||||
| 987 | tied package provides a C<CLEAR> method. | ||||
| 988 | |||||
| 989 | =head1 EXPIRATION SUPPORT | ||||
| 990 | |||||
| 991 | See Memoize::Expire, which is a plug-in module that adds expiration | ||||
| 992 | functionality to Memoize. If you don't like the kinds of policies | ||||
| 993 | that Memoize::Expire implements, it is easy to write your own plug-in | ||||
| 994 | module to implement whatever policy you desire. Memoize comes with | ||||
| 995 | several examples. An expiration manager that implements a LRU policy | ||||
| 996 | is available on CPAN as Memoize::ExpireLRU. | ||||
| 997 | |||||
| 998 | =head1 BUGS | ||||
| 999 | |||||
| 1000 | The test suite is much better, but always needs improvement. | ||||
| 1001 | |||||
| 1002 | There is some problem with the way C<goto &f> works under threaded | ||||
| 1003 | Perl, perhaps because of the lexical scoping of C<@_>. This is a bug | ||||
| 1004 | in Perl, and until it is resolved, memoized functions will see a | ||||
| 1005 | slightly different C<caller()> and will perform a little more slowly | ||||
| 1006 | on threaded perls than unthreaded perls. | ||||
| 1007 | |||||
| 1008 | Some versions of C<DB_File> won't let you store data under a key of | ||||
| 1009 | length 0. That means that if you have a function C<f> which you | ||||
| 1010 | memoized and the cache is in a C<DB_File> database, then the value of | ||||
| 1011 | C<f()> (C<f> called with no arguments) will not be memoized. If this | ||||
| 1012 | is a big problem, you can supply a normalizer function that prepends | ||||
| 1013 | C<"x"> to every key. | ||||
| 1014 | |||||
| 1015 | =head1 MAILING LIST | ||||
| 1016 | |||||
| 1017 | To join a very low-traffic mailing list for announcements about | ||||
| 1018 | C<Memoize>, send an empty note to C<mjd-perl-memoize-request@plover.com>. | ||||
| 1019 | |||||
| 1020 | =head1 AUTHOR | ||||
| 1021 | |||||
| 1022 | Mark-Jason Dominus (C<mjd-perl-memoize+@plover.com>), Plover Systems co. | ||||
| 1023 | |||||
| 1024 | See the C<Memoize.pm> Page at http://perl.plover.com/Memoize/ | ||||
| 1025 | for news and upgrades. Near this page, at | ||||
| 1026 | http://perl.plover.com/MiniMemoize/ there is an article about | ||||
| 1027 | memoization and about the internals of Memoize that appeared in The | ||||
| 1028 | Perl Journal, issue #13. (This article is also included in the | ||||
| 1029 | Memoize distribution as `article.html'.) | ||||
| 1030 | |||||
| 1031 | The author's book I<Higher-Order Perl> (2005, ISBN 1558607013, published | ||||
| 1032 | by Morgan Kaufmann) discusses memoization (and many other | ||||
| 1033 | topics) in tremendous detail. It is available on-line for free. | ||||
| 1034 | For more information, visit http://hop.perl.plover.com/ . | ||||
| 1035 | |||||
| 1036 | To join a mailing list for announcements about C<Memoize>, send an | ||||
| 1037 | empty message to C<mjd-perl-memoize-request@plover.com>. This mailing | ||||
| 1038 | list is for announcements only and has extremely low traffic---fewer than | ||||
| 1039 | two messages per year. | ||||
| 1040 | |||||
| 1041 | =head1 COPYRIGHT AND LICENSE | ||||
| 1042 | |||||
| 1043 | Copyright 1998, 1999, 2000, 2001, 2012 by Mark Jason Dominus | ||||
| 1044 | |||||
| 1045 | This library is free software; you may redistribute it and/or modify | ||||
| 1046 | it under the same terms as Perl itself. | ||||
| 1047 | |||||
| 1048 | =head1 THANK YOU | ||||
| 1049 | |||||
| 1050 | Many thanks to Florian Ragwitz for administration and packaging | ||||
| 1051 | assistance, to John Tromp for bug reports, to Jonathan Roy for bug reports | ||||
| 1052 | and suggestions, to Michael Schwern for other bug reports and patches, | ||||
| 1053 | to Mike Cariaso for helping me to figure out the Right Thing to Do | ||||
| 1054 | About Expiration, to Joshua Gerth, Joshua Chamas, Jonathan Roy | ||||
| 1055 | (again), Mark D. Anderson, and Andrew Johnson for more suggestions | ||||
| 1056 | about expiration, to Brent Powers for the Memoize::ExpireLRU module, | ||||
| 1057 | to Ariel Scolnicov for delightful messages about the Fibonacci | ||||
| 1058 | function, to Dion Almaer for thought-provoking suggestions about the | ||||
| 1059 | default normalizer, to Walt Mankowski and Kurt Starsinic for much help | ||||
| 1060 | investigating problems under threaded Perl, to Alex Dudkevich for | ||||
| 1061 | reporting the bug in prototyped functions and for checking my patch, | ||||
| 1062 | to Tony Bass for many helpful suggestions, to Jonathan Roy (again) for | ||||
| 1063 | finding a use for C<unmemoize()>, to Philippe Verdret for enlightening | ||||
| 1064 | discussion of C<Hook::PrePostCall>, to Nat Torkington for advice I | ||||
| 1065 | ignored, to Chris Nandor for portability advice, to Randal Schwartz | ||||
| 1066 | for suggesting the 'C<flush_cache> function, and to Jenda Krynicky for | ||||
| 1067 | being a light in the world. | ||||
| 1068 | |||||
| 1069 | Special thanks to Jarkko Hietaniemi, the 5.8.0 pumpking, for including | ||||
| 1070 | this module in the core and for his patient and helpful guidance | ||||
| 1071 | during the integration process. | ||||
| 1072 | |||||
| 1073 | =cut | ||||
sub Memoize::CORE:match; # opcode |