Skip to content
Permalink
Browse files

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
  • Loading branch information...
lizmat committed Jun 29, 2019
1 parent c227693 commit a26e95bab41e7b787c8283f7ae24ae3859727cfe
Showing with 32 additions and 64 deletions.
  1. +32 −64 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($/) },

0 comments on commit a26e95b

Please sign in to comment.
You can’t perform that action at this time.