[Bps-public-commit] r19340 - in Lorzy/trunk: lib/Lorzy/Expression t

[clkao at bestpractical.com]

Author: clkao
Date: Fri Apr 24 03:55:57 2009
New Revision: 19340

Added:
   Lorzy/trunk/lib/Lorzy/Expression/Break.pm
   Lorzy/trunk/lib/Lorzy/Expression/Continue.pm
   Lorzy/trunk/t/loop-control.t
Modified:
   Lorzy/trunk/lib/Lorzy/Exception.pm
   Lorzy/trunk/lib/Lorzy/Expression/ForEach.pm

Log:
loop exceptions for breaking and continuing in loop.


Modified: Lorzy/trunk/lib/Lorzy/Exception.pm
==============================================================================
--- Lorzy/trunk/lib/Lorzy/Exception.pm	(original)
+++ Lorzy/trunk/lib/Lorzy/Exception.pm	Fri Apr 24 03:55:57 2009
@@ -4,6 +4,9 @@
       { fields => ['details', 'stack'] },
       'Lorzy::Exception::Native' =>
       { isa => 'Lorzy::Exception'},
+      'Lorzy::Exception::Loop' =>
+      { isa => 'Lorzy::Exception',
+        fields => ['instruction'] },
       'Lorzy::Exception::Params' =>
       { isa => 'Lorzy::Exception',
         fields => ['missing', 'unwanted'] },

Added: Lorzy/trunk/lib/Lorzy/Expression/Break.pm
==============================================================================
--- (empty file)
+++ Lorzy/trunk/lib/Lorzy/Expression/Break.pm	Fri Apr 24 03:55:57 2009
@@ -0,0 +1,22 @@
+package Lorzy::Expression::Break;
+use Moose;
+use MooseX::ClassAttribute;
+
+extends 'Lorzy::Expression';
+
+class_has signature => (
+    is      => 'ro',
+    default => sub { {} } ,
+);
+
+sub evaluate {
+    my ($self, $evaluator) = @_;
+    $evaluator->throw_exception( 'Lorzy::Exception::Loop' => '',
+                                 instruction => 'break');
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+

Added: Lorzy/trunk/lib/Lorzy/Expression/Continue.pm
==============================================================================
--- (empty file)
+++ Lorzy/trunk/lib/Lorzy/Expression/Continue.pm	Fri Apr 24 03:55:57 2009
@@ -0,0 +1,22 @@
+package Lorzy::Expression::Continue;
+use Moose;
+use MooseX::ClassAttribute;
+
+extends 'Lorzy::Expression';
+
+class_has signature => (
+    is      => 'ro',
+    default => sub { {} } ,
+);
+
+sub evaluate {
+    my ($self, $evaluator) = @_;
+    $evaluator->throw_exception( 'Lorzy::Exception::Loop' => '',
+                                 instruction => 'continue');
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+

Modified: Lorzy/trunk/lib/Lorzy/Expression/ForEach.pm
==============================================================================
--- Lorzy/trunk/lib/Lorzy/Expression/ForEach.pm	(original)
+++ Lorzy/trunk/lib/Lorzy/Expression/ForEach.pm	Fri Apr 24 03:55:57 2009
@@ -34,7 +34,18 @@
     my $nodes = $$list;
 
     foreach (@$nodes) {
-        $lambda->apply($evaluator, { $binding => $_ });
+        eval {
+            $lambda->apply($evaluator, { $binding => $_ });
+        };
+        my $e;
+        if ($e = Lorzy::Exception::Loop->caught()) {
+            last if $e->instruction eq 'break';
+            next if $e->instruction eq 'continue';
+            $evaluator->throw_exception( 'Lorzy::Exception' => 'Unknown loop instruction: '.$e->instruction );
+        }
+        elsif ($e = Lorzy::Exception->caught()) {
+            ref $e ? $e->rethrow : die $e;
+        }
     }
 }
 

Added: Lorzy/trunk/t/loop-control.t
==============================================================================
--- (empty file)
+++ Lorzy/trunk/t/loop-control.t	Fri Apr 24 03:55:57 2009
@@ -0,0 +1,121 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use Test::Exception;
+
+use_ok('Lorzy::Expression');
+use_ok('Lorzy::Evaluator');
+use_ok('Lorzy::Builder');
+use_ok('Lorzy::Lambda::Native');
+use_ok('Lorzy::FunctionArgument');
+
+my $builder = Lorzy::Builder->new();
+my $eval = Lorzy::Evaluator->new();
+$eval->load_package('Str');
+my $script =
+    $builder->defun(
+    ops => [
+        { name => 'List',
+            args => {
+                nodes => [ 1..10 ] } } ],
+    signature => { });
+
+$eval->set_global_symbol( 'get-list' => $script );
+
+my @remembered;
+$eval->set_global_symbol( 'remember' =>
+Lorzy::Lambda::Native->new(
+    body => sub {
+        my $args = shift;
+        push @remembered, $args->{what};
+        return 1;
+    },
+
+    signature => {
+        'what' => Lorzy::FunctionArgument->new( name => 'what' => type => 'Str'),
+        }
+
+) );
+
+
+my $loop_code = $builder->defun(
+    ops => [
+        {   name => 'IfThen',
+            args => {
+                'if_true'   => { name => 'Break' },
+                'if_false'  => '1',
+                'condition' => {
+                    name => 'Str.Eq',
+                    args => {
+                        arg1           => '6',
+                        arg2 => {name => 'Symbol',
+                                 args => {symbol => 'what'} },
+                    }
+                }
+            }
+        },
+        {name => 'remember', args => { what => { name => 'Symbol',
+                                                 args => { symbol => 'what'} } } } ],
+    signature => {
+        'what' => Lorzy::FunctionArgument->new( name => 'what' => type => 'Str') },
+);
+
+$eval->set_global_symbol( 'loop-code' => $loop_code );
+
+$eval->apply_script(
+    $builder->defun(
+    ops => [
+        { name => 'ForEach',
+            args => {
+                list => { name => 'get-list', args => {} },
+                binding => 'what',
+                do => {name => 'Symbol',
+                       args => {symbol => 'loop-code'} },
+                    }
+        } ],
+    signature => { }),
+ {});
+is_deeply(\@remembered, [1..5]);
+
+ at remembered = ();
+my $loop_code2 = $builder->defun(
+    ops => [
+        {   name => 'IfThen',
+            args => {
+                'if_true'   => { name => 'Continue' },
+                'if_false'  => '1',
+                'condition' => {
+                    name => 'Str.Eq',
+                    args => {
+                        arg1           => '6',
+                        arg2 => {name => 'Symbol',
+                                 args => {symbol => 'what'} },
+                    }
+                }
+            }
+        },
+        {name => 'remember', args => { what => { name => 'Symbol',
+                                                 args => { symbol => 'what'} } } } ],
+    signature => {
+        'what' => Lorzy::FunctionArgument->new( name => 'what' => type => 'Str') },
+);
+
+
+$eval->set_global_symbol( 'loop-code' => $loop_code2 );
+
+$eval->apply_script(
+    $builder->defun(
+    ops => [
+        { name => 'ForEach',
+            args => {
+                list => { name => 'get-list', args => {} },
+                binding => 'what',
+                do => {name => 'Symbol',
+                       args => {symbol => 'loop-code'} },
+                    }
+        } ],
+    signature => { }),
+ {});
+is_deeply(\@remembered, [1..5,7..10]);