Permalink
Browse files

trying out function serialization instead

  • Loading branch information...
1 parent 3853d1f commit 0ffaaa26043d801c9e77d1e65343b9ec97fe2039 hakim committed Jul 16, 2010
@@ -4,16 +4,24 @@ use KiokuDB::Class;
my $empty;
sub empty { return $empty ||= List::Empty->new }
+sub node {
+ my $class = shift;
+ return $class->empty unless @_;
+ my ($head, $tail) = @_;
+ $tail ||= $class->empty;
+
+ return List::Node->new({
+ head => $head,
+ _tail => $tail,
+ });
+}
+
sub from_array {
my $self = shift;
my $class = (ref $self) || $self;
if (@_) {
my $head = shift;
- my $list = List::Node->new({
- head => $head,
- tail => scalar $class->from_array(@_),
- });
- return $list;
+ return List->node( $head, scalar $class->from_array(@_));
}
else {
return $class->empty;
@@ -35,25 +43,60 @@ has 'head' => (
isa => 'Any',
);
-has 'tail' => (
+has '_tail' => (
traits => ['KiokuDB::Lazy'],
- is => 'ro',
- isa => 'List',
+ is => 'rw',
+ isa => 'List | CodeRef',
);
+sub Map {
+ my ($self, $f) = @_;
+
+ return List->node(
+ $f->($self->head),
+ sub {
+ $self->tail->Map($f)
+ });
+}
+sub Grep {
+ my ($self, $f) = @_;
+
+ my $head = $self->head;
+
+ return $f->($head) ?
+ List->node(
+ $head,
+ sub {
+ $self->tail->Grep($f)
+ })
+ : $self->tail->Grep($f);
+}
+
+
+sub tail {
+ my $self = shift;
+ my $tail = $self->_tail;
+ if (ref $tail eq 'CODE') {
+ my $newtail = $tail->($self);
+ $self->_tail($newtail);
+ return $newtail;
+ }
+ else {
+ return $tail;
+ }
+}
+
sub take {
my ($list, $count) = @_;
- return () if $list->isEmpty;
return () unless $count;
return ($list->head, $list->tail->take($count-1));
}
sub While {
my ($list, $f) = @_;
- return $list->empty if $list->isEmpty;
my $head = $list->head;
if ($f->($head)) {
- return List::Node->new({ head => $head, tail => scalar $list->tail->While($f) });
+ return List->node( $head, scalar $list->tail->While($f));
}
else {
return $list->empty;
@@ -69,6 +112,8 @@ sub isEmpty { 1 }
sub head { die "Empty lists have no head" }
sub tail { die "Empty lists have no tail" }
sub take { return () }
+sub Map { return shift }
+sub Grep { return shift }
sub While { return __PACKAGE__->empty }
1;
@@ -1,60 +0,0 @@
-package List::Grep;
-use KiokuDB::Class;
-
-extends 'List::Node';
-
-has 'list' => (
- is => 'rw',
- isa => 'List',
-);
-
-sub _list {
- my $self = shift;
- my $list = $self->list;
-
- my $reset_list;
- {
- last if $list->isEmpty;
- last if $self->filter( $list->head );
- $reset_list++;
- $list = $list->tail;
- redo;
- }
- $self->list($list) if $reset_list; # optimization: modify inplace
- return $list;
-}
-
-sub isEmpty {
- my $self = shift;
- return $self->_list->isEmpty;
-}
-
-has '+head' => (
- lazy => 1,
- default => sub {
- my $self = shift;
- return $self->_list->head;
- },
-);
-
-has '+tail' => (
- traits => ['KiokuDB::Lazy'],
- lazy => 1,
- default => sub {
- my $self = shift;
- my $class = (ref $self) || $self;
- if ($self->isEmpty) {
- return $self->empty;
- }
- else {
- return $class->new( list => $self->list->tail );
- }
- },
-);
-
-sub filter {
- my ($self, $val) = @_;
- return 1; # id
-}
-
-1;
@@ -1,12 +0,0 @@
-package List::Grep::Odd;
-use KiokuDB::Class;
-
-extends 'List::Grep';
-
-
-sub filter {
- my ($self, $val) = @_;
- return $val % 2;
-}
-
-1;
@@ -1,45 +0,0 @@
-package List::Map;
-use KiokuDB::Class;
-
-extends 'List::Node';
-
-has 'list' => (
- is => 'ro',
- isa => 'List',
-);
-
-sub isEmpty {
- my $self = shift;
- return $self->list->isEmpty;
-}
-
-has '+head' => (
- lazy => 1,
- default => sub {
- my $self = shift;
- my $val = $self->list->head;
- $self->transform( $self->list->head ),
- },
-);
-
-has '+tail' => (
- traits => ['KiokuDB::Lazy'],
- lazy => 1,
- default => sub {
- my $self = shift;
- my $class = (ref $self) || $self;
- if ($self->isEmpty) {
- return $self->empty;
- }
- else {
- return $class->new( list => $self->list->tail );
- }
- },
-);
-
-sub transform {
- my ($self, $val) = @_;
- return $val; # id
-}
-
-1;
@@ -1,11 +0,0 @@
-package List::Map::Increment;
-use KiokuDB::Class;
-
-extends 'List::Map';
-
-sub transform {
- my ($self, $val) = @_;
- return $val+1;
-}
-
-1;
@@ -2,14 +2,12 @@
use strict; use warnings;
use List;
-use List::Map::Increment;
-use List::Grep::Odd;
use Data::Dumper;
use KiokuDB;
my $list = List->from_array(1..10);
-my $map = List::Map::Increment->new( list => $list );
+my $map = $list->Map( sub { $_[0] + 1 });
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Maxdepth = 10;
@@ -29,8 +27,8 @@
warn Dumper($map2);
warn Dumper( [ $map2->take(3) ] );
- warn Dumper( [ $map2->While(sub { $_[0] < 5 })->take(10) ] );
+ warn Dumper( [ $map2->While(sub { $_[0] < 6 })->take(10) ] );
- my $grep = List::Grep::Odd->new( list => $map2 );
+ my $grep = $map->Grep( sub { $_[0] % 2 });
warn Dumper( [ $grep->take(10) ] );
}

0 comments on commit 0ffaaa2

Please sign in to comment.