Make use of <OPER=...> bindings to promote <prec> and <sym> to

operator precedence parser.
perl6 · Oct 20, 2009 · b0d3c56 · b0d3c56
1 parent 49572a7
commit b0d3c56
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 24 deletions.
diff --git a/src/HLL/Actions.pm b/src/HLL/Actions.pm
@@ -5,32 +5,17 @@ method EXPR($/, $key?) {
     my $past := PAST::Op.new( :node($/) );
     for $/.list { $past.push($_.ast); }
     if $key eq 'INFIX' {
-       $past.name( 'infix:<' ~ $<sym> ~ '>' );
+       $past.name( 'infix:<' ~ $<OPER><sym> ~ '>' );
     }
     elsif $key eq 'PREFIX' {
-       $past.name( 'prefix:<' ~ $<sym> ~ '>' );
+       $past.name( 'prefix:<' ~ $<OPER><sym> ~ '>' );
     }
     elsif $key eq 'POSTFIX' {
-       $past.name( 'postfix:<' ~ $<sym> ~ '>' );
+       $past.name( 'postfix:<' ~ $<OPER><sym> ~ '>' );
     }
     make $past;
 }
 
-method prefixish($/) {
-    $<O> := $<prefix><O>;
-    $<sym> := $<prefix><sym>;
-}
-
-method infixish($/) {
-    $<O> := $<infix><O>;
-    $<sym> := $<infix><sym>;
-}
-
-method postfixish($/) {
-    $<O> := $<postfix><O>;
-    $<sym> := $<postfix><sym>;
-}
-
 method termish($/) {
     make $<noun>.ast;
 }

diff --git a/src/HLL/Grammar.pm b/src/HLL/Grammar.pm
@@ -15,9 +15,9 @@ grammar HLL::Grammar;
     token noun:sym<term> { <term> }
     token noun:sym<circumfix> { <circumfix> }
 
-    token infixish { <infix> }
-    token prefixish { <prefix> }
-    token postfixish { <postfix> }
+    token infixish { <OPER=infix=infix> }
+    token prefixish { <OPER=prefix=prefix> }
+    token postfixish { <OPER=postfix=postfix> }
 
     token quote_delimited {
         <starter> <quote_atom>* <stopper>

diff --git a/src/cheats/hll-grammar.pir b/src/cheats/hll-grammar.pir
@@ -391,8 +391,10 @@ An operator precedence parser.
     unless postfixish goto prepostfix_done
     .local string preprec, postprec
     $P0 = prefixish[0]
+    $P0 = $P0['OPER']
     preprec = $P0['prec']
-    $P1 = postfixish[0]
+    $P0 = postfixish[0]
+    $P0 = $P0['OPER']
     postprec = $P0['prec']
     if postprec < preprec goto postltpre
   postgtpre:
@@ -411,13 +413,15 @@ An operator precedence parser.
     push opstack, $P0
     goto prefix_loop
   prefix_done:
+    delete term['prefixish']
 
   postfix_loop:
     unless postfixish goto postfix_done
     $P0 = shift postfixish
     push opstack, $P0
     goto postfix_loop
   postfix_done:
+    delete term['postfixish']
 
     # Now see if we can fetch an infix operator
     .local pmc infixcur, infix
@@ -428,14 +432,16 @@ An operator precedence parser.
 
     unless opstack goto reduce_done
     .local string inprec, inassoc, opprec
-    $P0 = infix['O']
+    $P0 = infix['OPER']
+    $P0 = $P0['O']
     inprec = $P0['prec']
     inassoc = $P0['assoc']
     unless inprec goto err_inprec
 
   reduce_loop:
     unless opstack goto reduce_done
     $P0 = opstack[-1]
+    $P0 = $P0['OPER']
     $P0 = $P0['O']
     opprec = $P0['prec']
     unless opprec > inprec goto reduce_gt_done
@@ -490,7 +496,8 @@ An operator precedence parser.
     .local pmc op
     .local string opassoc
     op = pop opstack
-    $P0 = op['O']
+    $P0 = op['OPER']
+    $P0 = $P0['O']
     opassoc = $P0['assoc']
     if opassoc == 'unary' goto op_unary
   op_infix: