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

[jesse at bestpractical.com]

Author: jesse
Date: Fri May 23 22:39:18 2008
New Revision: 12653

Modified:
   pie/branches/named-params/lib/PIE/Evaluator.pm
   pie/branches/named-params/lib/PIE/Expression.pm
   pie/branches/named-params/lib/PIE/Lambda.pm
   pie/branches/named-params/lib/PIE/Lambda/Native.pm
   pie/branches/named-params/t/leaky-lexicals.t
   pie/branches/named-params/t/named-params.t

Log:
* all tests pass. ship it

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	Fri May 23 22:39:18 2008
@@ -54,16 +54,16 @@
     my $self       = shift;
     my $expression = shift;
     $self->enter_stack_frame;
+#    warn( ("-" x $self->stack_depth) .  "$expression enter");
     eval {
         Carp::confess unless ($expression);
-        $YAML::DumpCode++;
-        warn YAML::Dump($expression);
         my $ret = $expression->evaluate($self);
+
+
         $self->result->value($ret);
         $self->result->success(1);
     };
     if ( my $err = $@ ) {
-
         #        die $err; # for now
 
         $self->result->success(0);
@@ -71,11 +71,12 @@
         $self->result->error($err);
     }
 
+#    warn (("-" x $self->stack_depth) , " returns : " . $self->result->value(). " - ".$self->result->success . " - " .$self->result->error);
+#    warn (("-" x $self->stack_depth),  "$expression done");
     $self->trace();
     
     $self->leave_stack_frame;
-    return 1;
-
+    return $self->result->success;
 }
 
 sub trace{}
@@ -84,7 +85,6 @@
 sub resolve_name {
     my ($self, $name) = @_;
     my $stack = $self->stack_vars->[-1] || {};
-    warn YAML::Dump($name); 
     Carp::cluck if ref($name);
     $stack->{$name} || $self->get_named($name) || die "Could not find symbol $name in the current lexical context.";
 }
@@ -99,10 +99,10 @@
         { ISA => "HASHREF" }
     );
     Carp::confess unless($lambda);
-    
     my $ret = $lambda->apply( $self => $args);
     $self->result->value($ret);
     $self->result->success(1);
+    return $self->result->value;
 }
 
 1;

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	Fri May 23 22:39:18 2008
@@ -153,10 +153,9 @@
     
 sub evaluate {
     my ($self, $eval) = validate_pos(@_, { isa => 'PIE::Expression'}, { isa => 'PIE::Evaluator'});
-    warn "About to resolve the symbol name ". $self->args->{'symbol'};
-    my $result = $eval->resolve_name($self->args->{'symbol'});
-    warn "Done";
-    return $result->isa('PIE::Expression') ? $eval->run($result) : $result; # XXX: figure out evaluation order here
+    my $symbol = $self->{'args'}->{'symbol'}->evaluate($eval);
+    my $result = $eval->resolve_name($symbol);
+    return $result->meta->does_role('PIE::Evaluatable') ? $result->evaluate($eval): $result; # XXX: figure out evaluation order here
 }
 
 1;

Modified: pie/branches/named-params/lib/PIE/Lambda.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Lambda.pm	(original)
+++ pie/branches/named-params/lib/PIE/Lambda.pm	Fri May 23 22:39:18 2008
@@ -58,13 +58,15 @@
     my $arguments = $self->signature;
 
     $evaluator->push_stack_vars( $args );
+    my $res;
     foreach my $node (@{$self->nodes}) {
-        $evaluator->run($node);
+       $res =  $node->evaluate($evaluator);
     }
 
     $evaluator->pop_stack_vars( $args );
+    return $res;
+    #return $evaluator->result->value; 
 
-    return $evaluator->result->value; 
     
 }
 

Modified: pie/branches/named-params/lib/PIE/Lambda/Native.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Lambda/Native.pm	(original)
+++ pie/branches/named-params/lib/PIE/Lambda/Native.pm	Fri May 23 22:39:18 2008
@@ -16,14 +16,7 @@
     my ( $self, $evaluator, $args ) = @_;
 
     $self->validate_args_or_die($args);
-
-    my %args;
-    foreach my $key ( keys %$args ) {
-        $evaluator->run( $args->{$key} );
-        $args{$key} = $evaluator->result->value;
-
-    }
-    my $r = $self->body->( \%args );
+    my $r = $self->body->( {map { $_ => $args->{$_}->evaluate($evaluator) } keys %$args });
     return $r;
 }
 

Modified: pie/branches/named-params/t/leaky-lexicals.t
==============================================================================
--- pie/branches/named-params/t/leaky-lexicals.t	(original)
+++ pie/branches/named-params/t/leaky-lexicals.t	Fri May 23 22:39:18 2008
@@ -12,11 +12,13 @@
 my $builder = PIE::Builder->new();
 
 my $A_SIDE = PIE::Builder->defun( 
-        ops => [ {
-                    name => 'Symbol',
-                    args => { symbol => 'x'},
-                    { name => 'Symbol',
-                        args => { symbol => 'y'}}}],
+        ops => [ 
+        
+         { name => 'Symbol', args => { symbol => 'x'}},
+                    { name => 'Symbol', args => { symbol => 'y'} }
+                
+                
+                ],
         signature => { x => PIE::FunctionArgument->new(name => 'x', type => 'Str')});
 
 
@@ -28,8 +30,8 @@
         { y => PIE::FunctionArgument->new( name => 'y', type => 'String' ) }
 );
 
+$eval->set_named( b=> $defined_b);
 
-
-$eval->apply_script( $defined_b, { y => 'Y123' });
+$eval->run( $builder->build_expression( { name => 'b', args => { y => 'Y123' }}));
 ok (!$eval->result->success);
-is($eval->result->error,'');
+like($eval->result->error,qr/Could not find symbol y in the current lexical context/);

Modified: pie/branches/named-params/t/named-params.t
==============================================================================
--- pie/branches/named-params/t/named-params.t	(original)
+++ pie/branches/named-params/t/named-params.t	Fri May 23 22:39:18 2008
@@ -52,7 +52,6 @@
 
 $eval6->run($match_fail_p);
 ok( $eval6->result->success );
-warn $eval6->result->value;
 ok( !$eval6->result->value );
 
 
@@ -65,4 +64,5 @@
 );
 
 $eval6->run($match_orz);
+
 ok( !$eval6->result->success, "yay! it failed when we gave it a wrong argument name". $eval6->result->error );