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

clkao at bestpractical.com clkao at bestpractical.com
Sun May 25 01:42:03 EDT 2008


Author: clkao
Date: Sun May 25 01:42:03 2008
New Revision: 12678

Modified:
   pie/branches/named-params/lib/PIE/Expression.pm
   pie/branches/named-params/t/let.t

Log:
let is an implicit lambda immediately applied.


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	Sun May 25 01:42:03 2008
@@ -187,7 +187,19 @@
 
 }
 
+sub mk_signature {
+    my $self = shift;
+    return { map { $_ => PIE::FunctionArgument->new( name => $_, type => 'Str') } keys %{ $self->bindings } };
+}
+
 sub evaluate {
+    my ($self, $evaluator) = @_;
+    $evaluator->apply_script(
+        PIE::Lambda->new(
+            progn     => PIE::Expression::ProgN->new( nodes => $self->nodes ),
+            signature => $self->mk_signature,
+        ),
+        $self->bindings );
 
 }
 

Modified: pie/branches/named-params/t/let.t
==============================================================================
--- pie/branches/named-params/t/let.t	(original)
+++ pie/branches/named-params/t/let.t	Sun May 25 01:42:03 2008
@@ -1,10 +1,11 @@
-use Test::More qw'no_plan';
+use Test::More tests => 13;
 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 $MATCH_REGEX = PIE::Lambda::Native->new(
     body => sub {
@@ -40,7 +41,8 @@
                                 name => 'match-regexp',
                                 args => {
                                     regexp => { name => 'Symbol', args => { symbol => 'REGEXP' } },
-                                    'tested-string' => { name => 'Symbol', args => { symbol => 'tested-string' } },
+                                    'tested-string' => 
+                                         { name => 'Symbol', args => { symbol => 'tested-string' } },
                                     }
                                 }
                             }
@@ -56,3 +58,11 @@
 ok(exists $script->progn->nodes->[0]->bindings->{REGEXP});
 isa_ok($script->progn->nodes->[0]->bindings->{REGEXP}, 'PIE::Expression');
 
+TODO: {
+    local $TODO = 'lexical loopup in outter blocks';
+lives_ok {
+$eval->apply_script( $script, { 'tested-string', 'you do love software' } );
+};
+ok( $eval->result->success, $eval->result->error );
+is( $eval->result->value, 'hate' );
+};



More information about the Bps-public-commit mailing list