develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33942 - in trunk/languages/perl6/src: builtins parser

From:
tene
Date:
December 15, 2008 18:07
Subject:
[svn:parrot] r33942 - in trunk/languages/perl6/src: builtins parser
Message ID:
20081216020727.648DCCBA12@x12.develooper.com
Author: tene
Date: Mon Dec 15 18:07:26 2008
New Revision: 33942

Modified:
   trunk/languages/perl6/src/builtins/control.pir
   trunk/languages/perl6/src/parser/actions.pm
   trunk/languages/perl6/src/parser/grammar.pg

Log:
[rakudo]: Basic support for continue and break in given/when.

Modified: trunk/languages/perl6/src/builtins/control.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/control.pir	(original)
+++ trunk/languages/perl6/src/builtins/control.pir	Mon Dec 15 18:07:26 2008
@@ -126,6 +126,27 @@
     throw e
 .end
 
+.sub 'continue'
+    .local pmc e
+    e = new 'Exception'
+    e['severity'] = .EXCEPT_NORMAL
+    e['type'] = .CONTROL_CONTINUE
+    throw e
+.end
+
+.sub 'break'
+    .param pmc arg :optional
+    .param int has_arg :opt_flag
+    .local pmc e
+    e = new 'Exception'
+    e['severity'] = .EXCEPT_NORMAL
+    e['type'] = .CONTROL_BREAK
+    unless has_arg, no_arg
+    e['payload'] = arg
+  no_arg:
+    throw e
+.end
+
 =item term:...
 
 =cut

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm	(original)
+++ trunk/languages/perl6/src/parser/actions.pm	Mon Dec 15 18:07:26 2008
@@ -258,11 +258,59 @@
 }
 
 method when_statement($/) {
+    our $?BLOCK;
     my $block := $( $<block> );
     $block.blocktype('immediate');
 
-    # XXX TODO: push a control exception throw onto the end of the block so we
+    # Push a handler onto the innermost block so that we can exit if we
+    # successfully match
+    # XXX TODO: This isn't quite the right way to check this...
+    unless $?BLOCK.handlers() {
+        my @handlers;
+        @handlers.push(
+            PAST::Control.new(
+                PAST::Op.new(
+                    :pasttype('pirop'),
+                    :pirop('return'),
+                    PAST::Var.new(
+                        :scope('keyed'),
+                        PAST::Var.new( :name('exception'), :scope('register') ),
+                        'payload',
+                    ),
+                ),
+                :handle_types('BREAK')
+            )
+        );
+        $?BLOCK.handlers(@handlers);
+    }
+
+    # push a control exception throw onto the end of the block so we
     # exit the innermost block in which $_ was set.
+    my $last := $block.pop();
+    $block.push(
+        PAST::Op.new(
+            :pasttype('call'),
+            :name('break'),
+            $last
+        )
+    );
+
+    # Push a handler onto the block to handle CONTINUE exceptions so we can
+    # skip throwing the BREAK exception
+    my @handlers;
+    if $block.handlers() {
+        @handlers := $block.handlers();
+    }
+    @handlers.push(
+        PAST::Control.new(
+            PAST::Op.new(
+                :pasttype('pirop'),
+                :pirop('return'),
+            ),
+            :handle_types('CONTINUE')
+        )
+    );
+    $block.handlers(@handlers);
 
     # Invoke smartmatch of the expression.
     my $match_past := PAST::Op.new(
@@ -283,10 +331,61 @@
 }
 
 method default_statement($/) {
+    our $?BLOCK;
     # Always executed if reached, so just produce the block.
-    my $past := $( $<block> );
-    $past.blocktype('immediate');
-    make $past;
+    my $block := $( $<block> );
+    $block.blocktype('immediate');
+
+    # Push a handler onto the innermost block so that we can exit if we
+    # successfully match
+    # XXX TODO: This isn't quite the right way to check this...
+    unless $?BLOCK.handlers() {
+        my @handlers;
+        @handlers.push(
+            PAST::Control.new(
+                PAST::Op.new(
+                    :pasttype('pirop'),
+                    :pirop('return'),
+                    PAST::Var.new(
+                        :scope('keyed'),
+                        PAST::Var.new( :name('exception'), :scope('register') ),
+                        'payload',
+                    ),
+                ),
+                :handle_types('BREAK')
+            )
+        );
+        $?BLOCK.handlers(@handlers);
+    }
+
+    # push a control exception throw onto the end of the block so we
+    # exit the innermost block in which $_ was set.
+    my $last := $block.pop();
+    $block.push(
+        PAST::Op.new(
+            :pasttype('call'),
+            :name('break'),
+            $last
+        )
+    );
+
+    # Push a handler onto the block to handle CONTINUE exceptions so we can
+    # skip throwing the BREAK exception
+    my @handlers;
+    if $block.handlers() {
+        @handlers := $block.handlers();
+    }
+    @handlers.push(
+        PAST::Control.new(
+            PAST::Op.new(
+                :pasttype('pirop'),
+                :pirop('return'),
+            ),
+            :handle_types('CONTINUE')
+        )
+    );
+    $block.handlers(@handlers);
+    make $block;
 }
 
 method loop_statement($/) {

Modified: trunk/languages/perl6/src/parser/grammar.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar.pg	(original)
+++ trunk/languages/perl6/src/parser/grammar.pg	Mon Dec 15 18:07:26 2008
@@ -588,7 +588,7 @@
 
 ##  XXX: cheat until we get term:pi, term:rand, term:undef, etc.
 token named_0ary {
-    | [pi|rand|undef|nothing|time] >>
+    | [pi|rand|undef|nothing|time|next|last|continue|break] >>
     | ['...'|'???'|'!!!'|'=<>']
 }
 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About