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