A more complete solution to #3000

- pre-check EXPRessions, filter out the undefined ones - refactor circumfix() and circumfix[] code into single sub - remove dead code
rakudo · Jun 29, 2019 · a26e95b · a26e95b
1 parent c227693
commit a26e95b
Showing 1 changed file with 32 additions and 64 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -6613,26 +6613,35 @@ class Perl6::Actions is HLL::Actions does STDActions {
 
     method term:sym<value>($/) { make $<value>.ast; }
 
-    method circumfix:sym<( )>($/) {
-        my $Pair := $*W.find_symbol(['Pair']);
-        my $past := $<semilist>.ast;
-
+    sub handle-list-semis($/, $past) {
         if !+$past.list {
             $past := QAST::Stmts.new( :node($/) );
             $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/)));
         }
         # Look for any chained adverb pairs and relocate them.
         # Try to reuse existing QAST where possible.
         elsif $*FAKE_INFIX_FOUND {
-            my $numsemis := +$<semilist><statement>;
+            my @EXPR;
+            my $semis := $<semilist><statement>;
+            my $numsemis := +$semis;
+
+            my $i := -1;
+            while ++$i < $numsemis {
+                my $EXPR := $semis[$i]<EXPR>;
+                if nqp::defined($EXPR) {
+                    @EXPR.push($EXPR);
+                }
+            }
+            $numsemis := +@EXPR;
+
             if $numsemis > 1 {
                 $past := QAST::Stmts.new( :node($/) );
                 $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/)));
             }
-            my $semi := 0;
-            repeat until $semi >= $numsemis {
-                my $EXPR := $<semilist><statement>[$semi]<EXPR> // last;
-#                    nqp::die("internal problem: parser did not give circumfix an () EXPR");
+
+            my $semi := -1;
+            while ++$semi < $numsemis {
+                my $EXPR := @EXPR[$semi];
                 if $EXPR<colonpair> { # might start with a colonpair
                     my @fan := nqp::list($EXPR.ast);
                     migrate_colonpairs($/, @fan);
@@ -6657,11 +6666,23 @@ class Perl6::Actions is HLL::Actions does STDActions {
                         $past[0].push($EXPR.ast);
                     }
                 }
-                $semi++;
             }
             $past := wanted($past, 'circumfix()/pair');
         }
-        make $past;
+        $past
+    }
+
+    method circumfix:sym<( )>($/) {
+        make handle-list-semis($/, $<semilist>.ast)
+    }
+
+    method circumfix:sym<[ ]>($/) {
+        make QAST::Op.new(
+          :op('call'),
+          :name('&circumfix:<[ ]>'),
+          handle-list-semis($/, $<semilist>.ast),
+          :node($/)
+        )
     }
 
     method circumfix:sym<STATEMENT_LIST( )>($/) {
@@ -6861,59 +6882,6 @@ class Perl6::Actions is HLL::Actions does STDActions {
         }
     }
 
-    method circumfix:sym<[ ]>($/) {
-
-        my $Pair := $*W.find_symbol(['Pair']);
-        my $past := $<semilist>.ast;
-
-        if !+$past.list {
-            $past := QAST::Stmts.new( :node($/) );
-            $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/)));
-        }
-        # Look for any chained adverb pairs and relocate them.
-        # Try to reuse existing QAST where possible.
-        elsif $*FAKE_INFIX_FOUND {
-            my $numsemis := +$<semilist><statement>;
-            if $numsemis > 1 {
-                $past := QAST::Stmts.new( :node($/) );
-                $past.push(QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/)));
-            }
-            my $semi := 0;
-            repeat until $semi >= $numsemis {
-                my $EXPR := $<semilist><statement>[$semi]<EXPR> // last;
-#                    nqp::die("internal problem: parser did not give circumfix an [] EXPR");
-                if $EXPR<colonpair> { # might start with a colonpair
-                    my @fan := nqp::list($EXPR.ast);
-                    migrate_colonpairs($/, @fan);
-                    if (+@fan > 1) {
-                        my $comma := QAST::Op.new( :op('call'), :name('&infix:<,>'), :node($/));
-                        for @fan { $comma.push($_) }
-                        if ($numsemis == 1) {
-                            $past := QAST::Stmts.new( :node($/) );
-                            $past.push($comma);
-                        }
-                        else {
-                            $past[0].push($comma);
-                        }
-                    }
-                    elsif ($numsemis > 1) {
-                        $past[0].push($EXPR.ast);
-                    }
-                }
-                else {
-                    migrate_colonpairs($/, $EXPR.ast.list);
-                    if ($numsemis > 1) {
-                        $past[0].push($EXPR.ast);
-                    }
-                }
-                $semi++;
-            }
-            $past := wanted($past, 'circumfix[]/pair');
-        }
-
-        make QAST::Op.new( :op('call'), :name('&circumfix:<[ ]>'), $past, :node($/) );
-    }
-
     ## Expressions
     my %specials := nqp::hash(
         '==>',  -> $/, $sym { make_feed($/) },