Implement support and tests for NEXT and LAST phasers

- Added tokens in Grammar - Added methods in Actions - RakuAST::StatementPrefix::(Next|Last) classes added - Slight refactor of RakuAST::ScopePhaser to prevent repetition - Deparsing support added - Tests added
rakudo · Jan 19, 2023 · 35b6b6d · niner · Jan 20, 2023 · lizmat
1 parent 672ac18
commit 35b6b6d
Show file tree

Hide file tree

Showing 6 changed files with 219 additions and 16 deletions.
diff --git a/src/Raku/Actions.nqp b/src/Raku/Actions.nqp
@@ -500,6 +500,14 @@ class Raku::Actions is HLL::Actions does Raku::CommonActions {
         self.attach: $/, self.r('StatementPrefix', 'Phaser', 'Leave').new($<blorst>.ast);
     }
 
+    method statement_prefix:sym<NEXT>($/) {
+        self.attach: $/, self.r('StatementPrefix', 'Phaser', 'Next').new($<blorst>.ast);
+    }
+
+    method statement_prefix:sym<LAST>($/) {
+        self.attach: $/, self.r('StatementPrefix', 'Phaser', 'Last').new($<blorst>.ast);
+    }
+
     method statement_prefix:sym<race>($/) {
         my $blorst := $<blorst>.ast;
         if nqp::istype($blorst, self.r('Statement', 'For')) {

diff --git a/src/Raku/Grammar.nqp b/src/Raku/Grammar.nqp
@@ -903,6 +903,9 @@ grammar Raku::Grammar is HLL::Grammar does Raku::Common {
     token statement_prefix:sym<END>   { <sym><.kok> <blorst> }
     token statement_prefix:sym<LEAVE> { <sym><.kok> <blorst> }
 
+    token statement_prefix:sym<NEXT> { <sym><.kok> <blorst> }
+    token statement_prefix:sym<LAST> { <sym><.kok> <blorst> }
+
     token statement_prefix:sym<race>    { <sym><.kok> <blorst> }
     token statement_prefix:sym<hyper>   { <sym><.kok> <blorst> }
     token statement_prefix:sym<lazy>    { <sym><.kok> <blorst> }

diff --git a/src/Raku/ast/code.rakumod b/src/Raku/ast/code.rakumod
@@ -505,34 +505,63 @@ class RakuAST::PlaceholderParameterOwner is RakuAST::Node {
 }
 
 class RakuAST::ScopePhaser {
-    has List $!leave-phasers;
+    has Bool $!has-exit-handler;
+    has List $!LEAVE;
+    has List $!NEXT;
+    has List $!LAST;
     has RakuAST::Block $!let;
     has RakuAST::Block $!temp;
 
+    method add-phaser-to-list(Str $attr, RakuAST::StatementPrefix::Phaser $phaser) {
+        my $list := nqp::getattr(self, RakuAST::ScopePhaser, $attr);
+        $list := nqp::bindattr(self, RakuAST::ScopePhaser, $attr, [])
+          unless $list;
+
+        for $list {
+            if nqp::eqaddr($_, $phaser) {
+                return;
+            }
+        }
+        nqp::push($list, $phaser);
+    }
+
     method set-has-let() {
         nqp::bindattr(self, RakuAST::ScopePhaser, '$!let', RakuAST::Block.new(:implicit-topic(False)));
     }
 
     method set-has-temp() {
+        nqp::bindattr(self, RakuAST::ScopePhaser, '$!has-exit-handler', True);
         nqp::bindattr(self, RakuAST::ScopePhaser, '$!temp', RakuAST::Block.new(:implicit-topic(False)));
     }
 
     method add-leave-phaser(RakuAST::StatementPrefix::Phaser::Leave $phaser) {
-        nqp::bindattr(self, RakuAST::ScopePhaser, '$!leave-phasers', []) unless $!leave-phasers;
+        nqp::bindattr(self, RakuAST::ScopePhaser, '$!has-exit-handler', True);
+        self.add-phaser-to-list('$!LEAVE', $phaser);
+    }
 
-        for $!leave-phasers {
-            if nqp::eqaddr($_, $phaser) {
-                return;
+    method add-next-phaser(RakuAST::StatementPrefix::Phaser::Next $phaser) {
+        self.add-phaser-to-list('$!NEXT', $phaser);
+    }
+
+    method add-last-phaser(RakuAST::StatementPrefix::Phaser::Next $phaser) {
+        self.add-phaser-to-list('$!LAST', $phaser);
+    }
+
+    method add-list-to-code-object(Str $attr, $code-object) {
+        my $list := nqp::getattr(self, RakuAST::ScopePhaser, $attr);
+        if $list {
+            my $name := nqp::substr($attr,2);
+            for $list {
+                $code-object.add_phaser($name, $_.meta-object);
             }
         }
-        nqp::push($!leave-phasers, $phaser);
     }
 
     method add-phasers-to-code-object($code-object) {
-        my $leave-phasers := $!leave-phasers;
-        if $leave-phasers {
-            $code-object.add_phaser('LEAVE', $_.meta-object) for $leave-phasers;
-        }
+        self.add-list-to-code-object('$!LEAVE', $code-object);
+        self.add-list-to-code-object('$!NEXT', $code-object);
+        self.add-list-to-code-object('$!LAST', $code-object);
+
         if $!let {
             $code-object.add_phaser('UNDO', $!let.meta-object);
         }
@@ -542,7 +571,7 @@ class RakuAST::ScopePhaser {
     }
 
     method add-phasers-handling-code(RakuAST::IMPL::Context $context, Mu $qast) {
-        if $!leave-phasers && nqp::elems($!leave-phasers) || $!temp {
+        if $!has-exit-handler {
             $qast.has_exit_handler(1);
         }
         if $!let {
@@ -564,7 +593,12 @@ class RakuAST::ScopePhaser {
         }
     }
 
-    method IMPL-ADD-PHASER-QAST(RakuAST::IMPL::Context $context, RakuAST::Block $phaser, Str $value_stash, QAST::Block $block) {
+    method IMPL-ADD-PHASER-QAST(
+      RakuAST::IMPL::Context $context,
+      RakuAST::Block         $phaser,
+      Str                    $value_stash,
+      QAST::Block            $block
+    ) {
         $block[0].push(QAST::Op.new(
             :op('bind'),
             QAST::Var.new( :name($value_stash), :scope('lexical'), :decl('var') ),
@@ -610,7 +644,7 @@ class RakuAST::ScopePhaser {
     }
 
     method clear-phaser-attachments() {
-        nqp::setelems($!leave-phasers, 0) if $!leave-phasers;
+        nqp::setelems($!LEAVE, 0) if $!LEAVE;
     }
 }
 

diff --git a/src/Raku/ast/statementprefixes.rakumod b/src/Raku/ast/statementprefixes.rakumod
@@ -371,6 +371,30 @@ class RakuAST::StatementPrefix::Phaser::Begin
     }
 }
 
+# The NEXT phaser.
+class RakuAST::StatementPrefix::Phaser::Next
+  is RakuAST::StatementPrefix::Phaser::Sinky
+  is RakuAST::StatementPrefix::Thunky
+  is RakuAST::Attaching
+{
+
+    method attach(RakuAST::Resolver $resolver) {
+        $resolver.find-attach-target('block').add-next-phaser(self);
+    }
+}
+
+# The LAST phaser.
+class RakuAST::StatementPrefix::Phaser::Last
+  is RakuAST::StatementPrefix::Phaser::Sinky
+  is RakuAST::StatementPrefix::Thunky
+  is RakuAST::Attaching
+{
+
+    method attach(RakuAST::Resolver $resolver) {
+        $resolver.find-attach-target('block').add-last-phaser(self);
+    }
+}
+
 # The LEAVE phaser.
 class RakuAST::StatementPrefix::Phaser::Leave
   is RakuAST::StatementPrefix::Phaser::Sinky

diff --git a/src/core.c/RakuAST/Deparse.pm6 b/src/core.c/RakuAST/Deparse.pm6
@@ -1443,16 +1443,28 @@ class RakuAST::Deparse {
         'BEGIN ' ~ self.deparse($ast.blorst)
     }
 
+    multi method deparse(
+      RakuAST::StatementPrefix::Phaser::End:D $ast
+    --> Str:D) {
+        'END ' ~ self.deparse($ast.blorst)
+    }
+
+    multi method deparse(
+      RakuAST::StatementPrefix::Phaser::Last:D $ast
+    --> Str:D) {
+        'LAST ' ~ self.deparse($ast.blorst)
+    }
+
     multi method deparse(
       RakuAST::StatementPrefix::Phaser::Leave:D $ast
     --> Str:D) {
         'LEAVE ' ~ self.deparse($ast.blorst)
     }
 
     multi method deparse(
-      RakuAST::StatementPrefix::Phaser::End:D $ast
+      RakuAST::StatementPrefix::Phaser::Next:D $ast
     --> Str:D) {
-        'END ' ~ self.deparse($ast.blorst)
+        'NEXT ' ~ self.deparse($ast.blorst)
     }
 
     multi method deparse(RakuAST::StatementPrefix::Quietly:D $ast --> Str:D) {

diff --git a/t/12-rakuast/statement-phaser.rakutest b/t/12-rakuast/statement-phaser.rakutest
@@ -2,7 +2,7 @@ use MONKEY-SEE-NO-EVAL;
 use experimental :rakuast;
 use Test;
 
-plan 13; # Do not change this file to done-testing
+plan 15; # Do not change this file to done-testing
 
 my $ast;
 my $deparsed;
@@ -410,4 +410,126 @@ CODE
       for EVAL($ast), EVAL($deparsed);
 }
 
+subtest 'For loop with NEXT / LAST phaser thunk' => {
+    my $next;
+    my $last;
+
+    # for ^3 { NEXT ++$next; LAST ++$last }
+    ast RakuAST::Statement::For.new(
+      source => RakuAST::ApplyPrefix.new(
+        prefix  => RakuAST::Prefix.new('^'),
+        operand => RakuAST::IntLiteral.new(3)
+      ),
+      body => RakuAST::Block.new(
+        body => RakuAST::Blockoid.new(
+          RakuAST::StatementList.new(
+            RakuAST::Statement::Expression.new(
+              expression => RakuAST::StatementPrefix::Phaser::Next.new(
+                RakuAST::Statement::Expression.new(
+                  expression => RakuAST::ApplyPrefix.new(
+                    prefix => RakuAST::Prefix.new('++'),
+                    operand => RakuAST::Var::Lexical.new('$next')
+                  )
+                )
+              )
+            ),
+            RakuAST::Statement::Expression.new(
+              expression => RakuAST::StatementPrefix::Phaser::Last.new(
+                RakuAST::Statement::Expression.new(
+                  expression => RakuAST::ApplyPrefix.new(
+                    prefix => RakuAST::Prefix.new('++'),
+                    operand => RakuAST::Var::Lexical.new('$last')
+                  )
+                )
+              )
+            )
+          )
+        )
+      )
+    );
+    is-deeply $deparsed, Q:to/CODE/, 'deparse';
+for ^3 {
+    NEXT ++$next;
+    LAST ++$last
+}
+CODE
+
+    for 'AST', $ast, 'Str', $deparsed -> $type, $it {
+        $next = $last = 0;
+
+        is-deeply EVAL($it), Nil, "$type: for loop evaluates to Nil";
+        is-deeply $next, 3, "$type: NEXTed expected number of times";
+        is-deeply $last, 1, "$type: LASTed expected number of times";
+    }
+}
+
+subtest 'For loop with NEXT phaser block' => {
+    my $next;
+    my $last;
+
+    # for ^3 { NEXT { ++$next }; LAST { ++$last } }
+    ast RakuAST::Statement::For.new(
+      source => RakuAST::ApplyPrefix.new(
+        prefix  => RakuAST::Prefix.new('^'),
+        operand => RakuAST::IntLiteral.new(3)
+      ),
+      body => RakuAST::Block.new(
+        body => RakuAST::Blockoid.new(
+          RakuAST::StatementList.new(
+            RakuAST::Statement::Expression.new(
+              expression => RakuAST::StatementPrefix::Phaser::Next.new(
+                RakuAST::Block.new(
+                  body => RakuAST::Blockoid.new(
+                    RakuAST::StatementList.new(
+                      RakuAST::Statement::Expression.new(
+                        expression => RakuAST::ApplyPrefix.new(
+                          prefix => RakuAST::Prefix.new('++'),
+                          operand => RakuAST::Var::Lexical.new('$next')
+                        )
+                      )
+                    )
+                  )
+                )
+              )
+            ),
+            RakuAST::Statement::Expression.new(
+              expression => RakuAST::StatementPrefix::Phaser::Last.new(
+                RakuAST::Block.new(
+                  body => RakuAST::Blockoid.new(
+                    RakuAST::StatementList.new(
+                      RakuAST::Statement::Expression.new(
+                        expression => RakuAST::ApplyPrefix.new(
+                          prefix => RakuAST::Prefix.new('++'),
+                          operand => RakuAST::Var::Lexical.new('$last')
+                        )
+                      )
+                    )
+                  )
+                )
+              )
+            )
+          )
+        )
+      )
+    );
+    is-deeply $deparsed, Q:to/CODE/, 'deparse';
+for ^3 {
+    NEXT {
+        ++$next
+    }
+    LAST {
+        ++$last
+    }
+}
+CODE
+
+    for 'AST', $ast, 'Str', $deparsed -> $type, $it {
+        $next = $last = 0;
+
+        is-deeply EVAL($it), Nil, "$type: for loop evaluates to Nil";
+        is-deeply $next, 3, "$type: NEXTed expected number of times";
+        is-deeply $last, 1, "$type: LASTed expected number of times";
+    }
+}
+
 # vim: expandtab shiftwidth=4