[Bps-public-commit] r12689 - in pie/branches/named-params: lib/PIE

[clkao at bestpractical.com]

Author: clkao
Date: Mon May 26 08:48:12 2008
New Revision: 12689

Added:
   pie/branches/named-params/t/list.t
Modified:
   pie/branches/named-params/lib/PIE/Evaluator.pm
   pie/branches/named-params/lib/PIE/EvaluatorResult.pm
   pie/branches/named-params/lib/PIE/Expression.pm

Log:
implement list and iterator.


Modified: pie/branches/named-params/lib/PIE/Evaluator.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Evaluator.pm	(original)
+++ pie/branches/named-params/lib/PIE/Evaluator.pm	Mon May 26 08:48:12 2008
@@ -183,8 +183,6 @@
     my $x = $self->resolve_symbol_name($sym);
     my $signature = $x->signature;
     return { map { $_->name =>  {type => $_->type}}   values %$signature};
-    
-
 
 }
 

Modified: pie/branches/named-params/lib/PIE/EvaluatorResult.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/EvaluatorResult.pm	(original)
+++ pie/branches/named-params/lib/PIE/EvaluatorResult.pm	Mon May 26 08:48:12 2008
@@ -1,4 +1,3 @@
-
 package PIE::EvaluatorResult;
 use Moose;
 
@@ -15,7 +14,7 @@
 
 has value => ( 
     is => 'rw',
-    isa => 'Str | Undef',
+#    isa => 'Str | Undef | PIE::EvaluatorResult::RunTime',
     required => 0
     );
 

Modified: pie/branches/named-params/lib/PIE/Expression.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Expression.pm	(original)
+++ pie/branches/named-params/lib/PIE/Expression.pm	Mon May 26 08:48:12 2008
@@ -164,6 +164,57 @@
     return ref($result) && $result->meta->does_role('PIE::Evaluatable') ? $result->evaluate($eval): $result; # XXX: figure out evaluation order here
 }
 
+package PIE::Expression::List;
+use Moose;
+extends 'PIE::Expression::ProgN';
+
+sub evaluate {
+    my ($self, $evaluator) = @_;
+    return bless \$self->nodes, 'PIE::EvaluatorResult::RunTime';
+}
+
+package PIE::Expression::ForEach;
+use Moose;
+extends 'PIE::Expression';
+use MooseX::ClassAttribute;
+
+class_has signature => (
+    is => 'ro',
+    default => sub { { list => PIE::FunctionArgument->new( name => 'list'),
+                       binding => PIE::FunctionArgument->new( name => 'Str'),
+                       do => PIE::FunctionArgument->new( name => 'Str', type => 'PIE::Lambda'), # XXX: type for runtime?
+                   }});
+
+sub evaluate {
+    my ($self, $evaluator) = @_;
+    warn Dumper($self->args);use Data::Dumper;
+    my $lambda = $self->args->{do}->evaluate($evaluator);
+    die unless $lambda->isa("PIE::Lambda");
+
+    my $binding = $self->args->{binding}->evaluate($evaluator);
+    my $list = $self->args->{list}->evaluate($evaluator);
+
+    warn Dumper($list);
+    die unless ref($list) eq 'PIE::EvaluatorResult::RunTime';
+    my $nodes = $$list;
+
+    foreach (@$nodes) {
+        $lambda->apply($evaluator, { $binding => $_ });
+    }
+
+}
+
+package PIE::Expression::Symbol;
+use Moose;
+extends 'PIE::Expression';
+use Params::Validate qw/validate_pos/;
+use MooseX::ClassAttribute;
+
+class_has signature => (
+    is => 'ro',
+    default => sub { { symbol => PIE::FunctionArgument->new( name => 'symbol', type => 'Str')}});
+
+
 package PIE::Expression::Let;
 use Moose;
 extends 'PIE::Expression::ProgN';

Added: pie/branches/named-params/t/list.t
==============================================================================
--- (empty file)
+++ pie/branches/named-params/t/list.t	Mon May 26 08:48:12 2008
@@ -0,0 +1,54 @@
+use Test::More tests => 6;
+use strict;
+use_ok('PIE::Expression');
+use_ok('PIE::Evaluator');
+use_ok('PIE::Builder');
+use_ok('PIE::Lambda::Native');
+use_ok('PIE::FunctionArgument');
+use Test::Exception;
+my $builder = PIE::Builder->new();
+my $eval = PIE::Evaluator->new();
+
+my $script =
+    $builder->defun(
+    ops => [
+        { name => 'List',
+            args => {
+                nodes => [
+                     "hate",
+                     "love",
+                     "hate"  ] } } ],
+    signature => { });
+
+$eval->set_global_symbol( 'get-list' => $script );
+
+my @remembered;
+$eval->set_global_symbol( 'remember' =>
+PIE::Lambda::Native->new(
+    body => sub {
+        my $args = shift;
+        push @remembered, $args->{what};
+        return 1;
+    },
+
+    signature => {
+        'what' => PIE::FunctionArgument->new( name => 'what' => type => 'Str'),
+        }
+
+) );
+
+
+$eval->apply_script(
+    $builder->defun(
+    ops => [
+        { name => 'ForEach',
+            args => {
+                list => { name => 'get-list', args => {} },
+                binding => 'what',
+                do => { name => 'Symbol', args => { symbol => 'remember'} }
+                    }
+        } ],
+    signature => { }),
+ {});
+
+is_deeply(\@remembered, ['hate', 'love', 'hate']);