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

[jesse at bestpractical.com]

Author: jesse
Date: Fri May 23 08:19:57 2008
New Revision: 12640

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/01basic.t

Log:
Snapshot

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 08:19:57 2008
@@ -64,6 +64,7 @@
     
     $self->leave_stack_frame;
     return 1;
+
 }
 
 sub trace{}
@@ -85,8 +86,12 @@
         { ISA => "HASHREF" }
     );
     Carp::confess unless($lambda);
-   $lambda->args( $args );
-   $lambda->evaluate( $self);
+    #$lambda->args( $args );
+
+   my $ret = $lambda->evaluate( $self => $args);
+   warn "Coming back from te script, our ret was $ret";
+        $self->result->value($ret);
+        $self->result->success(1);
 }
 
 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 08:19:57 2008
@@ -97,13 +97,8 @@
 
 sub evaluate {
     my ($self, $evaluator) = validate_pos(@_, { isa => 'PIE::Expression'}, { isa => 'PIE::Evaluator'}, );
-    
-    
     $evaluator->run($self->args->{condition});
-    
-
     if ($evaluator->result->value) {
-        
         $evaluator->run($self->args->{if_true});
         return $evaluator->result->value;
         }    else { 

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 08:19:57 2008
@@ -20,7 +20,7 @@
 
 sub check_args {
     my $self = shift;
-    my $passed = $self->args; #reference to hash of provided args
+    my $passed = shift; #reference to hash of provided args
     my $expected = $self->signature; # expected args
     
     
@@ -45,7 +45,8 @@
 
 sub validate_args_or_die {
     my $self = shift;
-    my ( $missing, $unwanted ) = $self->check_args();
+    my $args = shift;
+    my ( $missing, $unwanted ) = $self->check_args( $args);
 
     if ( keys %$missing || keys %$unwanted ) {
         die "Function signature mismatch \n".
@@ -55,21 +56,21 @@
     }
 } 
 
-
 sub evaluate {
-    my ($self, $evaluator) = @_;
+    my ($self, $evaluator, $args) = @_;
+
 
-    $self->validate_args_or_die;
+    $self->validate_args_or_die($args);
     
     
     my $arguments = $self->signature;
     for (sort keys %$arguments) {
-        $evaluator->set_named( $_ => $arguments->{$_} );
+        $evaluator->set_named( $_ => $args->{$_} );
     }
     foreach my $node (@{$self->nodes}) {
         $evaluator->run($node);
     }
-    
+    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 08:19:57 2008
@@ -13,17 +13,16 @@
 
 
 sub evaluate {
-    my ( $self, $evaluator ) = @_;
+    my ( $self, $evaluator, $args ) = @_;
 
-    $self->validate_args_or_die;
+    $self->validate_args_or_die($args);
 
     my %args;
-    foreach my $key ( keys %{ $self->args } )  {
-        $args{$key} = lazy {  
-                        $evaluator->run( $self->args->{$key} );
-                        $evaluator->result->value  
-                    } 
-    } 
+    foreach my $key ( keys %$args ) {
+        $evaluator->run( $args->{$key} );
+        $args{$key} = $evaluator->result->value;
+
+    }
     my $r = $self->body->( \%args );
     return $r;
 }

Modified: pie/branches/named-params/t/01basic.t
==============================================================================
--- pie/branches/named-params/t/01basic.t	(original)
+++ pie/branches/named-params/t/01basic.t	Fri May 23 08:19:57 2008
@@ -65,10 +65,12 @@
 
 my $MATCH_REGEX = PIE::Lambda::Native->new(
     body => sub {
+        warn "HEY";
         my $args = shift;
         my $arg    = $args->{'tested-string'};
         my $regexp = $args->{'regexp'};
 
+        warn "REGEX CHECK: ". ($crg =~ m/$regexp/ )? 1 : 0;
         return ($arg =~ m/$regexp/ )? 1 : 0;
     },