implement labeled loops and throwing of labels as payload

Labels are lexcially installed as instances of type NQPLabel, and are glued to the exception handlers of 'while', 'until' and 'for' loops. When an exception with a label as payload is thrown, the handler that holds the identical label will be in charge.
Raku · May 21, 2014 · 1783628 · 1783628
1 parent d78bdec
commit 1783628
Show file tree

Hide file tree

Showing 11 changed files with 537 additions and 110 deletions.
diff --git a/src/NQP/Actions.nqp b/src/NQP/Actions.nqp
@@ -298,7 +298,10 @@ class NQP::Actions is HLL::Actions {
     method statement_control:sym<while>($/) {
         my $ast := xblock_immediate( $<xblock>.ast );
         $ast.op(~$<sym>);
-        unless $*CONTROL_USED {
+        if $*LABEL {
+            $ast.push(QAST::WVal.new( :value($*W.find_sym([$*LABEL])), :named('label') ));
+        }
+        elsif !$*CONTROL_USED {
             $ast.push(QAST::IVal.new( :value(1), :named('nohandler') ));
         }
         $/.prune();
@@ -316,7 +319,10 @@ class NQP::Actions is HLL::Actions {
             $ast := QAST::Op.new( $<EXPR>.ast, block_immediate( $<pblock>.ast ),
                                    :op($op), :node($/) );
         }
-        unless $*CONTROL_USED {
+        if $*LABEL {
+            $ast.push(QAST::WVal.new( :value($*W.find_sym([$*LABEL])), :named('label') ));
+        }
+        elsif !$*CONTROL_USED {
             $ast.push(QAST::IVal.new( :value(1), :named('nohandler') ));
         }
         $/.prune();
@@ -333,7 +339,10 @@ class NQP::Actions is HLL::Actions {
             $block.arity(1);
         }
         $block.blocktype('immediate');
-        unless $*CONTROL_USED {
+        if $*LABEL {
+            $ast.push(QAST::WVal.new( :value($*W.find_sym([$*LABEL])), :named('label') ));
+        }
+        elsif !$*CONTROL_USED {
             $ast.push(QAST::IVal.new( :value(1), :named('nohandler') ));
         }
         $/.prune();
@@ -1636,9 +1645,33 @@ class NQP::Actions is HLL::Actions {
         );
     }
 
-    method term:sym<next>($/) { make QAST::Op.new( :op('control'), :name('next') ) }
-    method term:sym<last>($/) { make QAST::Op.new( :op('control'), :name('last') ) }
-    method term:sym<redo>($/) { make QAST::Op.new( :op('control'), :name('redo') ) }
+    method term:sym<next>($/) {
+        my $ast := QAST::Op.new( :op('control'), :name('next') );
+
+        if $<identifier> {
+            $ast.push(QAST::WVal.new( :value($*W.find_sym([$<identifier>])), :named('label') ));
+        }
+
+        make $ast
+    }
+    method term:sym<last>($/) {
+        my $ast := QAST::Op.new( :op('control'), :name('last') );
+
+        if $<identifier> {
+            $ast.push(QAST::WVal.new( :value($*W.find_sym([$<identifier>])), :named('label') ));
+        }
+
+        make $ast
+    }
+    method term:sym<redo>($/) {
+        my $ast := QAST::Op.new( :op('control'), :name('redo') );
+
+        if $<identifier> {
+            $ast.push(QAST::WVal.new( :value($*W.find_sym([$<identifier>])), :named('label') ));
+        }
+
+        make $ast
+    }
 
     method infix:sym<~~>($/) {
         make QAST::Op.new( :op<callmethod>, :name<ACCEPTS>, :node($/) );

diff --git a/src/NQP/Grammar.nqp b/src/NQP/Grammar.nqp
@@ -152,14 +152,19 @@ grammar NQP::Grammar is HLL::Grammar {
     }
 
     token label {
-        :my $label;
         <identifier> ':' <?[\s]> <.ws>
+        {
+            $*LABEL := ~$<identifier>;
+            my $label := $*W.find_sym(['NQPLabel']).new();
+            $*W.add_object($label);
+            $*W.install_lexical_symbol($*W.cur_lexpad(), $*LABEL, $label);
+        }
     }
 
-    token statement {
+    token statement($*LABEL = '') {
         <!before <[\])}]> | $ >
         [
-        | <label> <statement>
+        | <label> <statement($*LABEL)> { $*LABEL := '' if $*LABEL }
         | <statement_control>
         | <EXPR> <.ws>
             [
@@ -311,9 +316,9 @@ grammar NQP::Grammar is HLL::Grammar {
     token term:sym<regex_declarator>   { <regex_declarator> }
     token term:sym<statement_prefix>   { <statement_prefix> }
     token term:sym<lambda>             { <?lambda> <pblock> }
-    token term:sym<last>               { <sym> <!identifier> { $*CONTROL_USED := 1 } }
-    token term:sym<next>               { <sym> <!identifier> { $*CONTROL_USED := 1 } }
-    token term:sym<redo>               { <sym> <!identifier> { $*CONTROL_USED := 1 } }
+    token term:sym<last>               { <sym> [<.ws> <identifier> <?{ $*W.is_lexical(~$<identifier>) }>]? { $*CONTROL_USED := 1 } }
+    token term:sym<next>               { <sym> [<.ws> <identifier> <?{ $*W.is_lexical(~$<identifier>) }>]? { $*CONTROL_USED := 1 } }
+    token term:sym<redo>               { <sym> [<.ws> <identifier> <?{ $*W.is_lexical(~$<identifier>) }>]? { $*CONTROL_USED := 1 } }
 
     token fatarrow {
         <key=.identifier> \h* '=>' <.ws> <val=.EXPR('i=')>

diff --git a/src/core/NQPMu.nqp b/src/core/NQPMu.nqp
@@ -134,3 +134,5 @@ nqp::sethllconfig('nqp', nqp::hash(
     'hash_iter', NQPHashIter
 ));
 #?endif
+
+my class NQPLabel { }