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

jesse at bestpractical.com jesse at bestpractical.com
Thu May 22 10:42:47 EDT 2008


Author: jesse
Date: Thu May 22 10:42:40 2008
New Revision: 12619

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/t/01basic.t
   pie/branches/named-params/t/hello_world.t

Log:
* Clkao, what idiot thing am I doing wrong?


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	Thu May 22 10:42:40 2008
@@ -1,8 +1,9 @@
 
 package PIE::Builder;
 use Moose;
-
+use Params::Validate;
 use PIE::Lambda;
+
 use PIE::Expression;
 use UNIVERSAL::require;
 
@@ -14,7 +15,7 @@
         $class->new( map { $_ => $self->build_expression( $args->{$_} ) } keys %$args );
     }
     else {
-        PIE::Expression->new( name => $name, args => $args );
+        PIE::Expression->new( name => $name, args => $args || {} );
     }
 }
 
@@ -24,6 +25,7 @@
         return PIE::Expression::String->new(value => $tree );
     }
     elsif (ref($tree) eq 'ARRAY') {
+        Carp::confess ("Aaaaa bad deprecated code");
         my ($func, @rest) = @$tree;
         return PIE::Expression->new( elements => [$func, map { $self->build_expression($_) } @rest]);
     }
@@ -33,6 +35,13 @@
 }
 
 
+sub defun {
+    my $self = shift;
+    my %args = validate( @_, { ops => 1, args => 1 });
+    warn YAML::Dump(\%args); use YAML;
+    return PIE::Lambda->new( nodes => [map { $self->build_expression($_) } @{$args{ops}} ], args => $args{args} );
+}
+
 sub build_expressions {
     my $self = shift;
     my $ops = shift;

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	Thu May 22 10:42:40 2008
@@ -8,10 +8,6 @@
    is => 'ro',
    isa => 'Str');
 
