apollo/netinet/in.h Apollo DomainOS port: C header file frontend
-Artistic The "Artistic License"
-AUTHORS Contact info for contributors
+Artistic The "Artistic License"
+AUTHORS Contact info for contributors
av.c Array value code
av.h Array value header
beos/nm.c BeOS port
bytecode.pl Produces ext/ByteLoader/byterun.h, ext/ByteLoader/byterun.c and ext/B/Asmdata.pm
cc_runtime.h Macros need by runtime of compiler-generated code
cflags.SH A script that emits C compilation flags per file
-Changes Differences from previous version
-Changes5.000 Differences between 4.x and 5.000
-Changes5.001 Differences between 5.000 and 5.001
-Changes5.002 Differences between 5.001 and 5.002
-Changes5.003 Differences between 5.002 and 5.003
-Changes5.004 Differences between 5.003 and 5.004
-Changes5.005 Differences between 5.004 and 5.005
-Changes5.6 Differences between 5.005 and 5.6
+Changes Differences from previous version
+Changes5.000 Differences between 4.x and 5.000
+Changes5.001 Differences between 5.000 and 5.001
+Changes5.002 Differences between 5.001 and 5.002
+Changes5.003 Differences between 5.002 and 5.003
+Changes5.004 Differences between 5.003 and 5.004
+Changes5.005 Differences between 5.004 and 5.005
+Changes5.6 Differences between 5.005 and 5.6
configpm Produces lib/Config.pm
-Configure Portability tool
+Configure Portability tool
configure.com Configure-equivalent for VMS
configure.gnu Crude emulation of GNU configure
config_h.SH Produces config.h
cop.h Control operator header
-Copying The GNU General Public License
-Cross/README Cross-compilation
+Copying The GNU General Public License
+Cross/README Cross-compilation
cv.h Code value header
cygwin/cygwin.c Additional code for Cygwin port
cygwin/ld2.in ld wrapper template for Cygwin port
lib/Memoize/SDBM_File.pm Memoize
lib/Memoize/Storable.pm Memoize
lib/Memoize/t/array.t Memoize
+lib/Memoize/t/array_confusion.t Memoize
lib/Memoize/t/correctness.t Memoize
lib/Memoize/t/errors.t Memoize
lib/Memoize/t/expire.t Memoize
#
# Transparent memoization of idempotent functions
#
-# Copyright 1998, 1999 M-J. Dominus.
+# Copyright 1998, 1999, 2000, 2001 M-J. Dominus.
# You may copy and distribute this program under the
# same terms as Perl itself. If in doubt,
# write to mjd-perl-memoize+@plover.com for a license.
#
-# Version 0.64 beta $Revision: 1.17 $ $Date: 2000/10/24 04:33:49 $
+# Version 0.65 beta $Revision: 1.17 $ $Date: 2000/10/24 04:33:49 $
package Memoize;
-$VERSION = '0.64';
+$VERSION = '0.65';
# Compile-time constants
sub SCALAR () { 0 }
use Carp;
use Exporter;
use vars qw($DEBUG);
+use Config; # Dammit.
@ISA = qw(Exporter);
@EXPORT = qw(memoize);
@EXPORT_OK = qw(unmemoize flush_cache);
if (defined $proto) { $proto = "($proto)" }
else { $proto = "" }
- # Goto considered harmful! Hee hee hee.
- my $wrapper = eval "sub $proto { unshift \@_, qq{$cref}; goto &_memoizer; }";
- # Actually I would like to get rid of the eval, but there seems not
- # to be any other way to set the prototype properly.
-
-# --- THREADED PERL COMMENT ---
-# The above line might not work under threaded perl because goto &
-# semantics are broken. If that's the case, try the following instead:
-# my $wrapper = eval "sub { &_memoizer(qq{$cref}, \@_); }";
-# Confirmed 1998-12-27 this does work.
-# 1998-12-29: Sarathy says this bug is fixed in 5.005_54.
-# However, the module still fails, although the sample test program doesn't.
+ # I would like to get rid of the eval, but there seems not to be any
+ # other way to set the prototype properly. The switch here for
+ # 'usethreads' works around a bug in threadperl having to do with
+ # magic goto. It would be better to fix the bug and use the magic
+ # goto version everywhere.
+ my $wrapper =
+ $Config{usethreads}
+ ? eval "sub $proto { &_memoizer(\$cref, \@_); }"
+ : eval "sub $proto { unshift \@_, \$cref; goto &_memoizer; }";
my $normalizer = $options{NORMALIZER};
if (defined $normalizer && ! ref $normalizer) {
if ($cache_opt eq 'FAULT') { # no cache
$caches{$context} = undef;
} elsif ($cache_opt eq 'HASH') { # user-supplied hash
- $caches{$context} = $cache_opt_args[0];
+ my $cache = $cache_opt_args[0];
+ my $package = ref(tied %$cache);
+ if ($context eq 'LIST' && $scalar_only{$package}) {
+ croak("You can't use $package for LIST_CACHE because it can only store scalars");
+ }
+ $caches{$context} = $cache;
} elsif ($cache_opt eq '' || $IS_CACHE_TAG{$cache_opt}) {
# default is that we make up an in-memory hash
$caches{$context} = {};
my $shortopt = (ref $fullopt) ? $fullopt->[0] : $fullopt;
return unless defined $shortopt && $shortopt eq 'TIE';
+ carp("TIE option to memoize() is deprecated; use HASH instead") if $^W;
+
my @args = ref $fullopt ? @$fullopt : ();
shift @args;
if ($@) {
croak "Memoize: Couldn't load hash tie module `$module': $@; aborting";
}
-# eval { import $module };
-# if ($@) {
-# croak "Memoize: Couldn't import hash tie module `$module': $@; aborting";
-# }
-# eval "use $module ()";
-# if ($@) {
-# croak "Memoize: Couldn't use hash tie module `$module': $@; aborting";
-# }
my $rc = (tie %$hash => $module, @args);
unless ($rc) {
- croak "Memoize: Couldn't tie hash to `$module': $@; aborting";
+ croak "Memoize: Couldn't tie hash to `$module': $!; aborting";
}
1;
}
croak "Internal error \#41; context was neither LIST nor SCALAR\n";
}
} else { # Default normalizer
- $argstr = join $;,@_; # $;,@_;? Perl is great.
+ local $^W = 0;
+ $argstr = join chr(28),@_;
}
if ($context == SCALAR) {
my $cache = $info->{S};
- _crap_out($info->{NAME}, 'scalar') unless defined $cache;
+ _crap_out($info->{NAME}, 'scalar') unless $cache;
if (exists $cache->{$argstr}) {
return $cache->{$argstr};
} else {
}
} elsif ($context == LIST) {
my $cache = $info->{L};
- _crap_out($info->{NAME}, 'list') unless defined $cache;
+ _crap_out($info->{NAME}, 'list') unless $cache;
if (exists $cache->{$argstr}) {
my $val = $cache->{$argstr};
- return ($val) unless ref $val eq 'ARRAY';
- # An array ref is ambiguous. Did the function really return
- # an array ref? Or did we cache a list-context list return in
- # an anonymous array?
# If LISTCONTEXT=>MERGE, then the function never returns lists,
- # so we know for sure:
+ # so we have a scalar value cached, so just return it straightaway:
return ($val) if $info->{O}{LIST_CACHE} eq 'MERGE';
- # Otherwise, we're doomed. ###BUG
+ # Maybe in a later version we can use a faster test.
+
+ # Otherwise, we cached an array containing the returned list:
return @$val;
} else {
my $q = $cache->{$argstr} = [&{$info->{U}}(@_)];
The default normalizer just concatenates the arguments with C<$;> in
between. This always works correctly for functions with only one
-argument, and also when the arguments never contain C<$;> (which is
-normally character #28, control-\. ) However, it can confuse certain
-argument lists:
+string argument, and also when the arguments never contain C<$;>
+(which is normally character #28, control-\. ) However, it can
+confuse certain argument lists:
normalizer("a\034", "b")
normalizer("a", "\034b")
normalizer("a\034\034b")
-for example.
+for example.
-The default normalizer also won't work when the function's arguments
-are references. For exampple, consider a function C<g> which gets two
-arguments: A number, and a reference to an array of numbers:
+Since hash keys are strings, the default normalizer will not
+distinguish between C<undef> and the empty string. It also won't work
+when the function's arguments are references. For example, consider
+a function C<g> which gets two arguments: A number, and a reference to
+an array of numbers:
g(13, [1,2,3,4,5,6,7]);
=item C<TIE>
This option is B<strongly deprecated> and will be removed
-in the B<next> version of C<Memoize>. Use the C<HASH> option instead.
+in the B<next> release of C<Memoize>. Use the C<HASH> option instead.
memoize ... [TIE, ARGS...]
memoize 'function', SCALAR_CACHE => [HASH => \%cache];
C<NDBM_File> has the same problem and the same solution. (Use
-C<Memoize::NDBM_File instead of Plain NDBM_File.>)
+C<Memoize::NDBM_File instead of plain NDBM_File.>)
C<Storable> isn't a tied hash class at all. You can use it to store a
hash to disk and retrieve it again, but you can't modify the hash while
list is for announcements only and has extremely low traffic---about
four messages per year.
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 1998, 1999, 2000, 2001 by Mark Jason Dominus
+
+This library is free software; you may redistribute it and/or modify
+it under the same terms as Perl itself.
+
=head1 THANK YOU
Many thanks to Jonathan Roy for bug reports and suggestions, to
'C<flush_cache> function, and to Jenda Krynicky for being a light in
the world.
+Special thanks to Jarkko Hietaniemi, the 5.8.0 pumpking, for including
+this module in the core and for his patient and helpful guidance
+during the integration process.
=cut
=cut
-use vars qw(@ISA);
+use vars qw(@ISA $VERSION);
+$VERSION = 0.65;
@ISA = qw(DB_File GDBM_File Memoize::NDBM_File Memoize::SDBM_File ODBM_File) unless @ISA;
my $verbose = 1;
# require 5.00556;
use Carp;
$DEBUG = 0;
-$VERSION = '0.51';
+$VERSION = '0.65';
# This package will implement expiration by prepending a fixed-length header
# to the font of the cached data. The format of the header will be:
=head1 SYNOPSIS
use Memoize;
- memoize 'function',
- SCALAR_CACHE => [TIE, Memoize::Expire,
+ use Memoize::Expire;
+ tie my %cache => 'Memoize::Expire',
LIFETIME => $lifetime, # In seconds
- NUM_USES => $n_uses,
- TIE => [Module, args...],
- ],
+ NUM_USES => $n_uses;
+
+ memoize 'function', SCALAR_CACHE => [HASH => \%cache ];
=head1 DESCRIPTION
values for memoized functions to expire automatically. This manual
assumes you are already familiar with the Memoize module. If not, you
should study that manual carefully first, paying particular attention
-to the TIE feature.
+to the HASH feature.
Memoize::Expire is a layer of software that you can insert in between
Memoize itself and whatever underlying package implements the cache.
-(By default, plain hash variables implement the cache.) The layer
-expires cached values whenever they get too old, have been used too
-often, or both.
+The layer presents a hash variable whose values expire whenever they
+get too old, have been used too often, or both. You tell C<Memoize> to
+use this forgetful hash as its cache instead of the default, which is
+an ordinary hash.
-To specify a real-time timeout, supply the LIFETIME option with a
+To specify a real-time timeout, supply the C<LIFETIME> option with a
numeric value. Cached data will expire after this many seconds, and
will be looked up afresh when it expires. When a data item is looked
up afresh, its lifetime is reset.
-If you specify NUM_USES with an argument of I<n>, then each cached
+If you specify C<NUM_USES> with an argument of I<n>, then each cached
data item will be discarded and looked up afresh after the I<n>th time
you access it. When a data item is looked up afresh, its number of
uses is reset.
If you specify both arguments, data will be discarded from the cache
-when either expiration condition holds.
-
-If you want the cache to persist between invocations of your program,
-supply a TIE option to specify the package name and arguments for a
-the tied hash that will implement the persistence. For example:
+when either expiration condition holds.
+
+Memoize::Expire uses a real hash internally to store the cached data.
+You can use the C<HASH> option to Memoize::Expire to supply a tied
+hash in place of the ordinary hash that Memoize::Expire will normally
+use. You can use this feature to add Memoize::Expire as a layer in
+between a persistent disk hash and Memoize. If you do this, you get a
+persistent disk cache whose entries expire automatically. For
+example:
+
+ # Memoize
+ # |
+ # Memoize::Expire enforces data expiration policy
+ # |
+ # DB_File implements persistence of data in a disk file
+ # |
+ # Disk file
use Memoize;
+ use Memoize::Expire;
use DB_File;
- memoize 'function',
- SCALAR_CACHE => [TIE, Memoize::Expire,
- LIFETIME => $lifetime, # In seconds
- NUM_USES => $n_uses,
- TIE => [DB_File, $filename, O_CREAT|O_RDWR, 0666],
- ], ...;
+ # Set up persistence
+ tie my %disk_cache => 'DB_File', $filename, O_CREAT|O_RDWR, 0666];
+ # Set up expiration policy, supplying persistent hash as a target
+ tie my %cache => 'Memoize::Expire',
+ LIFETIME => $lifetime, # In seconds
+ NUM_USES => $n_uses,
+ HASH => \%disk_cache;
+
+ # Set up memoization, supplying expiring persistent hash for cache
+ memoize 'function', SCALAR_CACHE => [ HASH => \%cache ];
=head1 INTERFACE
The user who wants the memoization cache to be expired according to
your policy will say so by writing
- memoize 'function',
- SCALAR_CACHE => [TIE, MyExpirePolicy, args...];
+ tie my %cache => 'MyExpirePolicy', args...;
+ memoize 'function', SCALAR_CACHE => [HASH => \%cache];
-This will invoke MyExpirePolicy->TIEHASH(args).
+This will invoke C<< MyExpirePolicy->TIEHASH(args) >>.
MyExpirePolicy::TIEHASH should do whatever is appropriate to set up
-the cache, and it should return the cache object to the caller.
+the cache, and it should return the cache object to the caller.
For example, MyExpirePolicy::TIEHASH might create an object that
contains a regular Perl hash (which it will to store the cached
data is and things like that. Let us call this object `C'.
When Memoize needs to check to see if an entry is in the cache
-already, it will invoke C->EXISTS(key). C<key> is the normalized
+already, it will invoke C<< C->EXISTS(key) >>. C<key> is the normalized
function argument. MyExpirePolicy::EXISTS should return 0 if the key
is not in the cache, or if it has expired, and 1 if an unexpired value
is in the cache. It should I<not> return C<undef>, because there is a
EXISTS method returns C<undef>.
If your EXISTS function returns true, Memoize will try to fetch the
-cached value by invoking C->FETCH(key). MyExpirePolicy::FETCH should
+cached value by invoking C<< C->FETCH(key) >>. MyExpirePolicy::FETCH should
return the cached value. Otherwise, Memoize will call the memoized
function to compute the appropriate value, and will store it into the
-cache by calling C->STORE(key, value).
+cache by calling C<< C->STORE(key, value) >>.
Here is a very brief example of a policy module that expires each
cache item after ten seconds.
package Memoize::TenSecondExpire;
sub TIEHASH {
- my ($package) = @_;
- my %cache;
- bless \%cache => $package;
+ my ($package, %args) = @_;
+ my $cache = $args{$HASH} || {};
+ bless $cache => $package;
}
sub EXISTS {
To use this expiration policy, the user would say
use Memoize;
- memoize 'function',
- SCALAR_CACHE => [TIE, Memoize::TenSecondExpire];
+ tie my %cache10sec => 'Memoize::TenSecondExpire';
+ memoize 'function', SCALAR_CACHE => [HASH => \%cache10sec];
Memoize would then call C<function> whenever a cached value was
entirely absent or was older than ten seconds.
-It's nice if you allow a C<TIE> argument to C<TIEHASH> that ties the
-underlying cache so that the user can specify that the cache is
-persistent or that it has some other interesting semantics. The
-sample C<Memoize::Expire> module demonstrates how to do this. It
-implements a policy that expires cache items when they get too old or
-when they have been accessed too many times.
+You should always support a C<HASH> argument to C<TIEHASH> that ties
+the underlying cache so that the user can specify that the cache is
+also persistent or that it has some other interesting semantics. The
+example above demonstrates how to do this, as does C<Memozie::Expire>.
Another sample module, C<Memoize::Saves>, is included with this
package. It implements a policy that allows you to specify that
=head1 ALTERNATIVES
+Brent Powers has a C<Memoize::ExpireLRU> module that was designed to
+wotk with Memoize and provides expiration of least-recently-used data.
+The cache is held at a fixed number of entries, and when new data
+comes in, the least-recently used data is expired. See
+L<http://search.cpan.org/search?mode=module&query=ExpireLRU>.
+
Joshua Chamas's Tie::Cache module may be useful as an expiration
manager. (If you try this, let me know how it works out.)
Mark-Jason Dominus (mjd-perl-memoize+@plover.com)
Mike Cariaso provided valuable insight into the best way to solve this
-problem.
+problem.
=head1 SEE ALSO
=cut
+$VERSION = 0.65;
use Carp;
+my $Zero = pack("N", 0);
+
sub TIEHASH {
my ($package, %args) = @_;
- my %cache;
- if ($args{TIE}) {
- my ($module, @opts) = @{$args{TIE}};
- my $modulefile = $module . '.pm';
- $modulefile =~ s{::}{/}g;
- eval { require $modulefile };
- if ($@) {
- croak "Memoize::ExpireFile: Couldn't load hash tie module `$module': $@; aborting";
- }
- my $rc = (tie %cache => $module, @opts);
- unless ($rc) {
- croak "Memoize::ExpireFile: Couldn't tie hash to `$module': $@; aborting";
- }
- }
- bless {ARGS => \%args, C => \%cache} => $package;
+ my $cache = $args{HASH} || {};
+ bless {ARGS => \%args, C => $cache} => $package;
}
sub EXISTS {
my ($self, $key) = @_;
- my $old_date = $self->{C}{"T$key"} || "0";
+ my $old_date = $self->{C}{"T$key"} || $Zero;
my $cur_date = pack("N", (stat($key))[9]);
- if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
- return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
- }
+# if ($self->{ARGS}{CHECK_DATE} && $old_date gt $cur_date) {
+# return $self->{ARGS}{CHECK_DATE}->($key, $old_date, $cur_date);
+# }
return $old_date ge $cur_date;
}
=head1 DESCRIPTION
-This is just for testing expiration semantics. It's not actually a
-very good example of how to write an expiration module.
+This module is just for testing expiration semantics. It's not a very
+good example of how to write an expiration module.
If you are looking for an example, I recommend that you look at the
simple example in the Memoize::Expire documentation, or at the code
for Memoize::Expire itself.
If you have questions, I will be happy to answer them if you send them
-to mjd-perl/memoize+@plover.com.
+to mjd-perl-memoize+@plover.com.
=cut
+$VERSION = 0.65;
my %cache;
sub TIEHASH {
use NDBM_File;
@ISA = qw(NDBM_File);
+$VERSION = 0.65;
$Verbose = 0;
$self->SUPER::STORE(@_);
}
+
+
# Inherit FETCH and TIEHASH
1;
Name: Memoize
What: Transparently speed up functions by caching return values.
-Version: 0.51
+Version: 0.65
Author: Mark-Jason Dominus (mjd-perl-memoize+@plover.com)
################################################################
The address is: mjd-perl-memoize+@plover.com.
################################################################
-What's new since 0.49:
+What's new since 0.62:
-Just a maintenance release. I made the tests a little more robust,
-and I included the Memoization article that I forgot to put into 0.48.
-################################################################
-What's new since 0.48:
-
-You can now expire data from the memoization cache according to any
-expiration policy you desire. A sample policy is provided in the
-Memoize::Expire module. It supports expiration of items that have
-been in the cache a certain number of seconds and items that have been
-accessed a certain number of times. When you call a memoized
-function, and Memoize discovers that a cache item has expired, it
-calls the real function and stores the result in the cache, just as if
-the data had not been in the cache in the first place.
-
-Many people asked for a cache expiration feature, and some people even
-sent patches. Thanks for the patches! But I did not accept them,
-because they all added the expiration stuff into the module, and I was
-sure that this was a bad way to do it. Everyone had a different idea
-of what useful expiration behavior was, so I foresaw an endless series
-of creeeping features and an expiration mechansim that got more and
-more and more complicated and slower and slower and slower.
-
-The new expiration policy mechanism makes use of the TIE feature. You
-write a cache policy module ( which might be very simple) and use the
-TIE feature to insert it between memoize and the real cache. The
-Memoize::Expire module. included in this package, is a useful example
-of this that might satisfy many people. The documentation for that
-module includes an even simpler module for those who would like to
-implement their own expiration policies.
-
-Big win: If you don't use the expiration feature, you don't pay for
-it. Memoize 0.49 with expiration turned off runs *exactly* as fast as
-Memoize 0.48 did. Not one line of code has been changed.
-
-Moral of the story: Sometimes, there is a Right Way to Do Things that
-really is better than the obvious way. It might not be obvious at
-first, and sometimes you have to make people wait for features so that
-the Right Way to Do Things can make itself known.
-
-Many thanks to Mike Cariaso for helping me figure out The Right Way to
-Do Things.
-
-Also: If you try to use ODBM_File, NDBM_File, SDBM_File, GDBM_File, or
-DB_File for the LIST_CACHE, you get an error right away, because those
-kinds of files will only store strings. Thanks to Jonathan Roy for
-suggesting this. If you want to store list values in a persistent
-cache, try Memoize::Storable.
-
-################################################################
-
-What's new since 0.46:
-
-Caching of function return values into NDBM files is now supported.
-You can cache function return values into Memoize::AnyDBM files, which
-is a pseudo-module that selects the `best' available DBM
-implementation.
-
-Bug fix: Prototyped functions are now memoized correctly; memoizing
-used to remove the prototype and issue a warning. Also new tests for
-this feature. (Thanks Alex Dudkevich)
-
-New test suites for SDBM and NDBM caching and prototyped functions.
-Various small fixes in the test suite.
-Various documentation enhancements and fixes.
-
-################################################################
-
-What's new since 0.45:
-
-Now has an interface to `Storable'. This wasn't formerly possible,
-because the base package can only store caches via modules that
-present a tied hash interface, and `Storable' doesn't. Solution:
-Memoize::Storable is a tied hash interface to `Storable'.
-
-################################################################
-
-What's new since 0.06:
-
-Storage of cached function return values in a static file is now
-tentatively supported. `memoize' now accepts new options SCALAR_CACHE
-and LIST_CACHE to specify the destination and protocol for saving
-cached values to disk.
-
-Consider these features alpha, and please report bugs to
-mjd-perl-memoize@plover.com. The beta version is awaiting a more
-complete test suite.
-
-Much new documentation to support all this.
-
-################################################################
-
-What's new since 0.05:
-
-Calling syntax is now
-
- memoize(function, OPTION1 => VALUE1, ...)
-
-instead of
-
- memoize(function, { OPTION1 => VALUE1, ... })
-
-
-Functions that return lists can now be memoized.
-
-New tests for list-returning functions and their normalizers.
-
-Various documentation changes.
-
-Return value from `unmemoize' is now the resulting unmemoized
-function, instead of the constant `1'. It was already docmuented to
-do so.
-
-################################################################
-
-
-=head1 NAME
-
-Memoize - Make your functions faster by trading space for time
-
-=head1 SYNOPSIS
-
- use Memoize;
- memoize('slow_function');
- slow_function(arguments); # Is faster than it was before
-
-
-This is normally all you need to know. However, many options are available:
-
- memoize(function, options...);
-
-Options include:
-
- NORMALIZER => function
- INSTALL => new_name
-
- SCALAR_CACHE => 'MEMORY'
- SCALAR_CACHE => ['TIE', Module, arguments...]
- SCALAR_CACHE => 'FAULT'
- SCALAR_CACHE => 'MERGE'
-
- LIST_CACHE => 'MEMORY'
- LIST_CACHE => ['TIE', Module, arguments...]
- LIST_CACHE => 'FAULT'
- LIST_CACHE => 'MERGE'
-
-
-=head1 DESCRIPTION
-
-`Memoizing' a function makes it faster by trading space for time. It
-does this by caching the return values of the function in a table.
-If you call the function again with the same arguments, C<memoize>
-jmups in and gives you the value out of the table, instead of letting
-the function compute the value all over again.
-
-Here is an extreme example. Consider the Fibonacci sequence, defined
-by the following function:
-
- # Compute Fibonacci numbers
- sub fib {
- my $n = shift;
- return $n if $n < 2;
- fib($n-1) + fib($n-2);
- }
-
-This function is very slow. Why? To compute fib(14), it first wants
-to compute fib(13) and fib(12), and add the results. But to compute
-fib(13), it first has to compute fib(12) and fib(11), and then it
-comes back and computes fib(12) all over again even though the answer
-is the same. And both of the times that it wants to compute fib(12),
-it has to compute fib(11) from scratch, and then it has to do it
-again each time it wants to compute fib(13). This function does so
-much recomputing of old results that it takes a really long time to
-run---fib(14) makes 1,200 extra recursive calls to itself, to compute
-and recompute things that it already computed.
-
-This function is a good candidate for memoization. If you memoize the
-`fib' function above, it will compute fib(14) exactly once, the first
-time it needs to, and then save the result in a table. Then if you
-ask for fib(14) again, it gives you the result out of the table.
-While computing fib(14), instead of computing fib(12) twice, it does
-it once; the second time it needs the value it gets it from the table.
-It doesn't compute fib(11) four times; it computes it once, getting it
-from the table the next three times. Instead of making 1,200
-recursive calls to `fib', it makes 15. This makes the function about
-150 times faster.
-
-You could do the memoization yourself, by rewriting the function, like
-this:
-
- # Compute Fibonacci numbers, memoized version
- { my @fib;
- sub fib {
- my $n = shift;
- return $fib[$n] if defined $fib[$n];
- return $fib[$n] = $n if $n < 2;
- $fib[$n] = fib($n-1) + fib($n-2);
- }
- }
-
-Or you could use this module, like this:
-
- use Memoize;
- memoize('fib');
-
- # Rest of the fib function just like the original version.
-
-This makes it easy to turn memoizing on and off.
-
-Here's an even simpler example: I wrote a simple ray tracer; the
-program would look in a certain direction, figure out what it was
-looking at, and then convert the `color' value (typically a string
-like `red') of that object to a red, green, and blue pixel value, like
-this:
-
- for ($direction = 0; $direction < 300; $direction++) {
- # Figure out which object is in direction $direction
- $color = $object->{color};
- ($r, $g, $b) = @{&ColorToRGB($color)};
- ...
- }
-
-Since there are relatively few objects in a picture, there are only a
-few colors, which get looked up over and over again. Memoizing
-C<ColorToRGB> speeded up the program by several percent.
-
-=head1 DETAILS
-
-This module exports exactly one function, C<memoize>. The rest of the
-functions in this package are None of Your Business.
-
-You should say
-
- memoize(function)
-
-where C<function> is the name of the function you want to memoize, or
-a reference to it. C<memoize> returns a reference to the new,
-memoized version of the function, or C<undef> on a non-fatal error.
-At present, there are no non-fatal errors, but there might be some in
-the future.
-
-If C<function> was the name of a function, then C<memoize> hides the
-old version and installs the new memoized version under the old name,
-so that C<&function(...)> actually invokes the memoized version.
-
-=head1 OPTIONS
-
-There are some optional options you can pass to C<memoize> to change
-the way it behaves a little. To supply options, invoke C<memoize>
-like this:
-
- memoize(function, NORMALIZER => function,
- INSTALL => newname,
- SCALAR_CACHE => option,
- LIST_CACHE => option
- );
-
-Each of these options is optional; you can include some, all, or none
-of them.
-
-=head2 INSTALL
-
-If you supply a function name with C<INSTALL>, memoize will install
-the new, memoized version of the function under the name you give.
-For example,
-
- memoize('fib', INSTALL => 'fastfib')
-
-installs the memoized version of C<fib> as C<fastfib>; without the
-C<INSTALL> option it would have replaced the old C<fib> with the
-memoized version.
-
-To prevent C<memoize> from installing the memoized version anywhere, use
-C<INSTALL =E<gt> undef>.
-
-=head2 NORMALIZER
-
-Suppose your function looks like this:
-
- # Typical call: f('aha!', A => 11, B => 12);
- sub f {
- my $a = shift;
- my %hash = @_;
- $hash{B} ||= 2; # B defaults to 2
- $hash{C} ||= 7; # C defaults to 7
-
- # Do something with $a, %hash
- }
-
-Now, the following calls to your function are all completely equivalent:
-
- f(OUCH);
- f(OUCH, B => 2);
- f(OUCH, C => 7);
- f(OUCH, B => 2, C => 7);
- f(OUCH, C => 7, B => 2);
- (etc.)
-
-However, unless you tell C<Memoize> that these calls are equivalent,
-it will not know that, and it will compute the values for these
-invocations of your function separately, and store them separately.
-
-To prevent this, supply a C<NORMALIZER> function that turns the
-program arguments into a string in a way that equivalent arguments
-turn into the same string. A C<NORMALIZER> function for C<f> above
-might look like this:
-
- sub normalize_f {
- my $a = shift;
- my %hash = @_;
- $hash{B} ||= 2;
- $hash{C} ||= 7;
-
- join($;, $a, map ($_ => $hash{$_}) sort keys %hash);
- }
-
-Each of the argument lists above comes out of the C<normalize_f>
-function looking exactly the same, like this:
-
- OUCH^\B^\2^\C^\7
-
-You would tell C<Memoize> to use this normalizer this way:
-
- memoize('f', NORMALIZER => 'normalize_f');
-
-C<memoize> knows that if the normalized version of the arguments is
-the same for two argument lists, then it can safely look up the value
-that it computed for one argument list and return it as the result of
-calling the function with the other argument list, even if the
-argument lists look different.
-
-The default normalizer just concatenates the arguments with C<$;> in
-between. This always works correctly for functions with only one
-argument, and also when the arguments never contain C<$;> (which is
-normally character #28, control-\. ) However, it can confuse certain
-argument lists:
-
- normalizer("a\034", "b")
- normalizer("a", "\034b")
- normalizer("a\034\034b")
-
-for example.
-
-The calling context of the function (scalar or list context) is
-propagated to the normalizer. This means that if the memoized
-function will treat its arguments differently in list context than it
-would in scalar context, you can have the normalizer function select
-its behavior based on the results of C<wantarray>. Even if called in
-a list context, a normalizer should still return a single string.
-
-=head2 C<SCALAR_CACHE>, C<LIST_CACHE>
-
-Normally, C<Memoize> caches your function's return values into an
-ordinary Perl hash variable. However, you might like to have the
-values cached on the disk, so that they persist from one run of your
-program to the next, or you might like to associate some other
-interesting semantics with the cached values.
-
-There's a slight complication under the hood of C<Memoize>: There are
-actually I<two> caches, one for scalar values and one for list values.
-When your function is called in scalar context, its return value is
-cached in one hash, and when your function is called in list context,
-its value is cached in the other hash. You can control the caching
-behavior of both contexts independently with these options.
-
-The argument to C<LIST_CACHE> or C<SCALAR_CACHE> must either be one of
-the following four strings:
-
- MEMORY
- TIE
- FAULT
- MERGE
-
-or else it must be a reference to a list whose first element is one of
-these four strings, such as C<[TIE, arguments...]>.
-
-=over 4
-
-=item C<MEMORY>
-
-C<MEMORY> means that return values from the function will be cached in
-an ordinary Perl hash variable. The hash variable will not persist
-after the program exits. This is the default.
-
-=item C<TIE>
-
-C<TIE> means that the function's return values will be cached in a
-tied hash. A tied hash can have any semantics at all. It is
-typically tied to an on-disk database, so that cached values are
-stored in the database and retrieved from it again when needed, and
-the disk file typically persists after your pogram has exited.
-
-If C<TIE> is specified as the first element of a list, the remaining
-list elements are taken as arguments to the C<tie> call that sets up
-the tied hash. For example,
-
- SCALAR_CACHE => [TIE, DB_File, $filename, O_RDWR | O_CREAT, 0666]
-
-says to tie the hash into the C<DB_File> package, and to pass the
-C<$filename>, C<O_RDWR | O_CREAT>, and C<0666> arguments to the C<tie>
-call. This has the effect of storing the cache in a C<DB_File>
-database whose name is in C<$filename>.
-
-Other typical uses of C<TIE>:
-
- LIST_CACHE => [TIE, GDBM_File, $filename, O_RDWR | O_CREAT, 0666]
- SCALAR_CACHE => [TIE, MLDBM, DB_File, $filename, O_RDWR|O_CREAT, 0666]
- LIST_CACHE => [TIE, My_Package, $tablename, $key_field, $val_field]
-
-This last might tie the cache hash to a package that you wrote
-yourself that stores the cache in a SQL-accessible database.
-A useful use of this feature: You can construct a batch program that
-runs in the background and populates the memo table, and then when you
-come to run your real program the memoized function will be
-screamingly fast because all its results have been precomputed.
-
-=item C<FAULT>
-
-C<FAULT> means that you never expect to call the function in scalar
-(or list) context, and that if C<Memoize> detects such a call, it
-should abort the program. The error message is one of
-
- `foo' function called in forbidden list context at line ...
- `foo' function called in forbidden scalar context at line ...
-
-=item C<MERGE>
-
-C<MERGE> normally means the function does not distinguish between list
-and sclar context, and that return values in both contexts should be
-stored together. C<LIST_CACHE =E<gt> MERGE> means that list context
-return values should be stored in the same hash that is used for
-scalar context returns, and C<SCALAR_CACHE =E<gt> MERGE> means the
-same, mutatis mutandis. It is an error to specify C<MERGE> for both,
-but it probably does something useful.
-
-Consider this function:
-
- sub pi { 3; }
-
-Normally, the following code will result in two calls to C<pi>:
-
- $x = pi();
- ($y) = pi();
- $z = pi();
-
-The first call caches the value C<3> in the scalar cache; the second
-caches the list C<(3)> in the list cache. The third call doesn't call
-the real C<pi> function; it gets the value from the scalar cache.
-
-Obviously, the second call to C<pi> is a waste of time, and storing
-its return value is a waste of space. Specifying C<LIST_CACHE
-=E<gt> MERGE> will make C<memoize> use the same cache for scalar and
-list context return values, so that the second call uses the scalar
-cache that was populated by the first call. C<pi> ends up being
-cvalled only once, and both subsequent calls return C<3> from the
-cache, regardless of the calling context.
-
-Another use for C<MERGE> is when you want both kinds of return values
-stored in the same disk file; this saves you from having to deal with
-two disk files instead of one. You can use a normalizer function to
-keep the two sets of return values separate. For example:
-
- memoize 'myfunc',
- NORMALIZER => 'n',
- SCALAR_CACHE => [TIE, MLDBM, DB_File, $filename, ...],
- LIST_CACHE => MERGE,
- ;
-
- sub n {
- my $context = wantarray() ? 'L' : 'S';
- # ... now compute the hash key from the arguments ...
- $hashkey = "$context:$hashkey";
- }
-
-This normalizer function will store scalar context return values in
-the disk file under keys that begin with C<S:>, and list context
-return values under keys that begin with C<L:>.
-
-=back
-
-=head1 OTHER FUNCTION
-
-There's an C<unmemoize> function that you can import if you want to.
-Why would you want to? Here's an example: Suppose you have your cache
-tied to a DBM file, and you want to make sure that the cache is
-written out to disk if someone interrupts the program. If the program
-exits normally, this will happen anyway, but if someone types
-control-C or something then the program will terminate immediately
-without syncronizing the database. So what you can do instead is
-
- $SIG{INT} = sub { unmemoize 'function' };
-
-
-Thanks to Jonathan Roy for discovering a use for C<unmemoize>.
-
-C<unmemoize> accepts a reference to, or the name of a previously
-memoized function, and undoes whatever it did to provide the memoized
-version in the first place, including making the name refer to the
-unmemoized version if appropriate. It returns a reference to the
-unmemoized version of the function.
-
-If you ask it to unmemoize a function that was never memoized, it
-croaks.
-
-=head1 CAVEATS
-
-Memoization is not a cure-all:
-
-=over 4
-
-=item *
-
-Do not memoize a function whose behavior depends on program
-state other than its own arguments, such as global variables, the time
-of day, or file input. These functions will not produce correct
-results when memoized. For a particularly easy example:
-
- sub f {
- time;
- }
-
-This function takes no arguments, and as far as C<Memoize> is
-concerned, it always returns the same result. C<Memoize> is wrong, of
-course, and the memoized version of this function will call C<time> once
-to get the current time, and it will return that same time
-every time you call it after that.
-
-=item *
-
-Do not memoize a function with side effects.
-
- sub f {
- my ($a, $b) = @_;
- my $s = $a + $b;
- print "$a + $b = $s.\n";
- }
-
-This function accepts two arguments, adds them, and prints their sum.
-Its return value is the numuber of characters it printed, but you
-probably didn't care about that. But C<Memoize> doesn't understand
-that. If you memoize this function, you will get the result you
-expect the first time you ask it to print the sum of 2 and 3, but
-subsequent calls will return the number 11 (the return value of
-C<print>) without actually printing anything.
-
-=item *
-
-Do not memoize a function that returns a data structure that is
-modified by its caller.
-
-Consider these functions: C<getusers> returns a list of users somehow,
-and then C<main> throws away the first user on the list and prints the
-rest:
-
- sub main {
- my $userlist = getusers();
- shift @$userlist;
- foreach $u (@$userlist) {
- print "User $u\n";
- }
- }
-
- sub getusers {
- my @users;
- # Do something to get a list of users;
- \@users; # Return reference to list.
- }
-
-If you memoize C<getusers> here, it will work right exactly once. The
-reference to the users list will be stored in the memo table. C<main>
-will discard the first element from the referenced list. The next
-time you invoke C<main>, C<Memoize> will not call C<getusers>; it will
-just return the same reference to the same list it got last time. But
-this time the list has already had its head removed; C<main> will
-erroneously remove another element from it. The list will get shorter
-and shorter every time you call C<main>.
-
-
-=back
-
-=head1 PERSISTENT CACHE SUPPORT
-
-You can tie the cache tables to any sort of tied hash that you want
-to, as long as it supports C<TIEHASH>, C<FETCH>, C<STORE>, and
-C<EXISTS>. For example,
-
- memoize 'function', SCALAR_CACHE =>
- [TIE, GDBM_File, $filename, O_RDWR|O_CREAT, 0666];
-
-works just fine. For some storage methods, you need a little glue.
-
-C<SDBM_File> doesn't supply an C<EXISTS> method, so included in this
-package is a glue module called C<Memoize::SDBM_File> which does
-provide one. Use this instead of plain C<SDBM_File> to store your
-cache table on disk in an C<SDBM_File> database:
-
- memoize 'function',
- SCALAR_CACHE =>
- [TIE, Memoize::SDBM_File, $filename, O_RDWR|O_CREAT, 0666];
-
-C<NDBM_File> has the same problem and the same solution.
-
-C<Storable> isn't a tied hash class at all. You can use it to store a
-hash to disk and retrieve it again, but you can't modify the hash while
-it's on the disk. So if you want to store your cache table in a
-C<Storable> database, use C<Memoize::Storable>, which puts a hashlike
-front-end onto C<Storable>. The hash table is actually kept in
-memory, and is loaded from your C<Storable> file at the time you
-memoize the function, and stored back at the time you unmemoize the
-function (or when your program exits):
-
- memoize 'function',
- SCALAR_CACHE => [TIE, Memoize::Storable, $filename];
-
- memoize 'function',
- SCALAR_CACHE => [TIE, Memoize::Storable, $filename, 'nstore'];
-
-Include the `nstore' option to have the C<Storable> database written
-in `network order'. (See L<Storable> for more details about this.)
-
-=head1 EXPIRATION SUPPORT
-
-See Memoize::Expire, which is a plug-in module that adds expiration
-functionality to Memoize. If you don't like the kinds of policies
-that Memoize::Expire implements, it is easy to write your own plug-in
-module to implement whatever policy you desire.
-
-=head1 MY BUGS
-
-Needs a better test suite, especially for the tied and expiration stuff.
-
-Also, there is some problem with the way C<goto &f> works under
-threaded Perl, because of the lexical scoping of C<@_>. This is a bug
-in Perl, and until it is resolved, Memoize won't work with these
-Perls. To fix it, you need to chop the source code a little. Find
-the comment in the source code that says C<--- THREADED PERL
-COMMENT---> and comment out the active line and uncomment the
-commented one. Then try it again.
-
-I wish I could investigate this threaded Perl problem. If someone
-could lend me an account on a machine with threaded Perl for a few
-hours, it would be very helpful.
-
-That is why the version number is 0.49 instead of 1.00.
-
-=head1 MAILING LIST
+ N O T I C E !
-To join a very low-traffic mailing list for announcements about
-C<Memoize>, send an empty note to C<mjd-perl-memoize-request@plover.com>.
+ ****************************************************************
+ ** **
+ ** The TIE option is now strongly deprecated. It will be **
+ ** permanently removed in the NEXT release of Memoize. **
+ ** Please convert all extant software to use HASH instead. **
+ ** **
+ ** See the manual for details. **
+ ** **
+ ****************************************************************
-=head1 AUTHOR
+I'm sorry about this. I hate making incompatible changes. But as of
+v0.65, Memoize is included in the Perl core. It is about to become
+much more difficult to make incompatible interface changes; if I don't
+get rid of TIE now, I may not get another chance.
-Mark-Jason Dominus (C<mjd-perl-memoize+@plover.com>), Plover Systems co.
+TIE presented serious problems. First, it had a bizarre syntax. But
+the big problem was that it was difficult and complicated for
+expiration manager authors to support; evern expiration manager had to
+duplicate the logic for handling TIE. HASH is much simpler to use,
+more powerful, and is trivial for expiration managers to support.
-See the C<Memoize.pm> Page at http://www.plover.com/~mjd/perl/Memoize/
-for news and upgrades. Near this page, at
-http://www.plover.com/~mjd/perl/MiniMemoize/ there is an article about
-memoization and about the internals of Memoize that appeared in The
-Perl Journal, issue #13. (This article is also included in the
-Memoize distribution as `article.html'.)
+Many long-awaited cleanups and bug fixes.
-To join a mailing list for announcements about C<Memoize>, send an
-empty message to C<mjd-perl-memoize-request@plover.com>. This mailing
-list is for announcements only and has extremely low traffic---about
-four messages per year.
+Memoize now works under threaded perl
-=head1 THANK YOU
+Slow tests speeded up. More test file improvements.
-Many thanks to Jonathan Roy for bug reports and suggestions, to
-Michael Schwern for other bug reports and patches, to Mike Cariaso for
-helping me to figure out the Right Thing to Do About Expiration, to
-Joshua Gerth, Joshua Chamas, Jonathan Roy, Mark D. Anderson, and
-Andrew Johnson for more suggestions about expiration, to Ariel
-Scolnikov for delightful messages about the Fibonacci function, to
-Dion Almaer for thought-provoking suggestions about the default
-normalizer, to Walt Mankowski and Kurt Starsinic for much help
-investigating problems under threaded Perl, to Alex Dudkevich for
-reporting the bug in prototyped functions and for checking my patch,
-to Tony Bass for many helpful suggestions, to Philippe Verdret for
-enlightening discussion of Hook::PrePostCall, to Nat Torkington for
-advice I ignored, to Chris Nandor for portability advice, and to Jenda
-Krynicky for being a light in the world.
+Long-standing LIST_CACHE bug cleared up---it turns out that there
+never was a bug. I put in tests for it anyway.
-=cut
+Manual increased.
use SDBM_File;
@ISA = qw(SDBM_File);
+$VERSION = 0.65;
$Verbose = 0;
package Memoize::Saves;
+$VERSION = 0.65;
+
$DEBUG = 0;
sub TIEHASH
{
my ($package, %args) = @_;
- my %cache;
+ my $cache = $args{HASH} || {};
# Convert the CACHE to a referenced hash for quick lookup
#
if ($@) {
die "Memoize::Saves: Couldn't load hash tie module `$module': $@; aborting";
}
- my $rc = (tie %cache => $module, @opts);
+ my $rc = (tie %$cache => $module, @opts);
unless ($rc) {
die "Memoize::Saves: Couldn't tie hash to `$module': $@; aborting";
}
}
- $args{C} = \%cache;
+ $args{C} = $cache;
bless \%args => $package;
}
CACHE => [ "word1", "word2" ],
DUMP => [ "word3", "word4" ],
REGEX => "Regular Expression",
- TIE => [Module, args...],
- ],
+ HASH => $cache_hashref,
+ ],
=head1 DESCRIPTION
Specifying multiple options will result in the least common denominator
being saved.
-You can use the TIE option to string multiple Memoize Plug-ins together:
-
+You can use the HASH option to string multiple Memoize Plug-ins together:
-memoize ('printme',
- SCALAR_CACHE =>
- [TIE, Memoize::Saves,
- REGEX => qr/my/,
- TIE => [Memoize::Expire,
- LIFETIME => 5,
- TIE => [ GDBM_File, $filename,
- O_RDWR | O_CREAT, 0666]
- ]
- ]
- );
+ tie my %disk_hash => 'GDBM_File', $filename, O_RDWR|O_CREAT, 0666;
+ tie my %expiring_cache => 'Memoize::Expire',
+ LIFETIME => 5, HASH => \%disk_cache;
+ tie my %cache => 'Memoize::Saves',
+ REGEX => qr/my/, HASH => \%expiring_cache;
+ memoize ('printme', SCALAR_CACHE => [HASH => \%cache]);
=head1 CAVEATS
This module is experimental, and may contain bugs. Please report bugs
-to the address below.
+to C<mjd-perl-memoize+@plover.com>.
If you are going to use Memoize::Saves with Memoize::Expire it is
-import to use it in that order. Memoize::Expire changes the return
+important to use it in that order. Memoize::Expire changes the return
value to include expire information and it may no longer match
your CACHE, DUMP, or REGEX.
perl(1)
-The Memoize man page.
+L<Memoize>
=cut
use Storable ();
+$VERSION = 0.65;
$Verbose = 0;
sub TIEHASH {
strings. This should at least be documented. Maybe Memoize could
detect the problem at TIE time and throw a fatal error.
+20010623 This was added sometime prior to 20001025.
+
Try out MLDBM here and document it if it works.
=item *
Don't forget about generic interface to Storable-like packages
-=item *
+20010627 It would appear that you put this into 0.51.
+=item *
Maybe add in TODISK after all, with TODISK => 'filename' equivalent to
test this theory? Line 59, currently commented out, may fix the
problem.
+20010623 Working around this in 0.65, but it still blows.
+
=item *
Maybe if the original function has a prototype, the module can use
=item *
-I found a use for `unmemoize'. If you're using the Storable glue, and
-your program gets SIGINT, you find that the cache data is not in the
-cache, because Perl normally writes it all out at once from a
-DESTROY method, and signals skip DESTROY processing. So you could add
+Jonathan Roy found a use for `unmemoize'. If you're using the
+Storable glue, and your program gets SIGINT, you find that the cache
+data is not in the cache, because Perl normally writes it all out at
+once from a DESTROY method, and signals skip DESTROY processing. So
+you could add
$sig{INT} = sub { unmemoize ... };
-(Jonathan Roy pointed this out)
=item *
scalar-only, and the check for scalar-only ties is missing from
Memoize::Expire. The inheritable method can take care of this.
+20010623 I decided not to put it in. Instead, we avoid the problem by
+getting rid of TIE. The HASH option does the same thing, and HASH is
+so simple to support that a module is superfluous.
+
=item *
20001130 Custom cache manager that checks to make sure the function
normalizer could make the adjustments and save the changes in @_, you
wouldn't have to do it twice.
+=item*
+20010623 Add CLEAR methods to tied hash modules.
+
+=item*
+20010623 You get a warning if you try to use DB_File as LIST_CACHE,
+because it won't store lists. But if you use it as the underlying
+cache with an expiration manager in the middle, no warning---the
+expiration manager doesn't know it's managing a list cache, and
+memoize doesn't know that DB_File is underlying. Is this fixable?
+Probably not, but think about it.
+
=item *
There was probably some other stuff that I forgot.
--- /dev/null
+#!/usr/bin/perl
+
+use lib '..';
+use Memoize 'memoize', 'unmemoize';
+
+sub reff {
+ return [1,2,3];
+
+}
+
+sub listf {
+ return (1,2,3);
+}
+
+print "1..6\n";
+
+memoize 'reff', LIST_CACHE => 'MERGE';
+print "ok 1\n";
+memoize 'listf';
+print "ok 2\n";
+
+$s = reff();
+@a = reff();
+print @a == 1 ? "ok 3\n" : "not ok 3\n";
+
+$s = listf();
+@a = listf();
+print @a == 3 ? "ok 4\n" : "not ok 4\n";
+
+unmemoize 'reff';
+memoize 'reff', LIST_CACHE => 'MERGE';
+unmemoize 'listf';
+memoize 'listf';
+
+@a = reff();
+$s = reff();
+print @a == 1 ? "ok 5\n" : "not ok 5\n";
+
+@a = listf();
+$s = listf();
+print @a == 3 ? "ok 6\n" : "not ok 6\n";
+
+
# 4--8
$n = 4;
+my $dummyfile = './dummydb';
+use Fcntl;
+my %args = ( DB_File => [],
+ GDBM_File => [$dummyfile, 2, 0666],
+ ODBM_File => [$dummyfile, O_RDWR|O_CREAT, 0666],
+ NDBM_File => [$dummyfile, O_RDWR|O_CREAT, 0666],
+ SDBM_File => [$dummyfile, O_RDWR|O_CREAT, 0666],
+ );
for $mod (qw(DB_File GDBM_File SDBM_File ODBM_File NDBM_File)) {
- eval { memoize(sub {}, LIST_CACHE => ['TIE', $mod]) };
- print $@ ? "ok $n\n" : "not ok $n # $@\n";
+ eval {
+ require "$mod.pm";
+ tie my %cache => $mod, @{$args{$mod}};
+ memoize(sub {}, LIST_CACHE => [HASH => \%cache ]);
+ };
+ print $@ =~ /can only store scalars/
+ || $@ =~ /Can't locate.*in \@INC/ ? "ok $n\n" : "not ok $n # $@\n";
+ 1 while unlink $dummyfile;
$n++;
}
# 9
-eval { memoize(sub {}, LIST_CACHE => ['TIE', WuggaWugga]) };
+eval { local $^W = 0;
+ memoize(sub {}, LIST_CACHE => ['TIE', 'WuggaWugga'])
+ };
print $@ ? "ok 9\n" : "not ok 9 # $@\n";
# 10
$arg;
}
-memoize 'id', SCALAR_CACHE => ['TIE', 'Memoize::ExpireTest'],
+tie my %cache => 'Memoize::ExpireTest';
+memoize 'id',
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT';
$n++; print "ok $n\n";
exit 0;
}
-print "1..11\n";
+print "1..12\n";
++$n; print "ok $n\n";
$data;
}
+require Memoize::ExpireFile;
+++$n; print "ok $n\n";
+
+tie my %cache => 'Memoize::ExpireFile';
memoize 'readfile',
- SCALAR_CACHE => ['TIE', 'Memoize::ExpireFile', ],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
++$n; print ((($READFILE_CALLS == 2) ? '' : 'not '), "ok $n\n");
++$n; print ((($t1 ne $t3) ? '' : 'not '), "ok $n\n");
-END { 1 while unlink 'TESTFILE' }
+END { 1 while unlink $FILE }
my $n = 0;
-print "1..21\n";
+print "1..22\n";
++$n; print "ok $n\n";
$RETURN;
}
+require Memoize::Expire;
+++$n; print "ok $n\n";
+
+tie my %cache => 'Memoize::Expire', NUM_USES => 2;
memoize 'call',
- SCALAR_CACHE => ['TIE', 'Memoize::Expire', NUM_USES => 2],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT';
# $Memoize::Expire::DEBUG = 1;
print "not " unless $CALLS{$_} == (1,2,2,1)[$_];
++$n; print "ok $n\n";
}
-
-
use lib '..';
use Memoize;
+use Time::HiRes 'time';
+my $DEBUG = 0;
my $n = 0;
+$| = 1;
if (-e '.fast') {
print "1..0\n";
exit 0;
}
-print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
+# Perhaps nobody will notice if we don't say anything
+# print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";
-print "1..14\n";
+print "1..15\n";
+$| = 1;
++$n; print "ok $n\n";
+require Memoize::Expire;
+++$n; print "ok $n\n";
+
sub close_enough {
# print "Close enough? @_[0,1]\n";
abs($_[0] - $_[1]) <= 1;
}
+my $t0;
+sub start_timer {
+ $t0 = time;
+ $DEBUG and print "# $t0\n";
+}
+
+sub wait_until {
+ my $until = shift();
+ my $diff = $until - (time() - $t0);
+ $DEBUG and print "# until $until; diff = $diff\n";
+ return if $diff <= 0;
+ select undef, undef, undef, $diff;
+}
+
sub now {
# print "NOW: @_ ", time(), "\n";
time;
}
+tie my %cache => 'Memoize::Expire', LIFETIME => 8;
memoize 'now',
- SCALAR_CACHE => ['TIE', 'Memoize::Expire', LIFETIME => 15],
+ SCALAR_CACHE => [HASH => \%cache ],
LIST_CACHE => 'FAULT'
;
# T
+start_timer();
for (1,2,3) {
$when{$_} = now($_);
++$n;
- print "not " unless $when{$_} == time;
+ print "not " unless close_enough($when{$_}, time());
print "ok $n\n";
- sleep 5 if $_ < 3;
+ sleep 3 if $_ < 3;
+ $DEBUG and print "# ", time()-$t0, "\n";
}
+# values will now expire at T=8, 11, 14
+# it is now T=6
-# T+10
+# T+6
for (1,2,3) {
- $again{$_} = now($_); # Should be the sameas before, because of memoization
+ $again{$_} = now($_); # Should be the same as before, because of memoization
}
-# T+10
+# T+6
foreach (1,2,3) {
++$n;
- print "not " unless $when{$_} == $again{$_};
+ print "not " unless close_enough($when{$_}, $again{$_});
print "ok $n\n";
}
-sleep 6; # now(1) expires
-
-# T+16
+wait_until(9.5); # now(1) expires
print "not " unless close_enough(time, $again{1} = now(1));
++$n; print "ok $n\n";
-# T+16
-foreach (2,3) { # Have not expired yet.
+# T+9.5
+foreach (2,3) { # Should not have expired yet.
++$n;
- print "not " unless now($_) == $again{$_};
+ print "not " unless close_enough(scalar(now($_)), $again{$_});
print "ok $n\n";
}
-sleep 6; # now(2) expires
+wait_until(12.5); # now(2) expires
-# T+22
+# T+12.5
print "not " unless close_enough(time, $again{2} = now(2));
++$n; print "ok $n\n";
-# T+22
-foreach (1,3) {
+# T+12.5
+foreach (1,3) { # 1 is good again because it was recomputed after it expired
++$n;
- print "not " unless now($_) == $again{$_};
+ print "not " unless close_enough(scalar(now($_)), $again{$_});
print "ok $n\n";
}
-
print "1..0\n";
exit 0;
}
+$| = 1;
+
+# If we don't say anything, maybe nobody will notice.
+# print STDERR "\nWarning: I'm testing the speedup. This might take up to thirty seconds.\n ";
-print "# Warning: I'm testing the speedup. This might take up to sixty seconds.\n";
print "1..6\n";
+# This next test finds an example that takes a long time to run, then
+# checks to make sure that the run is actually speeded up by memoization.
+# In some sense, this is the most essential correctness test in the package.
+#
+# We do this by running the fib() function with successfily larger
+# arguments until we find one that tales at leasrtt $LONG_RUN seconds
+# to execute. Then we memoize fib() and run the same call cagain. If
+# it doesn't produce the same test in less than one-tenth the time,
+# something is seriously wrong.
+#
+# $LONG_RUN is the number of seconds that the function call must last
+# in order for the call to be considered sufficiently long.
+
+
sub fib {
my $n = shift;
$COUNT++;
fib($n-1) + fib($n-2);
}
-$N = 0;
+sub max { $_[0] > $_[1] ?
+ $_[0] : $_[1]
+ }
+
+$N = 1;
$ELAPSED = 0;
-until ($ELAPSED > 10) {
- $N++;
+
+my $LONG_RUN = 10;
+
+while (1) {
my $start = time;
$COUNT=0;
$RESULT = fib($N);
$ELAPSED = time - $start;
- print "# fib($N) took $ELAPSED seconds.\n" if $N % 1 == 0;
+ last if $ELAPSED >= $LONG_RUN;
+ if ($ELAPSED > 1) {
+ print "# fib($N) took $ELAPSED seconds.\n" if $N % 1 == 0;
+ # we'd expect that fib(n+1) takes about 1.618 times as long as fib(n)
+ # so now that we have a longish run, let's estimate the value of $N
+ # that will get us a sufficiently long run.
+ $N += 1 + int(log($LONG_RUN/$ELAPSED)/log(1.618));
+ print "# OK, N=$N ought to do it.\n";
+ # It's important not to overshoot here because the running time
+ # is exponential in $N. If we increase $N too aggressively,
+ # the user will be forced to wait a very long time.
+ } else {
+ $N++;
+ }
}
print "# OK, fib($N) was slow enough; it took $ELAPSED seconds.\n";
-
+print "# Total calls: $COUNT.\n";
&memoize('fib');
print (($COUNT > $N) ? "ok 3\n" : "not ok 3\n");
# Do it again. Should be even faster this time.
+$COUNT = 0;
$start = time;
$RESULT2 = fib($N);
$ELAPSED2 = time - $start + .001; # prevent division by 0 errors
-
print (($RESULT == $RESULT2) ? "ok 4\n" : "not ok 4\n");
print (($ELAPSED/$ELAPSED2 > 10) ? "ok 5\n" : "not ok 5\n");
# This time it shouldn't have called the function at all.
-print ($COUNT ? "ok 6\n" : "not ok 6\n");
+print ($COUNT == 0 ? "ok 6\n" : "not ok 6\n");
}
$file = catfile($tmpdir, "md$$");
@files = ($file, "$file.db", "$file.dir", "$file.pag");
-{
- my @present = grep -e, @files;
- if (@present && (@failed = grep { not unlink } @present)) {
- warn "Can't unlink @failed! ($!)";
- }
-}
+1 while unlink @files;
tryout('Memoize::AnyDBM_File', $file, 1); # Test 1..4
# tryout('DB_File', $file, 1); # Test 1..4
-unlink $file, "$file.dir", "$file.pag";
+1 while unlink $file, "$file.dir", "$file.pag";
sub tryout {
my ($tiepack, $file, $testno) = @_;
+ tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666
+ or die $!;
memoize 'c5',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR | O_CREAT, 0666],
- LIST_CACHE => 'FAULT'
+ SCALAR_CACHE => [HASH => \%cache],
+ LIST_CACHE => 'FAULT'
;
my $t1 = c5($ARG);
# Now something tricky---we'll memoize c23 with the wrong table that
# has the 5 already cached.
memoize 'c23',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR, 0666],
+ SCALAR_CACHE => ['HASH', \%cache],
LIST_CACHE => 'FAULT'
;
}
$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
$file = catfile($tmpdir, "md$$");
-unlink $file, "$file.dir", "$file.pag";
+1 while unlink $file, "$file.dir", "$file.pag";
tryout('GDBM_File', $file, 1); # Test 1..4
-unlink $file, "$file.dir", "$file.pag";
+1 while unlink $file, "$file.dir", "$file.pag";
sub tryout {
+ require GDBM_File;
my ($tiepack, $file, $testno) = @_;
+ tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666
+ or die $!;
memoize 'c5',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR | O_CREAT, 0666],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
# Now something tricky---we'll memoize c23 with the wrong table that
# has the 5 already cached.
memoize 'c23',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR, 0666],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
}
$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
$file = catfile($tmpdir, "md$$");
-unlink $file, "$file.dir", "$file.pag";
+1 while unlink $file, "$file.dir", "$file.pag";
tryout('Memoize::NDBM_File', $file, 1); # Test 1..4
-unlink $file, "$file.dir", "$file.pag";
+1 while unlink $file, "$file.dir", "$file.pag";
sub tryout {
my ($tiepack, $file, $testno) = @_;
+ tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666
+ or die $!;
+
memoize 'c5',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR | O_CREAT, 0666],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
# Now something tricky---we'll memoize c23 with the wrong table that
# has the 5 already cached.
memoize 'c23',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR, 0666],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
use lib qw(. ..);
use Memoize 0.45 qw(memoize unmemoize);
use Fcntl;
-# use Memoize::GDBM_File;
+use Memoize::SDBM_File;
# $Memoize::GDBM_File::Verbose = 0;
sub i {
$_[0]+1;
}
-eval {require GDBM_File};
+eval {require SDBM_File};
if ($@) {
print "1..0\n";
exit 0;
}
$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
$file = catfile($tmpdir, "md$$");
-unlink $file, "$file.dir", "$file.pag";
-tryout('GDBM_File', $file, 1); # Test 1..4
-unlink $file, "$file.dir", "$file.pag";
+1 while unlink $file, "$file.dir", "$file.pag";
+tryout('Memoize::SDBM_File', $file, 1); # Test 1..4
+1 while unlink $file, "$file.dir", "$file.pag";
sub tryout {
my ($tiepack, $file, $testno) = @_;
+ tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666
+ or die $!;
memoize 'c5',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR | O_CREAT, 0666],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
# Now something tricky---we'll memoize c23 with the wrong table that
# has the 5 already cached.
memoize 'c23',
- SCALAR_CACHE => ['TIE', $tiepack, $file, O_RDWR, 0666],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
use lib qw(. ..);
use Memoize 0.45 qw(memoize unmemoize);
-# use Memoize::Storable;
+use Memoize::Storable;
# $Memoize::Storable::Verbose = 0;
+eval {require GDBM_File};
+if ($@) {
+ print "1..0\n";
+ exit 0;
+}
+
sub i {
$_[0];
}
}
$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
$file = catfile($tmpdir, "storable$$");
-unlink $file;
+1 while unlink $file;
tryout('Memoize::Storable', $file, 1); # Test 1..4
-unlink $file;
+1 while unlink $file;
sub tryout {
my ($tiepack, $file, $testno) = @_;
+ tie my %cache => $tiepack, $file
+ or die $!;
memoize 'c5',
- SCALAR_CACHE => ['TIE', $tiepack, $file],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
# Now something tricky---we'll memoize c23 with the wrong table that
# has the 5 already cached.
memoize 'c23',
- SCALAR_CACHE => ['TIE', $tiepack, $file],
+ SCALAR_CACHE => [HASH => \%cache],
LIST_CACHE => 'FAULT'
;
projects / p5sagit/p5-mst-13.2.git / commitdiff