Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

import Memoize 0.04 from CPAN

git-cpan-module:   Memoize
git-cpan-version:  0.04
git-cpan-authorid: MJD
git-cpan-file:     authors/id/M/MJ/MJD/Memoize-0.04.tar.gz
  • Loading branch information...
commit d3a2af356d60395c7c070f6cb34e91f457a973cc 1 parent f64745c
@mjdominus authored schwern committed
View
10 MANIFEST
@@ -1,7 +1,11 @@
+README
+MANIFEST
Memoize.pm
-demo.pl
-demo2.pl
Makefile.PL
-MANIFEST
t/correctness.t
t/speed.t
+t/errors.t
+t/unmemoize.t
+demo.pl
+demo2.pl
+TODO
View
2  Makefile.PL
@@ -1,7 +1,7 @@
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Memoize',
- VERSION => '0.03',
+ VERSION => '0.04',
# 'linkext' => {LINKTYPE => ''},
'dist' => {COMPRESS => 'gzip', SUFFIX => 'gz'},
);
View
206 Memoize.pm
@@ -8,7 +8,7 @@
# same terms as Perl iteself. If in doubt, write to mjd@pobox.com
# for a license.
#
-# Version 0.03 alpha $Revision: 1.2 $ $Date: 1998/02/04 22:04:03 $
+# Version 0.03 alpha $Revision: 1.3 $ $Date: 1998/02/05 03:26:25 $
package Memoize;
$VERSION = '0.03';
@@ -86,6 +86,23 @@ Or you could use this module, like this:
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
@@ -97,7 +114,9 @@ You should say
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.
+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,
@@ -106,7 +125,7 @@ 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, invokdle C<memoize>
+the way it behaves a little. To supply options, invoke C<memoize>
like this:
memoize(function, { TODISK => filename,
@@ -123,7 +142,7 @@ 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')
+ 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
@@ -181,6 +200,17 @@ that it computed for one argument list and return it as the result of
calling the function with the other argmuent 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$;", "b")
+ normalizer("a", "$;b")
+
+for example.
+
=head2 TODISK
C<TODISK> means that the memo table should be saved to disk so that it
@@ -194,6 +224,22 @@ results have been precomputed. Or you would be able to do this, if
TODISK were implemented, which it presently isn't. But it will be.
Some day.
+=head1 OTHER FUNCTION
+
+There's an C<unmemoize> function that you can import if you want to.
+If you use it, please let me know what it was good for, since I can
+only think of very limited uses for it and was considering leaving it
+out altogether.
+
+It 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:
@@ -231,9 +277,9 @@ Do not memoize a function with side effects.
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 abuot that. But C<Memoize> doesn't understand
+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 prnit the sum of 2 and 3, but
+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.
@@ -272,43 +318,6 @@ and shorter every time you call C<main>.
=back
-=head1 TO DO
-
-=over 4
-
-=item *
-
-There should be an C<unmemoize> function.
-
-=item *
-
-We should extend the benchmarking module to allow
-
- timethis(main, MEMOIZED => [ suba, subb ])
-
-What would this do? It would time C<main> three times, once with
-C<suba> and C<subb> unmemoized, twice with them memoized.
-
-Why would you want to do this? By the third set of runs, the memo
-tables would be fully populated, so all calls by C<main> to C<suba>
-and C<subb> wuold return immediately. You would be able to see how
-much of C<main>'s running time was due to time spent computing in
-C<suba> and C<subb>. If that was just a little time, you would know
-that optimizing or improving C<suba> and C<subb> would not have a
-large effect on the performance of C<main>. But if there was a big
-difference, you would know that C<suba> or C<subb> was a good
-candidate for optimization if you needed to make C<main> go faster.
-
-=item *
-
-There was some other stuff, but I forget.
-
-=item *
-
-Maybe a tied-hash interface to the memo-table, which a hook to
- automatically populate an entry if no value is there yet?
-
-=back
=head1 AUTHOR
@@ -336,41 +345,53 @@ for news and upgrades.
use Carp;
use Exporter;
+use vars qw($DEBUG);
@ISA = qw(Exporter);
@EXPORT = qw(memoize);
+@EXPORT_OK = qw(unmemoize);
use strict;
my %memotable;
+my %revmemotable;
sub memoize {
my $fn = shift;
my $options = shift || {};
- unless (defined($fn)) {
+ unless (defined($fn) &&
+ (ref $fn eq 'CODE' || ref $fn eq '')) {
croak "Usage: memoize 'functionname'|coderef {OPTIONS}";
}
my $uppack = caller;
my $cref; # Code reference to original function
- my $name;
+ my $name = (ref $fn ? undef : $fn);
- if (ref $fn eq 'CODE') {
- $cref = $fn;
- } elsif (! ref $fn) {
- if ($fn =~ /::/) {
- $name = $fn;
- } else {
- $name = $uppack . '::' . $fn;
- }
- no strict;
- $cref = *{$name}{CODE}; # Magic
- } else {
- croak "Usage: argument 1 to `memoize' must be a function name or reference.\n";
- }
+ # Convert function names to code references
+ $cref = &_make_cref($fn, $uppack);
# Goto considered harmful! Hee hee hee.
my $wrapper = eval "sub { unshift \@_, qq{$cref}; goto &_memoizer; }";
+ my $install_name;
+ if (defined $options->{INSTALL}) {
+ # INSTALL => name
+ $install_name = $options->{INSTALL};
+ } elsif (! exists $options->{INSTALL}) {
+ # No INSTALL option provided; use original name if possible
+ $install_name = $name;
+ } else {
+ # INSTALL => undef means don't install
+ }
+
+ if (defined $install_name) {
+ $install_name = $uppack . '::' . $install_name
+ unless $install_name =~ /::/;
+ no strict;
+ local($) = 0; # ``Subroutine $install_name redefined at ...''
+ *{$install_name} = $wrapper; # Install memoized version
+ }
+
# We should put some more stuff in here eventually.
$memotable{$cref} =
{
@@ -378,20 +399,13 @@ sub memoize {
UNMEMOIZED => $cref,
MEMOIZED => $wrapper,
PACKAGE => $uppack,
- NAME => undef, # What was this supposed to be for?
+ NAME => $install_name, # What was this supposed to be for?
MEMOS => { }, # Memo table
};
+
+ $revmemotable{$wrapper} = "" . $cref; # Turn code ref into hash key
- my $install_name = $options->{INSTALL} || $name;
- if (defined $install_name) {
- $install_name = $uppack . '::' . $install_name
- unless $install_name =~ /::/;
- no strict;
- local($) = 0; # ``Subroutine $install_name redefined at ...''
- *{$install_name} = $wrapper; # Install memoized version
- }
-
- $wrapper; # Return memoized version
+ $wrapper # Return just memoized version
}
# This is the function that manages the memo tables.
@@ -404,7 +418,7 @@ sub _memoizer {
unless (ref $normalizer) {
unless ($normalizer =~ /::/) {
no strict;
- $normalizer = *{$info->{PACKAGE} . '::' . $normalizer}{CODE};
+ $normalizer = \&{$info->{PACKAGE} . '::' . $normalizer};
}
}
@@ -423,4 +437,56 @@ sub _default_normalizer {
join $;,@_; # $;,@_;? Perl is great.
}
+sub unmemoize {
+ my $f = shift;
+ my $uppack = caller;
+ my $cref = _make_cref($f, $uppack);
+
+ unless (exists $revmemotable{$cref}) {
+ croak "Could not unmemoize function `$f', because it was not memoized to begin with";
+ }
+
+ my $tabent = $memotable{$revmemotable{$cref}};
+ unless (defined $tabent) {
+ croak "Could not figure out how to unmemoize function `$f'";
+ }
+ my $name = $tabent->{NAME};
+ if (defined $name) {
+ no strict;
+ *{$name} = $tabent->{UNMEMOIZED}; # Replace with original function
+ }
+ undef $memotable{$revmemotable{$cref}};
+ undef $revmemotable{$cref};
+ $tabent->{UNMEMOIZED};
+ 1;
+}
+
+sub _make_cref {
+ my $fn = shift;
+ my $uppack = shift;
+ my $cref;
+ my $name;
+
+ if (ref $fn eq 'CODE') {
+ $cref = $fn;
+ } elsif (! ref $fn) {
+ if ($fn =~ /::/) {
+ $name = $fn;
+ } else {
+ $name = $uppack . '::' . $fn;
+ }
+ no strict;
+ if (defined $name and !defined(&$name)) {
+ croak "Cannot memoize nonexistent function `$fn'";
+ }
+# $cref = \&$name;
+ $cref = *{$name}{CODE};
+ } else {
+ my $parent = (caller(1))[3]; # Function that called _make_cref
+ croak "Usage: argument 1 to `$parent' must be a function name or reference.\n";
+ }
+ $DEBUG and warn "${name}($fn) => $cref in _make_cref\n";
+ $cref;
+}
+
1;
View
13 README
@@ -0,0 +1,13 @@
+
+Documentation for this module is in the module file itself; see
+`Memoize.pm'. This is true for all Perl modules. To display it,
+try
+
+ perldoc Memoize.pm
+
+or just view Memoize.pm with any text viewer or editor.
+
+Author: Mark-Jason Dominus (mjd-perl-memoize@plover.com)
+
+Date: 17 February 1998
+
View
82 TODO
@@ -0,0 +1,82 @@
+=head1 TO DO
+
+=over 4
+
+=item *
+
+The module does not work at all for functions that return lists.
+It should have a RETURN_TYPE option that accepts SCALAR, LIST, and
+BOTH and defaults to BOTH. The memo hash can be doubled somehow with
+one hash for (references to) lists and one for scalars.
+
+Don't forget to add array value tests to the test suite.
+
+=item *
+
+There should be an C<unmemoize> function.
+
+=item *
+
+We should extend the benchmarking module to allow
+
+ timethis(main, { MEMOIZED => [ suba, subb ] })
+
+What would this do? It would time C<main> three times, once with
+C<suba> and C<subb> unmemoized, twice with them memoized.
+
+Why would you want to do this? By the third set of runs, the memo
+tables would be fully populated, so all calls by C<main> to C<suba>
+and C<subb> would return immediately. You would be able to see how
+much of C<main>'s running time was due to time spent computing in
+C<suba> and C<subb>. If that was just a little time, you would know
+that optimizing or improving C<suba> and C<subb> would not have a
+large effect on the performance of C<main>. But if there was a big
+difference, you would know that C<suba> or C<subb> was a good
+candidate for optimization if you needed to make C<main> go faster.
+
+=item *
+
+Maybe a tied-hash interface to the memo-table, which a hook to
+ automatically populate an entry if no value is there yet?
+
+=item *
+
+Perhaps C<memoize> should return a reference to the original function
+as well as one to the memoized version? But the programmer could
+always construct such a reference themselves, so perhaps it's not
+necessary. We save such a reference anyway, so a new package method
+could return it on demand even if it wasn't provided by C<memoize>.
+We could even bless the new function reference so that it could have
+accessor methods for getting to the original function, the options,
+the memo table, etc.
+
+=item *
+
+The TODISK feature is not ready yet. It will have to be rather
+complicated, providing options for which disk method to use (GDBM?
+DB_File? Flat file? Storable? User-supplied?) and which stringizing
+method to use (FreezeThaw? Marshal? User-supplied?)
+
+=item *
+
+Maybe an option for automatic expiration of cache values? (`After one
+day,' `After five uses,' etc.)
+
+=item *
+
+Put in a better example than C<fibo>. Show an example of a
+nonrecursive function that simply takes a long time to run.
+C<getpwuid> for example? But this exposes the bug that you can't say
+C<memoize('getpwuid')>, so perhaps it's not a very good example.
+
+Well, I did add the ColorToRGB example, but it's still not so good.
+These examples need a lot of work. C<factorial> might be a better
+example than C<fibo>.
+
+=item *
+
+There was probably some other stuff that I forgot.
+
+
+
+=back
View
16 t/correctness.t
@@ -3,7 +3,7 @@
use lib '..';
use Memoize;
-print "1..22\n";
+print "1..25\n";
print "Basic\n";
@@ -111,6 +111,20 @@ print (("@f2r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n");
$n++;
print (("@f3r" eq "1 1 1 1 1 1 1 1 1 1") ? "ok $n\n" : "not ok $n\n");
+print "INSTALL => undef option.\n";
+{ my $i = 1;
+ sub u1 { $i++ }
+}
+my $um = memoize('u1', {INSTALL => undef});
+@umr = (&$um, &$um, &$um);
+@u1r = (&u1, &u1, &u1 ); # Did *not* clobber &u1
+$n++;
+print (("@umr" eq "1 1 1") ? "ok $n\n" : "not ok $n\n"); # Increment once
+$n++;
+print (("@u1r" eq "2 3 4") ? "ok $n\n" : "not ok $n\n"); # Increment thrice
+$n++;
+print ((defined &{"undef"}) ? "not ok $n\n" : "ok $n\n"); # Just in case
+
print "$n tests in all.\n";
View
16 t/errors.t
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+
+use lib '..';
+use Memoize;
+use Carp;
+
+print "1..2\n";
+
+eval { croak("Ouch.") };
+print "\$\@: `$@'\n";
+print (($@ ? '' : 'not '), "ok 1\n");
+
+eval { memoize([]) };
+print "\$\@: `$@'\n";
+print (($@ ? '' : 'not '), "ok 2\n");
+
View
2  t/speed.t
@@ -3,7 +3,7 @@
use lib '..';
use Memoize;
-print STDERR "Warning: I'm testing the speedup. This might take up to sixty seconds.\n";
+print STDERR "\nWarning: I'm testing the speedup. This might take up to sixty seconds.\n ";
print "1..6\n";
View
26 t/unmemoize.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use lib '..';
+use Memoize qw(memoize unmemoize);
+
+print "1..5\n";
+
+eval { unmemoize('f') }; # Should fail
+print (($@ ? '' : 'not '), "ok 1\n");
+
+{ my $I = 0;
+ sub u { $I++ }
+}
+memoize('u');
+my @ur = (&u, &u, &u);
+print (("@ur" eq "0 0 0") ? "ok 2\n" : "not ok 2\n");
+
+eval { unmemoize('u') }; # Should succeed
+print ($@ ? "not ok 3\n" : "ok 3\n");
+
+@ur = (&u, &u, &u);
+print (("@ur" eq "1 2 3") ? "ok 4\n" : "not ok 4\n");
+
+eval { unmemoize('u') }; # Should fail
+print ($@ ? "ok 5\n" : "not ok 5\n");
+
Please sign in to comment.
Something went wrong with that request. Please try again.