From b0d3c56013d76bc037968c214b2662e7b520316b Mon Sep 17 00:00:00 2001
From: pmichaud <pmichaud@pobox.com>
Date: Tue, 20 Oct 2009 02:13:08 -0500
Subject: [PATCH] Make use of <OPER=...> bindings to promote <prec> and <sym>
 to operator precedence parser.

---
 src/HLL/Actions.pm         | 21 +++------------------
 src/HLL/Grammar.pm         |  6 +++---
 src/cheats/hll-grammar.pir | 13 ++++++++++---
 3 files changed, 16 insertions(+), 24 deletions(-)

diff --git a/src/HLL/Actions.pm b/src/HLL/Actions.pm
index 84328c1..addfcab 100644
--- 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
index 9cbb3e2..009793a 100644
--- 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
index affad06..14dfa67 100644
--- 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,6 +413,7 @@ An operator precedence parser.
     push opstack, $P0
     goto prefix_loop
   prefix_done:
+    delete term['prefixish']
 
   postfix_loop:
     unless postfixish goto postfix_done
@@ -418,6 +421,7 @@ An operator precedence parser.
     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,7 +432,8 @@ 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
@@ -436,6 +441,7 @@ An operator precedence parser.
   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: