[Bps-public-commit] r12636 - in pie/branches/named-params: lib/PIE t
jesse at bestpractical.com
jesse at bestpractical.com
Fri May 23 06:12:40 EDT 2008
Author: jesse
Date: Fri May 23 06:12:39 2008
New Revision: 12636
Modified:
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/named-params.t
Log:
* refactor the arg processing a bit
* lazy args for native lambdas
* better diagnostics when you call a missing funtion or mess up your args
* make args an attribute of the lambda/expression object
* made the named params test what they were supposed to
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 06:12:39 2008
@@ -21,9 +21,30 @@
set => 'set_named',
});
+has stack_depth => (
+ is => 'rw',
+ isa => 'Int',
+ default => sub { 0}
+ );
+
+
+sub enter_stack_frame {
+ my $self = shift;
+ $self->stack_depth($self->stack_depth+1);
+}
+
+sub leave_stack_frame {
+ my $self = shift;
+ die "Trying to leave stack frame 0. Too many returns. Something relaly bad happened" if ($self->stack_depth == 0);
+ $self->stack_depth($self->stack_depth-1);
+}
+
+
+
sub run {
my $self = shift;
my $expression = shift;
+ $self->enter_stack_frame;
eval {
Carp::confess unless ($expression);
my $ret = $expression->evaluate($self);
@@ -39,9 +60,15 @@
$self->result->error($err);
}
+ $self->trace();
+
+ $self->leave_stack_frame;
return 1;
}
+sub trace{}
+
+
sub resolve_name {
my ($self, $name) = @_;
$self->get_named($name);
@@ -49,9 +76,17 @@
sub apply_script {
- # 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($self, $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" }
+ );
+ Carp::confess unless($lambda);
+ $lambda->args( $args );
+ $lambda->evaluate( $self);
}
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 Fri May 23 06:12:39 2008
@@ -33,6 +33,7 @@
sub evaluate {
my ($self, $ev) = @_;
my $lambda = $ev->resolve_name($self->name);
+ die "Function ".$self->name." not defined" unless $lambda;
return $ev->apply_script( $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 Fri May 23 06:12:39 2008
@@ -8,19 +8,20 @@
isa => 'ArrayRef',
);
-has bindings => (
- is => 'rw',
- isa => 'ArrayRef[Str]');
-
has signature => (
is => 'rw',
isa => 'HashRef[PIE::FunctionArgument]');
+has args => (
+ is => 'rw',
+ default => sub { {} },
+ isa => 'HashRef[PIE::Expression]');
+
-sub check {
+sub check_args {
my $self = shift;
- my $passed = shift; #reference to hash of provided args
- my $args = $self->signature; # expected args
+ my $passed = $self->args; #reference to hash of provided args
+ my $expected = $self->signature; # expected args
my $missing = {};
@@ -28,12 +29,11 @@
my $fail =0;
foreach my $arg (keys %$passed) {
- if (!$args->{$arg}) {
+ if (!$expected->{$arg}) {
$unwanted->{$arg} = "The caller passed $arg which we were not expecting" ;
- $fail++
};
}
- foreach my $arg (keys %$args) {
+ foreach my $arg (keys %$expected) {
if (!$passed->{$arg}) {
$missing->{$arg} = "The caller did not pass $arg which we require";
@@ -43,11 +43,22 @@
return $missing, $unwanted;
}
+sub validate_args_or_die {
+ my $self = shift;
+ my ( $missing, $unwanted ) = $self->check_args();
+
+ if ( keys %$missing || keys %$unwanted ) {
+ die "Function signature mismatch \n".
+ (keys %$missing? "The following arguments were missing: " . join(", ", keys %$missing) ."\n" : ''),
+ (keys %$unwanted? "The following arguments were unwanted: " . join(", ", keys %$unwanted)."\n" : '');
+
+ }
+}
sub evaluate {
- my ($self, $evaluator, $args) = @_;
- my ($missing, $unwanted) = $self->check($args);
+ my ($self, $evaluator) = @_;
+ my ($missing, $unwanted) = $self->check();
if (keys %$missing || keys %$unwanted) {
warn "Bad args! XXX TODO BETTER DIAGNOSTICS";
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 06:12:39 2008
@@ -1,6 +1,8 @@
package PIE::Lambda::Native;
use Moose;
+use YAML;
+use Scalar::Defer;
extends 'PIE::Lambda';
has body => (
@@ -11,22 +13,17 @@
sub evaluate {
- my ( $self, $evaluator, $args ) = @_;
+ my ( $self, $evaluator ) = @_;
- my ( $missing, $unwanted ) = $self->check($args);
+ $self->validate_args_or_die;
- use YAML;
- 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 %args;
+ foreach my $key ( keys %{ $self->args } ) {
+ $args{$key} = lazy {
+ $evaluator->run( $self->args->{$key} );
+ $evaluator->result->value
+ }
+ }
my $r = $self->body->( \%args );
return $r;
}
Modified: pie/branches/named-params/t/named-params.t
==============================================================================
--- pie/branches/named-params/t/named-params.t (original)
+++ pie/branches/named-params/t/named-params.t Fri May 23 06:12:39 2008
@@ -1,4 +1,7 @@
use Test::More qw/no_plan/;
+use warnings;
+use strict;
+
use_ok('PIE::Lambda');
use_ok('PIE::Lambda::Native');
use_ok('PIE::Expression');
@@ -8,9 +11,9 @@
body => sub {
my $args = shift;
my $arg = $args->{'tested-string'};
- my $regexp = $args->{'regexp'};
+ my $regex = $args->{'regex'};
- return $arg =~ m/$regexp/;
+ return $arg =~ m/$regex/;
},
signature => {
@@ -19,15 +22,14 @@
}
);
-
my $eval5 = PIE::Evaluator->new;
-$eval5->set_named( 'match-regexp' => $MATCH_REGEX );
+$eval5->set_named( 'match-regex' => $MATCH_REGEX );
my $match_p = PIE::Expression->new(
- name => 'match-regexp',
+ name => 'match-regex',
args => {
- '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' } )
}
);
@@ -38,29 +40,29 @@
my $eval6 = PIE::Evaluator->new();
-$eval6->set_named( 'match-regexp' => $MATCH_REGEX );
+$eval6->set_named( 'match-regex' => $MATCH_REGEX );
my $match_fail_p = PIE::Expression->new(
- name => 'match-regexp',
+ name => 'match-regex',
args => {
- 'tested-string' => PIE::Expression::String->new( value => 'I do love hardware' ),
- 'regexp' => PIE::Expression::String->new( value => 'software' )
+ 'tested-string' => PIE::Expression::String->new( args => { value => 'I do love hardware' }),
+ 'regex' => PIE::Expression::String->new( args => { value => 'software'} )
}
);
$eval6->run($match_fail_p);
-ok( !$eval6->result->success );
+ok( $eval6->result->success );
ok( !$eval6->result->value );
my $match_orz = PIE::Expression->new(
- name => 'match-regexp',
+ name => 'match-regex',
args => {
- 'tested-string' => PIE::Expression::String->new( value => 'I do love software' ),
- 'wrong-regepx' => PIE::Expression::String->new( value => 'software' ),
+ 'tested-string' => PIE::Expression::String->new( args => { value => 'I do love software'} ),
+ 'wrong-param-name' => PIE::Expression::String->new( args => { value => 'software' }),
}
);
$eval6->run($match_orz);
-ok( !$eval6->result->success );
+ok( !$eval6->result->success, "yay! it failed when we gave it a wrong argument name". $eval6->result->error );
More information about the Bps-public-commit
mailing list