Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added grep subclass

  • Loading branch information...
commit 3853d1fc95bf0df4810203adef97c7d632ea356e 1 parent 6bbbeee
hakim authored
View
67 scratch/perl/kiokupipe/lib/List.pm
@@ -1,31 +1,74 @@
package List;
use KiokuDB::Class;
-has 'head' => (
- is => 'ro',
- isa => 'Any',
-);
-
-has 'tail' => (
- traits => ['KiokuDB::Lazy'],
- is => 'ro',
- isa => 'Maybe[List]',
-);
+my $empty;
+sub empty { return $empty ||= List::Empty->new }
sub from_array {
my $self = shift;
my $class = (ref $self) || $self;
if (@_) {
my $head = shift;
- my $list = $class->new({
+ my $list = List::Node->new({
head => $head,
tail => scalar $class->from_array(@_),
});
return $list;
}
else {
- return;
+ return $class->empty;
}
}
+package List::Node;
+use KiokuDB::Class;
+
+use lib '/home/hakim/other_repos/data-thunk/';
+use Data::Thunk;
+
+extends 'List';
+
+sub isEmpty { 0 }
+
+has 'head' => (
+ is => 'ro',
+ isa => 'Any',
+);
+
+has 'tail' => (
+ traits => ['KiokuDB::Lazy'],
+ is => 'ro',
+ isa => 'List',
+);
+
+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) });
+ }
+ else {
+ return $list->empty;
+ }
+}
+
+package List::Empty;
+use KiokuDB::Class;
+extends 'List';
+
+sub isEmpty { 1 }
+
+sub head { die "Empty lists have no head" }
+sub tail { die "Empty lists have no tail" }
+sub take { return () }
+sub While { return __PACKAGE__->empty }
+
1;
View
60 scratch/perl/kiokupipe/lib/List/Grep.pm
@@ -0,0 +1,60 @@
+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;
View
12 scratch/perl/kiokupipe/lib/List/Grep/Odd.pm
@@ -0,0 +1,12 @@
+package List::Grep::Odd;
+use KiokuDB::Class;
+
+extends 'List::Grep';
+
+
+sub filter {
+ my ($self, $val) = @_;
+ return $val % 2;
+}
+
+1;
View
15 scratch/perl/kiokupipe/lib/List/Map.pm
@@ -1,19 +1,23 @@
package List::Map;
use KiokuDB::Class;
-extends 'List';
+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;
- warn "Called with $val";
$self->transform( $self->list->head ),
},
);
@@ -23,13 +27,12 @@ has '+tail' => (
lazy => 1,
default => sub {
my $self = shift;
- warn "Making tail";
my $class = (ref $self) || $self;
- if (my $tail = $self->list->tail) {
- return $class->new( list => $tail );
+ if ($self->isEmpty) {
+ return $self->empty;
}
else {
- return;
+ return $class->new( list => $self->list->tail );
}
},
);
View
8 scratch/perl/kiokupipe/test.pl
@@ -3,6 +3,7 @@
use strict; use warnings;
use List;
use List::Map::Increment;
+use List::Grep::Odd;
use Data::Dumper;
use KiokuDB;
@@ -26,7 +27,10 @@
my $map2 = $kioku->lookup('map');
warn Dumper($map2);
+
warn Dumper( [ $map2->take(3) ] );
- warn Dumper( [ $map2->While(sub { $_[0] < 8 })->take(10) ] );
- warn Dumper($map2);
+ warn Dumper( [ $map2->While(sub { $_[0] < 5 })->take(10) ] );
+
+ my $grep = List::Grep::Odd->new( list => $map2 );
+ warn Dumper( [ $grep->take(10) ] );
}
Please sign in to comment.
Something went wrong with that request. Please try again.