my $curried_foo = curry( \&foo, args... );
[download]

(Update: If you're wondering why I didn't use some of the existing currying modules or why I don't use prototypes or annotations to make my implementation more like "real" currying, please read my comment on this subject, which explains why I think the style of currying I present below makes more sense for Perl (5) than does signature-based currying.)

(Update: tweaked code to reduce reliance upon INIT-time processing (thanks diotalevi!))

Our goal is to make currying free, like it is in some other programming languages. (In Haskell, for example, you don't need to say that you want to curry a function; you just call it with fewer than the expected number of arguments, and the currying happens automatically.)

Why do this in Perl?

Before getting to AutoCurry, let's spend a few moments justifying the exercise. Why should we try to reduce the cost of currying in Perl? The answer is because currying reduces the cost of reusing functions, making reuse practical in more situations, and that in turn reduces the cost of programming in general. In short, with currying we reinvent the wheel less. If we can reduce the cost of currying further, we might be able to achieve further cost reductions.

As a motivating example, consider the case of logging. Let's say that we have the following generalized logging function:

    sub log_to_handle {
        my ($fh, $heading, $message) = @_;
        print $fh "$heading: $message", $/;
    }
[download]

It's a simple function for the sake of our example, but let's imagine that it's complex and would be costly to rewrite.

Let's further say that later we're working with a server framework that lets us configure it with a logging function to use when the server emits diagnostic messages:

    my $app_server = AppServer->new( logger => $mylogger, ... );
[download]

The application server expects $mylogger to be a logging function that takes a single argument, the message to be logged.

It would be nice to be able to reuse our existing, 3-argument logging function for this purpose. We can do this by adapting it to the application server's expectations. Because the application server expects a 1-argument function and we have a 3-argument function, we must specialize away the extra arguments. We'll do this by binding $fh to STDERR and $heading to "app server".

In some programming languages, we would need to write a wrapper function to specialize the function:

    sub app_server_diagnostic_logger {
        log_to_handle( *STDERR, "app server", @_ );
    }

    $app_server = AppServer->new(
        logger => \&app_server_diagnostic_logger, ... 
    );
[download]

But Perl gives us a less-expensive way. We can use an anonymous subroutine to create an on-the-fly wrapper, tailored to our needs:

    $app_server = AppServer->new(
        logger => sub {
            log_to_handle( *STDERR, "app-server", @_ )
        }, ... 
    );
[download]

Still, we can do better. We can use a currying helper function to take the cost down another notch and also to make clear our intent to specialize an existing function:

    $app_server = AppServer->new(
        logger => curry( \&log_to_handle, *STDERR, "app-server" ),
        ...
    );
[download]

That's pretty good, but specialization in Perl is still more expensive than in some other languages. It would be great to reduce the cost to the bare minimum, where a regular function call is automatically curried if it doesn't receive all of the arguments it wants:

    $app_server = AppServer->new(
        logger => log_to_handle( *STDERR, "app-server" ),
        ...
    );
[download]

That's the ultimate goal: zero-cost currying.

The idea behind AutoCurry

AutoCurry gets us very close to the goal. We can't quite make it all the way because functions in Perl can accept varying numbers of arguments, and thus it's hard for us to determine reliably when currying is implied by analyzing function calls. For this reason, we take the practical road and rely upon a hint from the programmer to tell us when currying is expected. (Seen from this light, calling the curry helper function could be considered a rather expensive hint. We want to make the hint less expensive.)

The hint that we will use is to append the suffix "_c" to any function call that we want to have currying semantics. To show how it works with our running example:

    $app_server = AppServer->new(
        logger => log_to_handle_c( *STDERR, "app-server" ),
        ...
    );
[download]

That's only two characters away from the ideal, which is probably as close as we can practically make it.

Underneath, the implementation relies upon double-currying and some symbol-table manipulation to create curried variants of our normal functions.

Let's walk through the strategy. First, we need a run-of-the-mill currying helper:

    sub curry {
        my $f = shift;
        my $args = \@_;
        sub { $f->(@$args, @_) };
    }
[download]

Then, to create a currying variant of a normal function, we "double curry" it and store the resulting function in the symbol table under the appropriate _c name:

    *log_to_handle_c = curry( \&curry, \&log_to_handle );
[download]

In essence, each _c function is a partially applied call to curry that specializes the corresponding normal, non-curried function by calling curry again.

Now, to make the approach cost effective, all we need to do is automate it and bring it to a larger scale.

Mass production

For maximum convenience, we would like to curry-enable every function in our namespace automatically. The first step, then, is to scan our namespace for functions. We can do this by scanning its symbol table and extracting the names associated with non-empty CODE slots:

    sub get_function_names_from_package {
        no strict 'refs';
        my $pkg = shift || caller;
        my $symtab = *{ $pkg . "::" }{HASH};
        grep *$_{CODE},          # drop symbols w/o code
            map  $pkg."::$_",    # fully qualify
            grep !/^_|^[_A-Z]$/, # drop _underscored & ALL_CAPS
            keys %$symtab;       # get all symbols for package
    }
[download]

(Note that we skip functions whose names start with an underscore or are ALL CAPS. Such functions are often system routines that we don't have reason to curry.)

To see how the function works, let's try it on a small package:

    {   package Test;
        sub one { }
        sub two { }
        sub three { }
        $Test::not_a_function = 1;
    }

    my @names = get_function_names_from_package("Test");
    print "@names", $/;
    # Test::three Test::one Test::two
[download]

Now, all that's left is to iterate over the names and create corresponding _c versions that implement our double-curried strategy:

    for (@names) {
        no strict 'refs';
        my $curried_name = $_ . "_c";
        *$curried_name = curry( \&curry, \&$_ );
    }
[download]

And that's the essence of AutoCurry.

To wrap it up, we'll place everything in the AutoCurry package, along with some documentation and a few extra helper functions. As a further convenience, the module will accept instructions about what to auto-curry via its import list:

    use AutoCurry qw( foo );  # pass ':all' to curry all functions

    sub foo { print "@_$/"; }
    # currying variant, foo_c, is created automatically
[download]

Implementing the import function and robustifying the code above is straightforward, and so I'll stop the meditation here. (If you're curious, I have included the complete code for the module below. It contains fewer than sixty lines of code.)

Thank you!

Thanks for taking the time to read this meditation. If you have any criticisms or comments, please let me know. Also, if you can help me improve my writing, I would greatly appreciate your suggestions.

Cheers,
Tom

The code for AutoCurry.pm

package AutoCurry;

# Tom Moertel <tom@moertel.com>
# 2004-11-16
# $Id: AutoCurry.pm,v 1.3 2004/11/17 04:56:17 thor Exp $

=head1 NAME

AutoCurry - automatically create currying variants of functions

=head1 SYNOPSIS

    use AutoCurry qw( foo );  # pass :all to curry all functions

    sub foo { print "@_$/"; }
    # currying variant, foo_c, is created automatically

    my $hello = foo_c("Hello,");
    $hello->("world!");       # Hello, world!
    $hello->("Pittsburgh!");  # Hello, Pittsburgh!

=cut

use Carp;

my $PKG = __PACKAGE__;

sub curry {
    my $f = shift;
    my $args = \@_;
    sub { $f->(@$args, @_) };
}

sub curry_package {
    my $pkg = shift || caller;
    curry_named_functions_from_package( $pkg,
        get_function_names_from_package( $pkg )
    );
}

sub curry_named_functions {
    curry_named_functions_from_package( scalar caller(), @_ );
}

sub curry_named_functions_from_package {
    no strict 'refs';
    my $pkg = shift() . "::";
    map {
        my $curried_name = $_ . "_c";
        carp "$PKG: currying $_ over existing $curried_name"
            if *$curried_name{CODE};
        *$curried_name = curry( \&curry, \&$_ );
        $curried_name;
    } map { /::/ ? $_ : "$pkg$_" } @_;
}

sub get_function_names_from_package {
    no strict 'refs';
    my $pkg = shift || caller;
    my $symtab = *{ $pkg . "::" }{HASH};
    grep *$_{CODE},           # drop symbols w/o code
        map  $pkg."::$_",     # fully qualify
        grep !/^_|^[_A-Z]+$/, # drop _underscored & ALL_CAPS
        keys %$symtab;        # get all symbols for package
}

my @init;

sub import {
    shift;  # don't need self
    my $caller = caller;
    push @init, curry_package_c($caller) if grep /^:all$/, @_;
    curry_named_functions_from_package($caller, grep !/^:/, @_);
}

INIT { finish_initialization() }

sub finish_initialization {
    $_->() for @init; @init = ();
}

# physician, curry thyself!

curry_named_functions(qw(
    curry_package
));


1;

__END__

=head1 DESCRIPTION

This module automatically creates currying variants of functions.  For
each function C<foo>, a currying variant C<foo_c> will be created that
(1) captures whatever arguments are passed to it and (2) returns a new
function.  The new function awaits any new arguments that are passed
to I<it>, and then calls the original C<foo>, giving it both the
captured and new arguments.

If C<foo> is a function and C<foo_c> is its currying variant, then the
following are equivalent for all argument lists C<@a> and C<@b>:

    foo(@a, @b);
    foo_c(@a, @b)->();
    foo_c()->(@a, @b);
    foo_c(@a)->(@b);
    do { my $foo1 = foo_c(@a); $foo1->(@b) };

=head2 use AutoCurry I<names>

You can create currying variants at C<use> time by listing the
functions to be curried:

    use AutoCurry qw( foo bar );

Or, if you want to curry everything:

    use AutoCurry ':all';

=head2 curry_named_functions(I<names>) 

You can also create variants at run time:

    my @created_variants =
    AutoCurry::curry_named_functions(qw( foo bar ));

The fully-qualified names of the created functions are returned:

    print "@created_variants";
    # main::foo_c main::bar_c

If you're writing a module, this list of names is handy for augmenting
your export lists.

=head1 MOTIVATION

Currying reduces the cost of reusing functions by allowing you to
"specialize" them by pre-binding values to a subset of their
arguments.  Using it, you can convert any function of I<N> arguments
into a family of I<N> related, specialized functions.

Currying in Perl is somewhat awkward.  My motivation for
writing this module was to minimize that awkwardness and
approximate the "free" currying that modern functional
programming languages such as Haskell offer.

As an example, let's say we have a general-purpose logging function:

    sub log_to_file {
        my ($fh, $heading, $message) = @_;
        print $fh "$heading: $message", $/;
    }

    log_to_file( *STDERR, "warning", "hull breach imminent!" );

If we're logging a bunch of warnings to STDERR, we can save some work
by specializing the function for that purpose:

    my $log_warning = sub {
        log_to_file( *STDERR, "warning", @_ );
    };

    $log_warning->("cap'n, she's breakin' up!");

The C<log_warning> function, being tailored for the purpose, is easier
to use.  However, having to create the function is a pain.  We're
effectively currying by hand.  For this reason, many people use a
helper function to curry for them:

    $log_warning = curry( \&log_to_file, *STDERR, "warning" );

An improvement, but still far from free.

This module does away with the manual labor altogether by creating
currying variants of your functions automatically.  These variants
have names ending in a C<_c> suffix and I<automatically curry> the
original functions for the arguments you give them:

    use AutoCurry ':all';
    $log_warning = log_to_file_c( *STDERR, "warning" );

    $log_warning->("she's gonna blow!");

The total cost of currying is reduced to appending a C<_c> suffix,
which is probably as low as it's going to get on this side of Perl 6.

=head1 AUTHOR

    Tom Moertel <tom@moertel.com>
    $Id: AutoCurry.pm,v 1.3 2004/11/17 04:56:17 thor Exp $

=head1 COPYRIGHT and LICENSE

Copyright (c) 2004 by Thomas G Moertel.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
[download]