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

jesse at bestpractical.com jesse at bestpractical.com
Fri May 23 05:20:52 EDT 2008


Author: jesse
Date: Fri May 23 05:20:50 2008
New Revision: 12634

Modified:
   pie/branches/named-params/lib/PIE/Builder.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
   pie/branches/named-params/t/hello_world.t

Log:
* There's a bit of return value wackyness, but it seems to otherwise be happy

Modified: pie/branches/named-params/lib/PIE/Builder.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Builder.pm	(original)
+++ pie/branches/named-params/lib/PIE/Builder.pm	Fri May 23 05:20:50 2008
@@ -23,7 +23,7 @@
 sub build_expression {
     my ($self, $tree) = @_;
     if (!ref($tree)) {
-        return PIE::Expression::String->new(value => $tree );
+        return PIE::Expression::String->new(args => { value => $tree} );
     }
     elsif (ref($tree) eq 'HASH') {
         return $self->build_op_expression($tree->{name}, $tree->{args});

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 05:20:50 2008
@@ -117,13 +117,28 @@
 use Params::Validate qw/validate_pos/;
 
 has signature => (
-    is => 'ro',
-    default => sub { { value => PIE::FunctionArgument->new( name => 'value', type => 'Str')}});
-    
-    
+    is      => 'ro',
+    default => sub {
+        { value => PIE::FunctionArgument->new( name => 'value', type => 'Str' )
+        };
+    }
+);
+
+has args => (
+    is => 'rw',
+    default => sub { {} },
+    isa => 'HashRef[Str]');
+
+
 sub evaluate {
-    my ($self, $eval) = validate_pos(@_, { isa => 'PIE::Expression'}, { isa => 'PIE::Evaluator'});
-    return $self->args->{value};
+    my ( $self, $eval ) = validate_pos(
+        @_,
+        { isa => 'PIE::Expression' },
+        { isa => 'PIE::Evaluator' }
+    );
+
+
+    return $self->args->{'value'};
 
 }
 
@@ -144,3 +159,4 @@
 }
 
 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 05:20:50 2008
@@ -47,10 +47,12 @@
 
 sub evaluate {
     my ($self, $evaluator, $args) = @_;
-    
     my ($missing, $unwanted)  = $self->check($args);
     
-    return undef if (keys %$missing || keys %$unwanted);
+    if (keys %$missing || keys %$unwanted) {
+            warn "Bad args! XXX TODO BETTER DIAGNOSTICS";
+        return undef;
+    }
     
     my $arguments = $self->signature;
     for (sort keys %$arguments) {

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 05:20:50 2008
@@ -11,18 +11,23 @@
 
 
 sub evaluate {
-    my ($self, $evaluator, $args) = @_;
+    my ( $self, $evaluator, $args ) = @_;
+
+    my ( $missing, $unwanted ) = $self->check($args);
 
-    
-    my ($missing, $unwanted)  = $self->check($args);
-    
     use YAML;
-    die "Something went wrong with your args". YAML::Dump($missing, $unwanted) if (keys %$missing || keys %$unwanted);
-    
+    die "Something went wrong with your args"
+        . YAML::Dump( $missing, $unwanted )
+        if ( keys %$missing || keys %$unwanted );
+
     my $arguments = $self->signature;
-    my %args = map { $evaluator->run($args->{$_}); ( $_ => $evaluator->result->value ) } keys %$args;
-    # XXX TODO - these are eagerly evaluated at this point. we probably want to lazy {} them with Scalar::Defer
-    my $r = $self->body->(\%args);    
+    my %args      = map {
+        $evaluator->run( $args->{$_} );
+        ( $_ => $evaluator->result->value )
+    } keys %$args;
+
+# XXX TODO - these are eagerly evaluated at this point. we probably want to lazy {} them with Scalar::Defer
+    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 05:20:50 2008
@@ -82,14 +82,13 @@
 $eval9->set_named( 'match-regexp' => $MATCH_REGEX );
 $eval9->apply_script(
     $MATCH_REGEX, 
-    {   'tested-string' => PIE::Expression::String->new( value => 'I do love software' ),
-        'regex' => PIE::Expression::String->new( value => 'software' )
+    {   'tested-string' => PIE::Expression::String->new( args => {value => 'I do love software'} ),
+        'regex' => PIE::Expression::String->new( args => { value => 'software' })
     }
 );
 
 ok( $eval9->result->success, $eval9->result->error );
 is( $eval9->result->value, 1 );
-
 my $builder = PIE::Builder->new();
 my $eval10 = PIE::Evaluator->new();
 $eval10->set_named( 'match-regexp' => $MATCH_REGEX );

Modified: pie/branches/named-params/t/hello_world.t
==============================================================================
--- pie/branches/named-params/t/hello_world.t	(original)
+++ pie/branches/named-params/t/hello_world.t	Fri May 23 05:20:50 2008
@@ -32,9 +32,10 @@
     my $self = shift;
     my $name = shift;
 
+     my $args = { name => PIE::Expression::String->new( args => { value => $name } ) };
     for ( @{ $self->rules || [] } ) {
-        $self->evaluator->apply_script( $_,
-            { name => PIE::Expression::String->new( value => $name ) } );
+        $self->evaluator->apply_script( $_, $args);
+
         last unless ( $self->evaluator->result->success );
         $name = $self->evaluator->result->value;
     }
@@ -79,7 +80,7 @@
 is( $hello->run('jesse'), 'Hello fred' );
 
 my $script2 = $builder->defun(
-    ops =>[ { name => 'make-bob' }, { name => 'make-fred' } ] ,
+    ops => [ { name => 'make-bob' }, { name => 'make-fred' } ],
     signature =>
         { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
 );
@@ -88,11 +89,16 @@
 
 is( $hello->run('jesse'), 'Hello fred' );
 
-my $script3 = $builder->defun( ops => [ { name => 'make-bob' } ], signature =>
-    { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) } );
-my $script4 = $builder->defun ( ops => [ { name => 'make-fred' } ],
-signature =>
-    { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) } );
+my $script3 = $builder->defun(
+    ops => [ { name => 'make-bob' } ],
+    signature =>
+        { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
+);
+my $script4 = $builder->defun(
+    ops => [ { name => 'make-fred' } ],
+    signature =>
+        { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
+);
 
 $hello->rules( [ $script3, $script4 ] );
 



More information about the Bps-public-commit mailing list