-has elements => (
-   is => 'ro',
-   isa => 'ArrayRef');
-
 has args => (
     is => 'rw',
     default => sub { {} },
@@ -26,20 +22,6 @@
 
 
 sub evaluate {
-    my ($self, $ev) = @_;
-    
-    if ($self->elements) {
-        # deprecated
-        my $func = $self->elements->[0];
-        my @exp = @{ $self->elements }[1..$#{ $self->elements }];
-        my $lambda = $ev->resolve_name($func);
-        return $ev->apply_script($lambda, @exp);
-    }
-
-    my $lambda = $ev->resolve_name($self->name);
-    return $ev->apply_script_named_args( $lambda, $self->args );
-
-    
 }
 
 

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	Thu May 22 10:42:40 2008
@@ -77,7 +77,7 @@
     
     my ($missing, $unwanted)  = $self->check_named_args($args);
     
-    die if (keys %$missing || keys %$unwanted);
+    return undef if (keys %$missing || keys %$unwanted);
     
     my $arguments = $self->args;
     for (sort keys %$arguments) {

Modified: pie/branches/named-params/t/01basic.t
==============================================================================
--- pie/branches/named-params/t/01basic.t	(original)
+++ pie/branches/named-params/t/01basic.t	Thu May 22 10:42:40 2008
@@ -5,114 +5,132 @@
 use_ok('PIE::Lambda');
 use_ok('PIE::Lambda::Native');
 use_ok('PIE::Builder');
-
+use_ok('PIE::FunctionArgument');
 my $trivial = PIE::Expression::True->new;
 
 my $evaluator = PIE::Evaluator->new;
-ok ($evaluator->run($trivial));
-ok($evaluator->result->success);
-ok($evaluator->result->value);
-
+ok( $evaluator->run($trivial) );
+ok( $evaluator->result->success );
+ok( $evaluator->result->value );
 
 my $false = PIE::Expression::False->new();
 my $eval2 = PIE::Evaluator->new;
-ok($eval2->run($false));
-ok(!$eval2->result->value);
-ok($eval2->result->success);
-
+ok( $eval2->run($false) );
+ok( !$eval2->result->value );
+ok( $eval2->result->success );
+
+my $if_true = PIE::Expression::IfThen->new(
+    condition => PIE::Expression::True->new(),
+    if_true   => PIE::Expression::True->new(),
+    if_false  => PIE::Expression::False->new()
+);
 
-my $if_true = PIE::Expression::IfThen->new( condition => PIE::Expression::True->new(),                                           if_true => PIE::Expression::True->new(),if_false => PIE::Expression::False->new());
-                                            
 my $eval3 = PIE::Evaluator->new();
-ok($eval3->run($if_true));
-ok($eval3->result->value);
-ok($eval2->result->success);
+ok( $eval3->run($if_true) );
+ok( $eval3->result->value );
+ok( $eval2->result->success );
+
+my $if_false = PIE::Expression::IfThen->new(
+    condition => PIE::Expression::False->new(),
+    if_true   => PIE::Expression::True->new(),
+    if_false  => PIE::Expression::False->new()
+);
 
-my $if_false = PIE::Expression::IfThen->new( condition => PIE::Expression::False->new(),                                           if_true => PIE::Expression::True->new(),if_false => PIE::Expression::False->new());
-                                            
 my $eval4 = PIE::Evaluator->new();
-ok($eval4->run($if_false));
-ok(!$eval4->result->value);
-ok($eval4->result->success);
-
-
+ok( $eval4->run($if_false) );
+ok( !$eval4->result->value );
+ok( $eval4->result->success );
 
-
-
-
-my $script = PIE::Lambda->new(nodes => [ 
+my $script = PIE::Lambda->new(
+    nodes => [
         PIE::Expression::True->new()
 
-],
+    ],
 
 );
 
 my $eval7 = PIE::Evaluator->new();
 $eval7->apply_script($script);
-ok($eval7->result->success);
-ok($eval7->result->value);
-
-
+ok( $eval7->result->success );
+ok( $eval7->result->value );
 
-my $script2 = PIE::Lambda->new(
-    nodes => [
-                $if_true ]);
+my $script2 = PIE::Lambda->new( nodes => [$if_true] );
 
 my $eval8 = PIE::Evaluator->new();
 $eval8->apply_script($script2);
-ok($eval8->result->success);
-ok($eval8->result->value);
+ok( $eval8->result->success );
+ok( $eval8->result->value );
 
 my $eval9 = PIE::Evaluator->new();
 
-$eval9->set_named( 'match-regexp' => $MATCH_REGEX);
+my $MATCH_REGEX = PIE::Lambda::Native->new(
+    body => sub {
+        my %args   = (@_);
+        my $arg    = $args{'tested-string'};
+        my $regexp = $args{'regexp'};
+
+        return $arg =~ m/$regexp/;
+    },
+
+    args => {
+        'tested-string' => PIE::FunctionArgument->new(
+            name => 'tested-string' => type => 'Str'
+        ),
+        'regex' => PIE::FunctionArgument->new( name => 'regex', type => 'Str' )
+        }
 
+);
 
+$eval9->set_named( 'match-regexp' => $MATCH_REGEX );
 
 my $match_script = PIE::Lambda->new(
-
-    nodes => [
-        PIE::Expression->new(
-            elements => [
-                'match-regexp',
-                PIE::Expression::Symbol->new( symbol => 'tested-string' ),
-                PIE::Expression::Symbol->new( symbol => 'regex' ),
-            ]
-        )
-    ],
-    bindings => [ 'tested-string', 'regex' ],
+    nodes => [ PIE::Expression->new( name => 'match-regexp' ) ],
+    args  => {
+        'tested-string' => PIE::FunctionArgument->new(
+            name => 'tested-string',
+            type => 'Str'
+        ),
+        'regex' =>
+            PIE::FunctionArgument->new( name => 'regex', type => 'Regex' )
+    }
 );
 
+$eval9->apply_script_named_args(
+    $match_script,
+    {   'tested-string' =>
+            PIE::Expression::String->new( value => 'I do love hardware' ),
+        'regex' => PIE::Expression::String->new( value => 'software' )
+    }
+);
 
-$eval9->apply_script($match_script,                                                 PIE::Expression::String->new( value => 'I do love hardware'), 
-                                                PIE::Expression::String->new( value =>'software') );
-
-ok ($eval9->result->success);
-
-is($eval9->result->value, 1);
-my $tree = 
-[
-          {
-            name => 'IfThen',
-            args => {
-                          'if_true' => 'hate',
-                          'if_false' => 'love',
-                          'condition' => [ 'match-regexp', 'software', 'foo' ],
-                        }
-          }
-        ];
-
+ok( $eval9->result->success );
 
+is( $eval9->result->value, 1 );
 my $builder = PIE::Builder->new();
+
 #use YAML;
 
 my $eval10 = PIE::Evaluator->new();
+$eval10->set_named( 'match-regexp' => $MATCH_REGEX );
 
-$eval10->set_named( 'match-regexp' => $MATCH_REGEX);
-
-
-$eval10->apply_script( $builder->build_expressions($tree) );
-ok($eval10->result->success);
-is($eval10->result->value,'love');
-
+$eval10->apply_script_named_args(
+    $builder->defun(
+        ops  => [ {name =>'IfThen'} ],
+        args => {
+            'if_true'   => PIE::Expression::String->new( value => 'hate' ),
+            'if_false'  => PIE::Expression::String->new( value => 'love' ),
+            'condition' => {
+                ops  => [ {name =>'match-regexp'} ],
+                args => {
+                    regex =>
+                        PIE::Expression::String->new( value => 'software' ),
+                    'tested-string' =>
+                        PIE::Expression::String->new( value => 'foo' )
+                }
+            },
+        }
+    )
+);
+ok( $eval10->result->success );
+is( $eval10->result->value, ' love ' );
 

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	Thu May 22 10:42:40 2008
@@ -1,8 +1,8 @@
-use Test::More tests => 13;
-
+use Test::More tests => 14;
 
 use_ok('PIE::Evaluator');
 use_ok('PIE::Builder');
+use_ok('PIE::FunctionArgument');
 
 package Hello;
 
@@ -10,90 +10,98 @@
 use MooseX::AttributeHelpers;
 
 has 'evaluator' => (
-    is => 'rw',
-    isa => 'PIE::Evaluator',
-    lazy => 1,
-    default => sub { return PIE::Evaluator->new()},
+    is      => 'rw',
+    isa     => 'PIE::Evaluator',
+    lazy    => 1,
+    default => sub { return PIE::Evaluator->new() },
 );
 
 has 'rules' => (
-#    metaclass => 'Collection::Array',
-    is => 'rw',
-    isa => 'ArrayRef',
-#     provides  => {
-#                 push       => 'push_rules'
-#     },
-#    default   => sub { [] },
-    );
-
 
+    #    metaclass => 'Collection::Array',
+    is  => 'rw',
+    isa => 'ArrayRef',
 
+    #     provides  => {
+    #                 push       => 'push_rules'
+    #     },
+    #    default   => sub { [] },
+);
 
-sub run { 
+sub run {
     my $self = shift;
     my $name = shift;
 
-    for (@{$self->rules||[]}) {
-        $self->evaluator->apply_script($_, 
-                                       PIE::Expression::String->new( value => $name ));
-        last unless ($self->evaluator->result->success);
-        $name =  $self->evaluator->result->value;
-    }   
+    for ( @{ $self->rules || [] } ) {
+        $self->evaluator->apply_script_named_args( $_,
+            { name => PIE::Expression::String->new( value => $name ) } );
+        last unless ( $self->evaluator->result->success );
+        $name = $self->evaluator->result->value;
+    }
 
     return "Hello $name";
 }
 
-
-
-
 package main;
 
-is (Hello->new->run('jesse'),'Hello jesse');
+is( Hello->new->run('jesse'), 'Hello jesse' );
 
 my $hello = Hello->new;
-isa_ok($hello => 'Hello');
+isa_ok( $hello => 'Hello' );
 
 use PIE::Lambda::Native;
-$hello->evaluator->set_named('make-fred',
-                             PIE::Lambda::Native->new( body => sub { return 'fred'}));
-$hello->evaluator->set_named('make-bob', PIE::Lambda::Native->new( body => sub { my $name = shift; return 'bob'}));
-
-$hello->evaluator->set_named('make-whoever',
-                             PIE::Lambda::Native->new( body => sub { return $_[0] },
-                                                       bindings => ['name'] ));
+$hello->evaluator->set_named( 'make-fred',
+    PIE::Lambda::Native->new( body => sub { return 'fred' } ) );
+$hello->evaluator->set_named( 'make-bob',
+    PIE::Lambda::Native->new( body => sub { return 'bob' } ) );
+
+$hello->evaluator->set_named(
+    'make-whoever',
+    PIE::Lambda::Native->new(
+        body => sub { my %args = @_; return $args{'name'} },
+        args => {
+            name => PIE::FunctionArgument->new( name => 'name', type => 'Str' )
+            }
 
+    )
+);
 
-my $tree = [ [ 'make-fred'] ];
+my $tree    = [ { name => 'make-fred' } ];
 my $builder = PIE::Builder->new();
-my $script = $builder->build_expressions($tree);
-$script->bindings([ 'name' ]);
-
-$hello->rules([ $script]);
-can_ok($hello->rules->[0], 'evaluate');
-is ($hello->run('jesse'),'Hello fred');
-
-my $script2 = $builder->build_expressions([ ['make-bob'], ['make-fred'] ] );
-$script2->bindings([ 'name' ]);
-$hello->rules([ $script2 ]);
-can_ok($hello->rules->[0], 'evaluate');
-
-is ($hello->run('jesse'),'Hello fred');
-
-my $script3 = $builder->build_expressions([ ['make-bob'] ]);
-$script3->bindings([ 'name' ]);
-my $script4 = $builder->build_expressions([ ['make-fred'] ]);
-$script4->bindings([ 'name' ]);
-
-$hello->rules([ $script3, $script4 ]);
-
-can_ok($hello->rules->[0], 'evaluate');
-can_ok($hello->rules->[1], 'evaluate');
-is ($hello->run('jesse'),'Hello fred');
+my $script  = $builder->defun(
+    ops => $tree,
+    args =>
+        { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
+);
 
+$hello->rules( [$script] );
+can_ok( $hello->rules->[0], 'evaluate' );
+is( $hello->run('jesse'), 'Hello fred' );
+
+my $script2 = $builder->defun(
+    ops =>[ { name => 'make-bob' }, { name => 'make-fred' } ] ,
+ args =>
+        { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
+);
+$hello->rules( [$script2] );
+can_ok( $hello->rules->[0], 'evaluate' );
 
-$hello->rules([ $hello->evaluator->get_named('make-whoever') ]);
-can_ok($hello->rules->[0], 'evaluate');
-is ($hello->run('jesse'),'Hello jesse');
+is( $hello->run('jesse'), 'Hello fred' );
 
+my $script3 = $builder->defun( ops => [ { name => 'make-bob' } ], args =>
+    { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) } );
+my $script4 = $builder->defun ( ops => [ { name => 'make-fred' } ],
+args =>
+    { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) } );
+
+$hello->rules( [ $script3, $script4 ] );
+
+can_ok( $hello->rules->[0], 'evaluate' );
+can_ok( $hello->rules->[1], 'evaluate' );
+is( $hello->run('jesse'), 'Hello fred' );
+
+$hello->rules( [ $hello->evaluator->get_named('make-whoever') ] );
+can_ok( $hello->rules->[0], 'evaluate' );
+is( $hello->run('jesse'), 'Hello jesse' );
 
 1;



More information about the Bps-public-commit mailing list