[Bps-public-commit] r12677 - in pie/branches/named-params: lib/PIE

[clkao at bestpractical.com]

Author: clkao
Date: Sun May 25 01:33:09 2008
New Revision: 12677

Added:
   pie/branches/named-params/t/let.t
Modified:
   pie/branches/named-params/lib/PIE/Builder.pm
   pie/branches/named-params/lib/PIE/Expression.pm

Log:
build let tree (nodes, bindings) properly.


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	Sun May 25 01:33:09 2008
@@ -16,7 +16,6 @@
     # XXX: in case of primitive-ops, we should only bulid the args we
     # know about
 
-    warn "==> orz $class";
     my @known_args = $class eq 'PIE::Expression' ? keys %$args : keys %{ $class->signature };
     return $class->new( name => $name, builder => $self, builder_args => $args,
                         args => { map { $_ => $self->build_expression( $args->{$_} ) } @known_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	Sun May 25 01:33:09 2008
@@ -167,6 +167,29 @@
 }
 
 package PIE::Expression::Let;
+use Moose;
+extends 'PIE::Expression::ProgN';
+
+has bindings => (
+    is => 'rw',
+    isa => 'HashRef',
+    default => sub { { } },
+);
+
+sub BUILD {
+    my ($self, $params) = @_;
+
+    return unless $params->{builder};
+    my $bindings = $params->{builder_args}{bindings};
+
+    $self->bindings->{$_} = $params->{builder}->build_expression($bindings->{$_})
+        for keys %$bindings;
+
+}
+
+sub evaluate {
+
+}
 
 1;
 

Added: pie/branches/named-params/t/let.t
==============================================================================
--- (empty file)
+++ pie/branches/named-params/t/let.t	Sun May 25 01:33:09 2008
@@ -0,0 +1,58 @@
+use Test::More qw'no_plan';
+use strict;
+use_ok('PIE::Expression');
+use_ok('PIE::Evaluator');
+use_ok('PIE::Builder');
+use_ok('PIE::Lambda::Native');
+use_ok('PIE::FunctionArgument');
+
+my $MATCH_REGEX = PIE::Lambda::Native->new(
+    body => sub {
+        my $args = shift;
+        my $arg    = $args->{'tested-string'};
+        my $regexp = $args->{'regexp'};
+        return ($arg =~ m/$regexp/ )? 1 : 0;
+    },
+
+    signature => {
+        'tested-string' => PIE::FunctionArgument->new( name => 'tested-string' => type => 'Str'),
+        'regexp' => PIE::FunctionArgument->new( name => 'regexp', type => 'Str' )
+        }
+
+);
+
+my $builder = PIE::Builder->new();
+my $eval = PIE::Evaluator->new();
+$eval->set_global_symbol( 'match-regexp' => $MATCH_REGEX );
+
+my $script =
+    $builder->defun(
+    ops => [
+        { name => 'Let',
+            args => {
+                bindings => { REGEXP => 'software' },
+                nodes => [
+                    { name => 'IfThen',
+                        args => {
+                            'if_true'   => 'hate',
+                            'if_false'  => 'love',
+                            'condition' => {
+                                name => 'match-regexp',
+                                args => {
+                                    regexp => { name => 'Symbol', args => { symbol => 'REGEXP' } },
+                                    'tested-string' => { name => 'Symbol', args => { symbol => 'tested-string' } },
+                                    }
+                                }
+                            }
+                    }
+                    ] } } ],
+    signature => { 'tested-string' => PIE::FunctionArgument->new( name => 'tested-string' => type => 'Str' ) },
+    );
+
+is(scalar @{$script->progn->nodes}, 1);
+isa_ok($script->progn->nodes->[0], 'PIE::Expression::Let');
+is(scalar @{$script->progn->nodes->[0]->nodes}, 1);
+
+ok(exists $script->progn->nodes->[0]->bindings->{REGEXP});
+isa_ok($script->progn->nodes->[0]->bindings->{REGEXP}, 'PIE::Expression');
+