[Bps-public-commit] r12634 - in pie/branches/named-params: lib/PIE t
jesse at bestpractical.com
jesse at bestpractical.com
Fri May 23 05:20:52 EDT 2008
Author: jesse
Date: Fri May 23 05:20:50 2008
New Revision: 12634
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/lib/PIE/Lambda/Native.pm
pie/branches/named-params/t/01basic.t
pie/branches/named-params/t/hello_world.t
Log:
* There's a bit of return value wackyness, but it seems to otherwise be happy
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 05:20:50 2008
@@ -23,7 +23,7 @@
sub build_expression {
my ($self, $tree) = @_;
if (!ref($tree)) {
- return PIE::Expression::String->new(value => $tree );
+ return PIE::Expression::String->new(args => { value => $tree} );
}
elsif (ref($tree) eq 'HASH') {
return $self->build_op_expression($tree->{name}, $tree->{args});
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 05:20:50 2008
@@ -117,13 +117,28 @@
use Params::Validate qw/validate_pos/;
has signature => (
- is => 'ro',
- default => sub { { value => PIE::FunctionArgument->new( name => 'value', type => 'Str')}});
-
-
+ is => 'ro',
+ default => sub {
+ { value => PIE::FunctionArgument->new( name => 'value', type => 'Str' )
+ };
+ }
+);
+
+has args => (
+ is => 'rw',
+ default => sub { {} },
+ isa => 'HashRef[Str]');
+
+
sub evaluate {
- my ($self, $eval) = validate_pos(@_, { isa => 'PIE::Expression'}, { isa => 'PIE::Evaluator'});
- return $self->args->{value};
+ my ( $self, $eval ) = validate_pos(
+ @_,
+ { isa => 'PIE::Expression' },
+ { isa => 'PIE::Evaluator' }
+ );
+
+
+ return $self->args->{'value'};
}
@@ -144,3 +159,4 @@
}
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 05:20:50 2008
@@ -47,10 +47,12 @@
sub evaluate {
my ($self, $evaluator, $args) = @_;
-
my ($missing, $unwanted) = $self->check($args);
- return undef if (keys %$missing || keys %$unwanted);
+ if (keys %$missing || keys %$unwanted) {
+ warn "Bad args! XXX TODO BETTER DIAGNOSTICS";
+ return undef;
+ }
my $arguments = $self->signature;
for (sort keys %$arguments) {
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 05:20:50 2008
@@ -11,18 +11,23 @@
sub evaluate {
- my ($self, $evaluator, $args) = @_;
+ my ( $self, $evaluator, $args ) = @_;
+
+ my ( $missing, $unwanted ) = $self->check($args);
-
- my ($missing, $unwanted) = $self->check($args);
-
use YAML;
- die "Something went wrong with your args". YAML::Dump($missing, $unwanted) if (keys %$missing || keys %$unwanted);
-
+ 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 $r = $self->body->(\%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;
}
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 05:20:50 2008
@@ -82,14 +82,13 @@
$eval9->set_named( 'match-regexp' => $MATCH_REGEX );
$eval9->apply_script(
$MATCH_REGEX,
- { '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' })
}
);
ok( $eval9->result->success, $eval9->result->error );
is( $eval9->result->value, 1 );
-
my $builder = PIE::Builder->new();
my $eval10 = PIE::Evaluator->new();
$eval10->set_named( 'match-regexp' => $MATCH_REGEX );
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 05:20:50 2008
@@ -32,9 +32,10 @@
my $self = shift;
my $name = shift;
+ my $args = { name => PIE::Expression::String->new( args => { value => $name } ) };
for ( @{ $self->rules || [] } ) {
- $self->evaluator->apply_script( $_,
- { name => PIE::Expression::String->new( value => $name ) } );
+ $self->evaluator->apply_script( $_, $args);
+
last unless ( $self->evaluator->result->success );
$name = $self->evaluator->result->value;
}
@@ -79,7 +80,7 @@
is( $hello->run('jesse'), 'Hello fred' );
my $script2 = $builder->defun(
- ops =>[ { name => 'make-bob' }, { name => 'make-fred' } ] ,
+ ops => [ { name => 'make-bob' }, { name => 'make-fred' } ],
signature =>
{ name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
);
@@ -88,11 +89,16 @@
is( $hello->run('jesse'), 'Hello fred' );
-my $script3 = $builder->defun( ops => [ { name => 'make-bob' } ], signature =>
- { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) } );
-my $script4 = $builder->defun ( ops => [ { name => 'make-fred' } ],
-signature =>
- { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) } );
+my $script3 = $builder->defun(
+ ops => [ { name => 'make-bob' } ],
+ signature =>
+ { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
+);
+my $script4 = $builder->defun(
+ ops => [ { name => 'make-fred' } ],
+ signature =>
+ { name => PIE::FunctionArgument->new( name => 'name', type => 'Str' ) }
+);
$hello->rules( [ $script3, $script4 ] );
More information about the Bps-public-commit
mailing list