Changeset 22561

Timestamp:

10/10/08 08:49:28 (6 weeks ago)

Author:

lwall

Message:

[STD] move adverb parsing into infixish and EXPR with loose_unary prec

Files:

• src/perl6/STD.pm (modified) (9 diffs)

src/perl6/STD.pm

@@ -868 +868 @@
     
     <prefix_postfix_meta_operator>*                 {*}         #= prepost
-    { $+prevop = $<O> }
     <.ws>
 }
@@ -892 +891 @@
     ]
 
-    # also queue up any postfixes, since adverbs could change things
+    # also queue up any postfixes
     :dba('postfix')
     [ <?stdstopper> ||
         <post>*
-        <.ws>
-        <adverbs>?
-    ]
-}
-
-token adverbs {
-    <!stdstopper>
-    [ <colonpair> <.ws> ]+
-    {
-        my $prop = $+prevop orelse
-            $¢.panic('No previous operator visible to adverbial pair');
-#        $prop.adverb($<colonpair>);
-    }
+    ]
+    <.ws>
 }
 
@@ -947 +935 @@
         { $key = $<identifier>.text; $value = 0; }
         {*}                                                     #= false
+    | $<num> = [\d+] <identifier>
     | <identifier>
         { $key = $<identifier>.text; }
@@ -994 +983 @@
     :dba('infix or meta-infix')
     [
+    | <colonpair> { $<fake> = 1; $<sym> = ':'; %<O><prec> = %loose_unary<prec>;  }
     | <infix>
        [
@@ -1051 +1041 @@
     | <postop> { $<O> = $<postop><O> }
     ]
-    { $+prevop = $<O> }
 }
 
@@ -3245 +3234 @@
     || <?{ $listopish }>
     || ':' <?before \s> <arglist>    # either switch to listopiness
-    || {{ $+prevop = $<O> = {}; }}   # or allow adverbs (XXX needs hoisting?)
+    || {{ $<O> = {}; }}   # or allow adverbs (XXX needs hoisting?)
     ]
 }
@@ -3388 +3377 @@
     my $preclim = $preclvl ?? $preclvl.<prec> // $LOOSEST !! $LOOSEST;
     my $inquote is context = 0;
-    my $prevop is context<rw>;
     my @termstack;
     my @opstack;
@@ -3475 +3463 @@
     };
 
+  TERM:
     loop {
         self.deb("In loop, at ", $here.pos) if $*DEBUG +& DEBUG::EXPR;
@@ -3511 +3500 @@
         push @termstack, $here;
         self.deb("after push: " ~ (0+@termstack)) if $*DEBUG +& DEBUG::EXPR;
-        $oldpos = $here.pos;
-        my @infix = $here.cursor_fresh.infixish();
-        last unless @infix;
-        my $infix = @infix[0];
-        last unless $infix.pos > $oldpos;
-        
-        # XXX might want to allow this in a declaration though
-        if not $infix { $here.panic("Can't have two terms in a row") }
-
-        if not $infix<sym> {
-            die $infix.dump if $*DEBUG +& DEBUG::EXPR;
-        }
-
-        my $inO = $infix<O>;
-        $prevop = $inO;
-        my Str $inprec = $inO<prec>;
-        if not defined $inprec {
-            self.deb("No prec given in infix!") if $*DEBUG +& DEBUG::EXPR;
-            die $infix.dump if $*DEBUG +& DEBUG::EXPR;
-            $inprec = %terminator<prec>;
-        }
-
-        last unless $inprec gt $preclim;
-
-        $here = $infix.cursor_fresh.ws();
-
-
-        # substitute precedence for listops
-        $inO<prec> = $inO<sub> if $inO<sub>;
-
-        # Does new infix (or terminator) force any reductions?
-        while @opstack[*-1]<O><prec> gt $inprec {
-            reduce();
-        }
-
-        # Not much point in reducing the sentinels...
-        last if $inprec lt $LOOSEST;
-
-        # Equal precedence, so use associativity to decide.
-        if @opstack[*-1]<O><prec> eq $inprec {
-            given $inO<assoc> {
-                when 'non'   { $here.panic("\"$infix\" is not associative") }
-                when 'left'  { reduce() }   # reduce immediately
-                when 'right' { }            # just shift
-                when 'chain' { }            # just shift
-                when 'list'  {              # if op differs reduce else shift
-                    reduce() if $infix<sym> !eqv @opstack[*-1]<sym>;
+
+        loop {     # while we see adverbs
+            $oldpos = $here.pos;
+            my @infix = $here.cursor_fresh.infixish();
+            last TERM unless @infix;
+            my $infix = @infix[0];
+            last TERM unless $infix.pos > $oldpos;
+            
+            if not $infix<sym> {
+                die $infix.dump if $*DEBUG +& DEBUG::EXPR;
+            }
+
+            my $inO = $infix<O>;
+            my Str $inprec = $inO<prec>;
+            if not defined $inprec {
+                self.deb("No prec given in infix!") if $*DEBUG +& DEBUG::EXPR;
+                die $infix.dump if $*DEBUG +& DEBUG::EXPR;
+                $inprec = %terminator<prec>;
+            }
+
+            last TERM unless $inprec gt $preclim;
+
+            $here = $infix.cursor_fresh.ws();
+
+
+            # substitute precedence for listops
+            $inO<prec> = $inO<sub> if $inO<sub>;
+
+            # Does new infix (or terminator) force any reductions?
+            while @opstack[*-1]<O><prec> gt $inprec {
+                reduce();
+            }
+
+            # Not much point in reducing the sentinels...
+            last if $inprec lt $LOOSEST;
+
+            # Equal precedence, so use associativity to decide.
+            if @opstack[*-1]<O><prec> eq $inprec {
+                given $inO<assoc> {
+                    when 'non'   { $here.panic("\"$infix\" is not associative") }
+                    when 'left'  { reduce() }   # reduce immediately
+                    when 'right' { }            # just shift
+                    when 'chain' { }            # just shift
+                    when 'list'  {              # if op differs reduce else shift
+                        reduce() if $infix<sym> !eqv @opstack[*-1]<sym>;
+                    }
+                    default { $here.panic("Unknown associativity \"$_\" for \"$infix\"") }
                 }
-                default { $here.panic("Unknown associativity \"$_\" for \"$infix\"") }
+            }
+            if $infix<fake> {
+                my $adverbs = @termstack[*-1]<ADV> ||= [];
+                push @$adverbs, $infix<colonpair>;
+                next;  # not really an infix, so keep trying
+            }
+            else {
+                $termish = $inO<nextterm> if $inO<nextterm>;
+                push @opstack, $infix;
+                last;
             }
         }
-        $termish = $inO<nextterm> if $inO<nextterm>;
-        push @opstack, $infix;
     }
     reduce() while +@termstack > 1;