[Bps-public-commit] r12617 - in pie/branches/named-params: . lib/PIE t
jesse at bestpractical.com
jesse at bestpractical.com
Thu May 22 09:23:59 EDT 2008
Author: jesse
Date: Thu May 22 09:23:58 2008
New Revision: 12617
Modified:
pie/branches/named-params/ (props changed)
pie/branches/named-params/lib/PIE/Builder.pm
pie/branches/named-params/lib/PIE/Evaluator.pm
pie/branches/named-params/lib/PIE/Expression.pm
pie/branches/named-params/lib/PIE/FunctionArgument.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:
r31873 at 31b: jesse | 2008-05-22 21:22:04 +0800
Basic support for named args. the only tests tht run are probably named-params
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 09:23:58 2008
@@ -4,13 +4,18 @@
use PIE::Lambda;
use PIE::Expression;
+use UNIVERSAL::require;
sub build_op_expression {
my ($self, $name, $args) = @_;
my $class = "PIE::Expression::$name";
- die unless $class->meta->does_role("PIE::Evaluatable");
-
- $class->new( map { $_ => $self->build_expression( $args->{$_} ) } keys %$args );
+ if ($class->require) {
+ die unless $class->meta->does_role("PIE::Evaluatable");
+ $class->new( map { $_ => $self->build_expression( $args->{$_} ) } keys %$args );
+ }
+ else {
+ PIE::Expression->new( name => $name, args => $args );
+ }
}
sub build_expression {
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 Thu May 22 09:23:58 2008
@@ -30,7 +30,7 @@
$self->result->success(1);
};
if (my $err = $@) {
- die $err; # for now
+# die $err; # for now
$self->result->success(0);
$self->result->error($err);
@@ -52,5 +52,10 @@
$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" } ) ;
+ $lambda->evaluate_named_args($self, $args);
+}
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 Thu May 22 09:23:58 2008
@@ -4,10 +4,21 @@
with 'PIE::Evaluatable';
+has name => (
+ is => 'ro',
+ isa => 'Str');
+
has elements => (
is => 'ro',
isa => 'ArrayRef');
+has args => (
+ is => 'rw',
+ default => sub { {} },
+ isa => 'HashRef[PIE::Expression]');
+
+#Attribute (args) does not pass the type constraint because: Validation failed for 'HashRef[PIE::FunctionArgument]' failed with value HASH(0x9a979c) at /opt/local/lib/perl5/site_perl/5.8.8/Moose/Meta/Attribute.pm line 340
+
# (foo bar (orz 1 ))
# === (eval 'foo bar (orz 1))
# === (apply foo ((bar (orz 1))
@@ -16,10 +27,19 @@
sub evaluate {
my ($self, $ev) = @_;
- my $func = $self->elements->[0];
- my @exp = @{ $self->elements }[1..$#{ $self->elements }];
- my $lambda = $ev->resolve_name($func);
- return $ev->apply_script($lambda, @exp);
+
+ 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/FunctionArgument.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/FunctionArgument.pm (original)
+++ pie/branches/named-params/lib/PIE/FunctionArgument.pm Thu May 22 09:23:58 2008
@@ -1,6 +1,8 @@
package PIE::FunctionArgument;
use Moose;
+
+
has name => (
is => 'rw',
isa => 'Str'
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 09:23:58 2008
@@ -12,12 +12,12 @@
is => 'rw',
isa => 'ArrayRef[Str]');
-has arguments => (
+has args => (
is => 'rw',
- isa => 'HashRef[PIE::Function::Argument]');
+ isa => 'HashRef[PIE::FunctionArgument]');
-sub check_bindings {
+sub check_args {
my $self = shift;
my $passed = shift;
my $bindings = $self->bindings;
@@ -27,7 +27,7 @@
sub bind_expressions {
my ($self, $ev, @exp) = @_;
- $self->check_bindings(\@exp);
+ $self->check_args(\@exp);
my $bindings = $self->bindings;
$ev->set_named( $bindings->[$_] => $exp[$_] ) for 0.. $#exp;
}
@@ -43,4 +43,51 @@
}
}
+
+sub check_named_args {
+ my $self = shift;
+ my $passed = shift; #reference to hash of provided args
+ my $args = $self->args; # expected args
+
+
+ my $missing = {};
+ my $unwanted = {};
+
+ my $fail =0;
+ foreach my $arg (keys %$passed) {
+ if (!$args->{$arg}) {
+ $unwanted->{$arg} = "The caller passed $arg which we were not expecting" ;
+ $fail++
+ };
+ }
+ foreach my $arg (keys %$args) {
+ if (!$passed->{$arg}) {
+
+ $missing->{$arg} = "The caller did not pass $arg which we require";
+ }
+ }
+
+ return $missing, $unwanted;
+}
+
+
+
+sub evaluate_named_args {
+ my ($self, $evaluator, $args) = @_;
+
+ my ($missing, $unwanted) = $self->check_named_args($args);
+
+ die if (keys %$missing || keys %$unwanted);
+
+ my $arguments = $self->args;
+ for (sort keys %$arguments) {
+ $evaluator->set_named( $_ => $arguments->{$_} );
+ }
+ foreach my $node (@{$self->nodes}) {
+ $evaluator->run($node);
+ }
+
+
+}
+
1;
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 Thu May 22 09:23:58 2008
@@ -20,4 +20,24 @@
$self->body->(map {$evaluator->run($_); $evaluator->result->value } @_);
}
+
+
+
+sub evaluate_named_args {
+ my ($self, $evaluator, $args) = @_;
+
+
+ my ($missing, $unwanted) = $self->check_named_args($args);
+
+
+ die "Something went wrong with your args" if (keys %$missing || keys %$unwanted);
+
+ 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);
+ return $r;
+}
+
+
1;
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 09:23:58 2008
@@ -39,46 +39,6 @@
-my $MATCH_REGEX = PIE::Lambda::Native->new( body => sub { my ($arg, $regexp) = @_;
- return $arg =~ m/$regexp/; },
-
- bindings => [ 'tested-string', 'regex' ],
-
- );
-
-
-
-my $eval5 = PIE::Evaluator->new;
-$eval5->set_named( 'match-regexp' => $MATCH_REGEX);
-
-
-
-my $match_p = PIE::Expression->new(elements => ['match-regexp',
- PIE::Expression::String->new( value => 'I do love software'),
- PIE::Expression::String->new( value =>'software')]);
-
-$eval5->run($match_p);
-ok ($eval5->result->success);
-
-is($eval5->result->value, 1);
-
-
-
-my $eval6 = PIE::Evaluator->new();
-
-$eval6->set_named( 'match-regexp' => $MATCH_REGEX);
-
-
-
-my $match_fail_p = PIE::Expression->new(elements => ['match-regexp',
- PIE::Expression::String->new( value => 'I do love hardware'),
- PIE::Expression::String->new( value =>'software')]);
-
-$eval6->run($match_fail_p);
-ok ($eval6->result->success);
-
-ok(!$eval6->result->value);
-
my $script = PIE::Lambda->new(nodes => [
PIE::Expression::True->new()
More information about the Bps-public-commit
mailing list