view release on metacpan or  search on metacpan

lib/FAST/List/Gen/Lazy.pm  view on Meta::CPAN

            my $need;
            if (@_) {
                 if (defined $_[0] and $_[0] =~ /^\d+$/) {
                    $need = shift;
                 } else {
                    $proto = shift || '@';
                 }
            }

            my $returns = @_ ? shift : $will_return{$code} || 1;

            my ($head) = $proto =~ /^([^;]*)(?:;.*)?$/
                or carp "unsupported prototype: $proto";

            unless (defined $need) {
                $need  = (()= $head =~ /$proto_chunk/go);
            }
            if ($need > 1 and $proto eq '@') {
                $proto = ('@' x $need)
            }
            (my $next_proto = $proto) =~ s/^$proto_chunk//o;

            my $self;
            $self = my $ret = $set_proto->($proto, sub {
                return $self unless @_;
                my $args = \@_;

                if (@_ < $need) {
                    &fn ($set_proto->($next_proto,
                        sub {$code->(@$args, @_)}
                    ), $need - @_, $returns)
                }
                elsif (@_ >= $need) {
                    my $thunk = sub {$code->(@$args)};
                    my $data;
                    if ($returns == 1) {
                        bless \sub {
                            unless ($data) {
                                $data = \scalar $thunk->();
                                $data = \$$$data->() if ref $$data eq 'FAST::List::Gen::Thunk';
                                undef $thunk;
                            }
                            $$data
                        } => 'FAST::List::Gen::Thunk'
                    } else {
                        map {
                            my $n = $_ - 1;
                            bless \sub {
                                unless ($data) {
                                    $data = sub {\@_}->(map {
                                        ref eq 'FAST::List::Gen::Thunk' ? $$_->() : $_
                                    } $thunk->());
                                    undef $thunk;
                                }
                                $$data[$n]
                            } => 'FAST::List::Gen::Thunk'
                        } 1 .. $returns
                    }
                }
            });
            Scalar::Util::weaken($self);
            if ($returns > 1) {
                $will_return{$ret} = $returns;
            }
            $ret
        }
    }

{package
    FAST::List::Gen::Function;
    use overload fallback => 1,
        '.' => \&compose,
        '~' => \&flip,
        (map {$_ => \& curry} qw(< <<)),
        (map {$_ => \&rcurry} qw(> >>));

    my $wrap = do {
        sub {
            my $src_fn = shift;
            unless (ref $src_fn eq 'FAST::List::Gen::Bare::Function') {
                push @_, $will_return->($src_fn);
                goto &$fn;
            }
            my ($code, $proto) = @_;
            $proto ||= '@';
            bless Scalar::Util::set_prototype(\&$code, $proto), 'FAST::List::Gen::Bare::Function';
        }
    };

    sub compose {
        my ($x, $y) = @_;
           ($x, $y) = ($y, $x) if $_[2];

        $wrap->($x, sub {$x->(&$y)}, prototype $y)
    }
    sub curry {
        my $x = shift;
        my $y = \$_[0];
        my $proto     = prototype $x;
        my $new_proto = $proto =~ /^\@(?!\@)/ ? $proto : $proto_tail->($proto);

        $wrap->($x, sub {$x->($$y, @_)}, $new_proto);
    }
    sub rcurry {
        my $x = shift;
        my $y = \$_[0];
        $wrap->($x, sub {$x->(@_, $$y)}, $proto_init->(prototype $x));
    }
    sub flip {
        my $x             = shift;
        my ($head, $tail) = (prototype($x) || '@') =~ /^([^;]+)(.*)/;
        my $new_proto     = (join '' => reverse $proto_split->($head)).$tail;

        $wrap->($x, sub {$x->(@_[reverse 0 .. $#_])}, $new_proto);
    }
}

{package
    FAST::List::Gen::Bare::Function;
    our @ISA = 'FAST::List::Gen::Function';
}