[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