[Bps-public-commit] r12598 - in pie/trunk: lib/PIE/Lambda t

[clkao at bestpractical.com]

Author: clkao
Date: Wed May 21 06:23:47 2008
New Revision: 12598

Added:
   pie/trunk/lib/PIE/Lambda/
   pie/trunk/lib/PIE/Lambda/Native.pm
Modified:
   pie/trunk/lib/PIE/Evaluator.pm
   pie/trunk/lib/PIE/Lambda.pm
   pie/trunk/t/hello_world.t

Log:
lambda::native.

Modified: pie/trunk/lib/PIE/Evaluator.pm
==============================================================================
--- pie/trunk/lib/PIE/Evaluator.pm	(original)
+++ pie/trunk/lib/PIE/Evaluator.pm	Wed May 21 06:23:47 2008
@@ -48,13 +48,12 @@
 sub apply_script {
     my ($self, $lambda, @exp) = @_;
     if (ref($lambda) eq 'CODE') {
+        warn " deprecated";
         $lambda->(map {$self->run($_); $self->result->value } @exp);    
     }
     elsif ($lambda->isa("PIE::Lambda")) {
-        my $bindings = $lambda->bindings;
-        Carp::croak "unmatched number of arguments" unless $#{$bindings} == $#exp;
         # XXX: cleanup, unmask, etc
-        $self->set_named( $bindings->[$_] => $exp[$_] ) for 0.. $#exp;
+        $lambda->bind_expressions( $self, @exp );
         $lambda->evaluate($self);
     }
     else {

Modified: pie/trunk/lib/PIE/Lambda.pm
==============================================================================
--- pie/trunk/lib/PIE/Lambda.pm	(original)
+++ pie/trunk/lib/PIE/Lambda.pm	Wed May 21 06:23:47 2008
@@ -12,7 +12,12 @@
     is => 'rw',
     isa => 'ArrayRef[Str]');
 
-
+sub bind_expressions {
+    my ($self, $ev, @exp) = @_;
+    my $bindings = $self->bindings;
+    Carp::croak "unmatched number of arguments" unless $#{$bindings} == $#exp;
+    $ev->set_named( $bindings->[$_] => $exp[$_] ) for 0.. $#exp;
+}
 
 sub evaluate {
     my $self = shift;
@@ -20,7 +25,6 @@
     foreach my $node (@{$self->nodes}) {
         $evaluator->run($node);
     }
-    
 }
 
 1;

Added: pie/trunk/lib/PIE/Lambda/Native.pm
==============================================================================
--- (empty file)
+++ pie/trunk/lib/PIE/Lambda/Native.pm	Wed May 21 06:23:47 2008
@@ -0,0 +1,27 @@
+
+package PIE::Lambda::Native;
+use Moose; 
+extends 'PIE::Lambda';
+
+has body => (
+    is => 'ro',
+#    isa => 'CODE',
+);
+
+sub bind_expressions {
+    my ($self, $ev, @exp) = @_;
+    my $bindings = $self->bindings;
+    Carp::croak "unmatched number of arguments" unless $#{$bindings} == $#exp;
+
+    return;
+    Carp::croak "unmatched number of arguments" unless $#{$bindings} == $#exp;
+    $ev->set_named( $bindings->[$_] => $exp[$_] ) for 0.. $#exp;
+}
+
+sub evaluate {
+    my $self = shift;
+    my $ev = shift;
+    $self->body->(map {$ev->run($_); $self->result->value } @_);
+}
+
+1;

Modified: pie/trunk/t/hello_world.t
==============================================================================
--- pie/trunk/t/hello_world.t	(original)
+++ pie/trunk/t/hello_world.t	Wed May 21 06:23:47 2008
@@ -53,10 +53,16 @@
 my $hello = Hello->new;
 isa_ok($hello => 'Hello');
 
-
-$hello->evaluator->set_named('make-fred', sub { my $name = shift; return 'fred'});
+use PIE::Lambda::Native;
+$hello->evaluator->set_named('make-fred',
+                             PIE::Lambda::Native->new( body => sub { return 'fred'}));
 $hello->evaluator->set_named('make-bob', sub { my $name = shift; return 'bob'});
 
+$hello->evaluator->set_named('make-whoever',
+                             PIE::Lambda::Native->new( body => sub { return $_[0] },
+                                                       bindings => ['name'] ));
+
+
 my $tree = [ [ 'make-fred'] ];
 my $builder = PIE::Builder->new();
 my $script = $builder->build_expressions($tree);