Re^3: Near-free function currying in Perl

LOL, you beat me by only a few minutes, I was just going to posts this.

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 3;

{
    package Test;

    use Attribute::Handlers;

    sub curry : ATTR(CODE) {
        my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
        my @args = split(//, $data);
        my $num_args = scalar(@args);
        my $func = *{$symbol}{NAME};
        no strict 'refs';
        no warnings 'redefine';
        *{"${package}::${func}"} = sub {
                if (scalar(@_) == $num_args) {
                    goto $referent;
                }
                else {
                    my @args = @_;
                    return sub {
                        $referent->(@args, @_);
                    };
                }
            };
    }

    sub foo : curry('$$$') {
        return @_;
    }
    
}
              
is_deeply(
    [ Test::foo(1, 2, 3) ],
    [ 1, 2, 3 ],
    '... got the right return value');   

my $curried_foo = Test::foo(1, 2);              
is(ref($curried_foo), 'CODE', '... this is our curried sub');

is_deeply(
    [ $curried_foo->(3) ],
    [ 1, 2, 3 ],
    '... got the right return value now');

1;
[download]

Although to be honest, neither of our implementations, nor Tom's do what Haskell and Standard ML do, which is too keep currying until all the functions arguments are satisfied.

my $curried_foo = foo(1);
my $even_more_curried_foo = $curried_foo->(2);
print $even_more_curried_foo->(3); # now we execute the function
[download]

And from my (limited) understanding of prototypes, it seems that this may not be possible since seems it is difficult to assign an attribute to a closure.

-stvn

Comment on Re^3: Near-free function currying in Perl Select or Download Code

Replies are listed 'Best First'.
Re^4: Near-free function currying in Perl by dragonchild (Archbishop) on Nov 17, 2004 at 17:33 UTC
Easily fixed. `package Demo; require v5.6.1; use Attribute::Handlers::Prospective; sub UNIVERSAL::curry : ATTR(CODE,RAWDATA) { my ($package, $symbol, $referent, $attr, $data, $phase) = @_; my $num = () = $data =~ /(\$)/g; my $subname = "$package".'::'.{$symbol}{NAME}; $subname = sub { if (@_ < $num) { my @x = @_; return sub { $subname->(@x, @_ ) }; } $referent->(@_); }; } 1; __END__` [download] Being right, does not endow the right to be rude; politeness costs nothing. Being unknowing, is not the same as being stupid. Expressing a contrary opinion, whether to the individual or the group, is more often a sign of deeper thought than of cantankerous belligerence. Do not mistake your goals as the only goals; your opinion as the only opinion; your confidence as correctness. Saying you know better is not the same as explaining you know better.	[reply] [d/l]
Re^5: Near-free function currying in Perl by stvn (Monsignor) on Nov 17, 2004 at 17:57 UTC
Very nice ++ -stvn	[reply]


Problems? Is your data what you think it is?
	PerlMonks