Aggressive Memoizer

aggressive_memoizer.pl

#!/bin/env perl

use strict;
use warnings;
use v5.12;

sub aggressively_memoize {
    my $caller_num = shift // 1;

    my $caller = (caller($caller_num))[3];
    return unless $caller;

    my ($package, $sub_name) = $caller =~ /(.*)::(.*?)$/;
    return if $sub_name eq '__ANON__';

    my $orig = $package->can($sub_name);
    my %cache;

    my $new_sub = sub {
        aggressively_memoize(2);

        my $key = join("\0", @_);

        # FIXME: Should check wantarray, this doesn't work in list context.
        unless (exists $cache{$key}) {
            $cache{$key} = $orig->(@_);
        }
        # Uncomment this if you wonder whether or not the cache is getting hit:
        #else {
        #    warn 'hit';
        #}

        return $cache{$key};
    };

    {
        no strict 'refs';
        no warnings 'redefine';
        *{$caller} = $new_sub;
    }

    return;
}

sub add {
    # Comment this out to see the performance difference
    aggressively_memoize();

    my $result = 0;
    $result += $_ for @_;
    return $result;
}

sub fib {
    my $n = shift;
    return 0 if $n <= 0;
    return 1 if $n == 1;
    return fib(add($n, -1)) + fib(add($n, -2));
}

say fib(40);