[Bps-public-commit] r12678 - in pie/branches/named-params: lib/PIE
clkao at bestpractical.com
clkao at bestpractical.com
Sun May 25 01:42:03 EDT 2008
Author: clkao
Date: Sun May 25 01:42:03 2008
New Revision: 12678
Modified:
pie/branches/named-params/lib/PIE/Expression.pm
pie/branches/named-params/t/let.t
Log:
let is an implicit lambda immediately applied.
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 Sun May 25 01:42:03 2008
@@ -187,7 +187,19 @@
}
+sub mk_signature {
+ my $self = shift;
+ return { map { $_ => PIE::FunctionArgument->new( name => $_, type => 'Str') } keys %{ $self->bindings } };
+}
+
sub evaluate {
+ my ($self, $evaluator) = @_;
+ $evaluator->apply_script(
+ PIE::Lambda->new(
+ progn => PIE::Expression::ProgN->new( nodes => $self->nodes ),
+ signature => $self->mk_signature,
+ ),
+ $self->bindings );
}
Modified: pie/branches/named-params/t/let.t
==============================================================================
--- pie/branches/named-params/t/let.t (original)
+++ pie/branches/named-params/t/let.t Sun May 25 01:42:03 2008
@@ -1,10 +1,11 @@
-use Test::More qw'no_plan';
+use Test::More tests => 13;
use strict;
use_ok('PIE::Expression');
use_ok('PIE::Evaluator');
use_ok('PIE::Builder');
use_ok('PIE::Lambda::Native');
use_ok('PIE::FunctionArgument');
+use Test::Exception;
my $MATCH_REGEX = PIE::Lambda::Native->new(
body => sub {
@@ -40,7 +41,8 @@
name => 'match-regexp',
args => {
regexp => { name => 'Symbol', args => { symbol => 'REGEXP' } },
- 'tested-string' => { name => 'Symbol', args => { symbol => 'tested-string' } },
+ 'tested-string' =>
+ { name => 'Symbol', args => { symbol => 'tested-string' } },
}
}
}
@@ -56,3 +58,11 @@
ok(exists $script->progn->nodes->[0]->bindings->{REGEXP});
isa_ok($script->progn->nodes->[0]->bindings->{REGEXP}, 'PIE::Expression');
+TODO: {
+ local $TODO = 'lexical loopup in outter blocks';
+lives_ok {
+$eval->apply_script( $script, { 'tested-string', 'you do love software' } );
+};
+ok( $eval->result->success, $eval->result->error );
+is( $eval->result->value, 'hate' );
+};
More information about the Bps-public-commit
mailing list