Browse files

concat

  • Loading branch information...
1 parent 0ffaaa2 commit ce8ee1c060a2d9f209a51c7946e1162288f85b8d hakim committed Jul 16, 2010
Showing with 34 additions and 0 deletions.
  1. +29 −0 scratch/perl/kiokupipe/lib/List.pm
  2. +5 −0 scratch/perl/kiokupipe/test.pl
View
29 scratch/perl/kiokupipe/lib/List.pm
@@ -4,6 +4,11 @@ use KiokuDB::Class;
my $empty;
sub empty { return $empty ||= List::Empty->new }
+sub prepend {
+ my ($self, $head) = @_;
+ return List->node($head, $self);
+}
+
sub node {
my $class = shift;
return $class->empty unless @_;
@@ -71,7 +76,23 @@ sub Grep {
})
: $self->tail->Grep($f);
}
+sub Foldl {
+ my ($self, $f, $init) = @_;
+ return $self->tail->Foldl( $f, $f->( $init, $self->head ) );
+}
+sub Foldr {
+ # f x (foldr f z xs)
+ my ($self, $f, $init) = @_;
+ return $f->(
+ $self->head,
+ $self->tail->Foldr( $f, $init )
+ );
+}
+sub concat {
+ my ($self, $list) = @_;
+ return $self->Foldr( sub { $_[1]->prepend($_[0]) }, $list );
+}
sub tail {
my $self = shift;
@@ -115,5 +136,13 @@ sub take { return () }
sub Map { return shift }
sub Grep { return shift }
sub While { return __PACKAGE__->empty }
+sub Foldl {
+ my ($self, $f, $init) = @_;
+ return $init;
+}
+sub Foldr {
+ my ($self, $f, $init) = @_;
+ return $init;
+}
1;
View
5 scratch/perl/kiokupipe/test.pl
@@ -31,4 +31,9 @@
my $grep = $map->Grep( sub { $_[0] % 2 });
warn Dumper( [ $grep->take(10) ] );
+
+ warn $grep->Foldl( sub { $_[0] + $_[1] }, 0 );
+ warn $grep->Foldr( sub { $_[0] + $_[1] }, 0 );
+
+ warn Dumper( [ $grep->concat($map2)->take(20) ] );
}

0 comments on commit ce8ee1c

Please sign in to comment.