[Bps-public-commit] r12629 - in pie/branches/named-params: lib/PIE t
jesse at bestpractical.com
jesse at bestpractical.com
Fri May 23 03:00:26 EDT 2008
Author: jesse
Date: Fri May 23 03:00:25 2008
New Revision: 12629
Modified:
pie/branches/named-params/lib/PIE/Builder.pm
pie/branches/named-params/lib/PIE/Evaluatable.pm
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
pie/branches/named-params/t/hello_world.t
Log:
* removed dead code (including support for functions without named args)
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 03:00:25 2008
@@ -25,13 +25,10 @@
if (!ref($tree)) {
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]);
- }
elsif (ref($tree) eq 'HASH') {
return $self->build_op_expression($tree->{name}, $tree->{args});
+ } else {
+ Carp::confess("Don't know what to do with a tree that looksl ike ". YAML::Dump($tree));
}
}
@@ -39,16 +36,7 @@
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;
-
- return PIE::Lambda->new( nodes => [map { $self->build_expression($_) } @$ops ] );
-}
-
-
1;
Modified: pie/branches/named-params/lib/PIE/Evaluatable.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Evaluatable.pm (original)
+++ pie/branches/named-params/lib/PIE/Evaluatable.pm Fri May 23 03:00:25 2008
@@ -2,6 +2,6 @@
package PIE::Evaluatable;
use Moose::Role;
-requires 'evaluate';
+requires 'evaluate_named_args';
1;
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 03:00:25 2008
@@ -25,7 +25,7 @@
my $self = shift;
my $expression = shift;
eval {
- my $ret = $expression->evaluate($self);
+ my $ret = $expression->evaluate_named_args($self);
$self->result->value($ret);
$self->result->success(1);
};
@@ -47,13 +47,6 @@
}
-sub apply_script {
- # self, a lambda, any number of positional params. (to be replaced with a params object?)
- my ($self, $lambda, @exp) = validate_pos(@_, { isa => 'PIE::Evaluator'}, { ISA => 'PIE::Lambda'}, (0) x (@_ - 2) ) ;
- # XXX: cleanup, unmask, etc
- $lambda->evaluate($self, @exp);
-}
-
sub apply_script_named_args {
# self, a lambda, any number of positional params. (to be replaced with a params object?)
my ($self, $lambda, $args) = validate_pos(@_, { isa => 'PIE::Evaluator'}, { ISA => 'PIE::Lambda'}, { ISA => "HASHREF" } ) ;
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 03:00:25 2008
@@ -12,6 +12,11 @@
is => 'ro',
isa => 'ArrayRef');
+has signature => (
+ is => 'rw',
+ default => sub { {}},
+ isa => 'HashRef[PIE::FunctionArgument]');
+
has args => (
is => 'rw',
default => sub { {} },
@@ -25,21 +30,10 @@
-sub evaluate {
+sub evaluate_named_args {
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 );
-
-
}
@@ -47,16 +41,15 @@
use Moose;
extends 'PIE::Expression';
-
-sub evaluate {1}
+sub evaluate_named_args {1}
package PIE::Expression::False;
use Moose;
extends 'PIE::Expression::True';
-sub evaluate {
+sub evaluate_named_args {
my $self = shift;
- return ! $self->SUPER::evaluate();
+ return ! $self->SUPER::evaluate_named_args();
}
@@ -64,10 +57,15 @@
use Moose;
extends 'PIE::Expression';
-has items => ( is => 'rw', isa => 'ArrayRef[PIE::Evaluatable]');
-has block => ( is => 'rw', isa => 'PIE::Evaluatable');
+has signature => (
+ is => 'ro',
+ default => sub { items => PIE::FunctionArgument->new(name => 'items', type => 'ArrayRef[PIE::Evaluatable]'),
+ block => PIE::FunctionARgument->new(name => 'block', type => 'PIE::Evaluatable')}
+
+);
-sub evaluate {
+
+sub evaluate_named_args {
my $self = shift;
}
@@ -75,36 +73,40 @@
package PIE::Expression::IfThen;
use Moose;
extends 'PIE::Expression';
+use Params::Validate qw/validate_pos/;
+has signature => (
+ is => 'ro',
+ default => sub {
+ {
+ condition => PIE::FunctionArgument->new(
+ name => 'condition',
+ isa => 'PIE::Evaluatable'),
+
+ if_true => PIE::FunctionArgument->new(
+ name => 'if_true',
+ isa => 'PIE::Evaluatable'),
+ if_false => PIE::FunctionArgument->new(
+ name => 'if_false',
+ isa => 'PIE::Evaluatable'
+ )
+ }
+ }
+);
-has condition => (
- is => 'rw',
- does => 'PIE::Evaluatable');
+sub evaluate_named_args {
+ my ($self, $evaluator) = validate_pos(@_, { isa => 'PIE::Expression'}, { isa => 'PIE::Evaluator'}, );
-has if_true => (
- is => 'rw',
- does => 'PIE::Evaluatable');
-
-has if_false => (
- is => 'rw',
- does => 'PIE::Evaluatable');
-
-sub arguments { return qw(condition if_true if_false)}
-
-
-sub evaluate {
- my $self = shift;
- my $evaluator = shift;
- $evaluator->run($self->condition);
+ $evaluator->run($self->args->{condition});
if ($evaluator->result->value) {
- $evaluator->run($self->if_true);
+ $evaluator->run($self->args->{if_true});
return $evaluator->result->value;
} else {
- $evaluator->run($self->if_false);
+ $evaluator->run($self->args->{if_false});
return $evaluator->result->value;
}
}
@@ -112,31 +114,33 @@
package PIE::Expression::String;
use Moose;
extends 'PIE::Expression';
+use Params::Validate qw/validate_pos/;
-has value => (
- is => 'rw',
- isa => 'Str | Undef');
+has signature => (
+ is => 'ro',
+ default => sub { { value => PIE::FunctionArgument->new( name => 'value', type => 'Str')}});
-sub evaluate {
- my $self = shift;
- return $self->value;
+sub evaluate_named_args {
+ my ($self, $eval, $args) = validate_pos(@_, { isa => 'PIE::Expression'}, { isa => 'PIE::Evaluator'}, 1);
+ return $args->{value};
}
package PIE::Expression::Symbol;
use Moose;
extends 'PIE::Expression';
+use Params::Validate qw/validate_pos/;
-has symbol => (
- is => 'rw',
- isa => 'Str');
+has signature => (
+ is => 'ro',
+ default => sub { { symbol => PIE::FunctionArgument->new( name => 'symbol', type => 'Str')}});
-sub evaluate {
- my ($self, $ev) = @_;
- my $result = $ev->get_named($self->symbol);
- return $result->isa('PIE::Expression') ? $ev->run($result) : $result; # XXX: figure out evaluation order here
+sub evaluate_named_args {
+ my ($self, $eval, $args) = validate_pos(@_, { isa => 'PIE::Expression'}, { isa => 'PIE::Evaluator'});
+ my $result = $eval->get_named($self->args->{'symbol'});
+ return $result->isa('PIE::Expression') ? $eval->run($result) : $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 03:00:25 2008
@@ -17,33 +17,6 @@
isa => 'HashRef[PIE::FunctionArgument]');
-sub check_args {
- my $self = shift;
- my $passed = shift;
- my $bindings = $self->bindings;
- Carp::croak "unmatched number of arguments. ".($#{$bindings}+1)." expected. Got ".($#{$passed}+1) unless $#{$bindings} == $#{$passed};
-
-}
-
-sub bind_expressions {
- my ($self, $ev, @exp) = @_;
- $self->check_args(\@exp);
- my $bindings = $self->bindings;
- $ev->set_named( $bindings->[$_] => $exp[$_] ) for 0.. $#exp;
-}
-
-sub evaluate {
- my $self = shift;
- my $evaluator = shift;
-
- $self->bind_expressions( $evaluator, @_ );
-
- foreach my $node (@{$self->nodes}) {
- $evaluator->run($node);
- }
-}
-
-
sub check_named_args {
my $self = shift;
my $passed = shift; #reference to hash of provided args
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 03:00:25 2008
@@ -8,19 +8,6 @@
# isa => 'CODE',
);
-sub bind_expressions {
- my ($self, $evaluator, @exp) = @_;
- return;
-}
-
-sub evaluate {
- my $self = shift;
- my $evaluator = shift;
- $self->check_bindings(\@_);
- $self->body->(map {$evaluator->run($_); $evaluator->result->value } @_);
-}
-
-
sub evaluate_named_args {
@@ -35,7 +22,7 @@
my $arguments = $self->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);
+ 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 03:00:25 2008
@@ -65,9 +65,9 @@
my $MATCH_REGEX = PIE::Lambda::Native->new(
body => sub {
- my %args = (@_);
- my $arg = $args{'tested-string'};
- my $regexp = $args{'regexp'};
+ my $args = shift;
+ my $arg = $args->{'tested-string'};
+ my $regexp = $args->{'regexp'};
return ($arg =~ m/$regexp/ )? 1 : 0;
},
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 03:00:25 2008
@@ -58,7 +58,7 @@
$hello->evaluator->set_named(
'make-whoever',
PIE::Lambda::Native->new(
- body => sub { my %args = @_; return $args{'name'} },
+ body => sub { my $args = shift; return $args->{'name'} },
args => {
name => PIE::FunctionArgument->new( name => 'name', type => 'Str' )
}
@@ -75,7 +75,7 @@
);
$hello->rules( [$script] );
-can_ok( $hello->rules->[0], 'evaluate' );
+can_ok( $hello->rules->[0], 'evaluate_named_args' );
is( $hello->run('jesse'), 'Hello fred' );
my $script2 = $builder->defun(
@@ -84,7 +84,7 @@
{ name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
);
$hello->rules( [$script2] );
-can_ok( $hello->rules->[0], 'evaluate' );
+can_ok( $hello->rules->[0], 'evaluate_named_args' );
is( $hello->run('jesse'), 'Hello fred' );
@@ -96,12 +96,12 @@
$hello->rules( [ $script3, $script4 ] );
-can_ok( $hello->rules->[0], 'evaluate' );
-can_ok( $hello->rules->[1], 'evaluate' );
+can_ok( $hello->rules->[0], 'evaluate_named_args' );
+can_ok( $hello->rules->[1], 'evaluate_named_args' );
is( $hello->run('jesse'), 'Hello fred' );
$hello->rules( [ $hello->evaluator->get_named('make-whoever') ] );
-can_ok( $hello->rules->[0], 'evaluate' );
+can_ok( $hello->rules->[0], 'evaluate_named_args' );
is( $hello->run('jesse'), 'Hello jesse' );
1;
More information about the Bps-public-commit
mailing list