File Coverage

blib/lib/Moose/Autobox/Code.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Moose::Autobox::Code;
2 1     1   1769 use Moose::Role 'with';
  0            
  0            
3             use Moose::Autobox;
4              
5             our $VERSION = '0.15';
6              
7             with 'Moose::Autobox::Ref';
8              
9             sub curry {
10             my ($f, @a) = @_;
11             return sub { $f->(@a, @_) }
12             }
13              
14             sub rcurry {
15             my ($f, @a) = @_;
16             return sub { $f->(@_, @a) }
17             }
18              
19             sub compose {
20             my ($f, $f2, @rest) = @_;
21             return $f if !$f2;
22             return (sub { $f2->($f->(@_)) })->compose(@rest);
23             }
24              
25             sub disjoin {
26             my ($f, $f2) = @_;
27             return sub { $f->(@_) || $f2->(@_) }
28             }
29            
30             sub conjoin {
31             my ($f, $f2) = @_;
32             return sub { $f->(@_) && $f2->(@_) }
33             }
34              
35             # fixed point combinators
36              
37             sub u {
38             my $f = shift;
39             sub { $f->($f, @_) };
40             }
41              
42             sub y {
43             my $f = shift;
44             (sub { my $h = shift; sub { $f->(($h->u)->())->(@_) } }->u)->();
45             }
46              
47             1;
48              
49             __END__
50              
51             =pod
52              
53             =head1 NAME
54              
55             Moose::Autobox::Code - the Code role
56              
57             =head1 SYNOPOSIS
58              
59             use Moose::Autobox;
60            
61             my $adder = sub { $_[0] + $_[1] };
62             my $add_2 = $adder->curry(2);
63            
64             $add_2->(2); # returns 4
65            
66             # create a recursive subroutine
67             # using the Y combinator
68             *factorial = sub {
69             my $f = shift;
70             sub {
71             my $n = shift;
72             return 1 if $n < 2;
73             return $n * $f->($n - 1);
74             }
75             }->y;
76            
77             factorial(10) # returns 3628800
78            
79              
80             =head1 DESCRIPTION
81              
82             This is a role to describe operations on the Code type.
83              
84             =head1 METHODS
85              
86             =over 4
87              
88             =item B<curry (@values)>
89              
90             =item B<rcurry (@values)>
91              
92             =item B<conjoin (\&sub)>
93              
94             =item B<disjoin (\&sub)>
95              
96             =item B<compose (@subs)>
97              
98             This will take a list of C<@subs> and compose them all into a single
99             subroutine where the output of one sub will be the input of another.
100              
101             =item B<y>
102              
103             This implements the Y combinator.
104              
105             =item B<u>
106              
107             This implements the U combinator.
108              
109             =back
110              
111             =over 4
112              
113             =item B<meta>
114              
115             =back
116              
117             =head1 SEE ALSO
118              
119             =over 4
120              
121             =item L<http://en.wikipedia.org/wiki/Fixed_point_combinator>
122              
123             =item L<http://blade.nagaokaut.ac.jp/cgi-bin/scat.rb/ruby/ruby-talk/20469>
124              
125             =back
126              
127             =head1 BUGS
128              
129             All complex software has bugs lurking in it, and this module is no
130             exception. If you find a bug please either email me, or add the bug
131             to cpan-RT.
132              
133             =head1 AUTHOR
134              
135             Stevan Little E<lt>stevan@iinteractive.comE<gt>
136              
137             =head1 COPYRIGHT AND LICENSE
138              
139             Copyright 2006-2008 by Infinity Interactive, Inc.
140              
141             L<http://www.iinteractive.com>
142              
143             This library is free software; you can redistribute it and/or modify
144             it under the same terms as Perl itself.
145              
146             =cut