Changeset 22599 for src/perl6

Timestamp:

10/14/08 00:57:05 (6 weeks ago)

Author:

lwall

Message:

[STD] fix circularity bug in unary and binary ops
[viv] more progress in ~ delimiters through

Location:

src/perl6

Files:

• Cursor.pmc (modified) (1 diff)
• STD.pm (modified) (5 diffs)
• viv (modified) (3 diffs)

src/perl6/Cursor.pmc

@@ -1958 +1958 @@
 
 sub _COMMITBRANCH { my $self = shift;
+    $self->{LAST} = shift() if @_;
     local $CTX = $self->callm if $DEBUG & DEBUG::trace_call;
     my $P = $self->{_pos};
+    my $F = $self->{_from};
+    my $buf = $self->{_orig};
+    $self->{FIRST} = substr($$buf, $F, $P - $F);
     $self->deb("Commit branch to $P") if $DEBUG & DEBUG::matchers;
     $self, LazyMap->new(sub { $self->deb("ABORTBRANCH") if $DEBUG & DEBUG::trace_call; die "ABORTBRANCH" }, $self);

src/perl6/STD.pm

@@ -2671 +2671 @@
     | <?> { $kind = '!' }
     ]
-
     <.ws>
+
     $<subsig> = [
-    | '[' ~ ']' <signature>
-    | <?before '{'> <!{ $+GOAL eq '{'}>
-      '{' ~ '}' <signature>
+        '[' ~ ']' <signature>
+        <.ws>
     ]*
 
@@ -3233 +3232 @@
     | :dba('argument list') '(' ~ ')' <semilist> {*}              #= func args
     | :dba('argument list') <.unsp> '.'? '(' ~ ')' <semilist> {*} #= func args
-    | {} [<?before \s> <!{ $istype }> <.ws> <!infixstopper> <arglist> { $listopish = 1 }]?
+    | {} [<?before \s> <!{ $istype }> <.ws> <!infixstopper> <listopargs=arglist> { $listopish = 1 }]?
     ]
 
@@ -3239 +3238 @@
     [
     || <?{ $listopish }>
-    || ':' <?before \s> <arglist>    # either switch to listopiness
+    || ':' <?before \s> <listopargs=arglist>    # either switch to listopiness
     || {{ $<O> = {}; }}   # or allow adverbs (XXX needs hoisting?)
     ]
@@ -3451 +3450 @@
 
                 self.deb($op.dump) if $*DEBUG +& DEBUG::EXPR;
-                $op<arg> = (pop @termstack).cleanup;
-                $op<_from> = $op<arg><_from>
-                    if $op<_from> > $op<arg><_from>;
-                $op<_to> = $op<arg><_to>
-                    if $op<_to> < $op<arg><_to>;
-                $op<_arity> = 'UNARY';
-                push @termstack, $op._REDUCE('EXPR');
+                my $nop = $op.cursor_fresh();
+                $nop<_from> = $op<_from>;
+                $nop<_to> = $op<_to>;
+                $nop<_pos> = $op<_pos>;
+                $nop<arg> = (pop @termstack).cleanup;
+                if ($nop<arg><_from> < $nop<_from>) {
+                    $nop<_from> = $nop<arg><_from>;
+                }
+                if ($nop<arg><_to> > $nop<_to>) {
+                    $nop<_to> = $nop<arg><_to>;
+                }
+                $nop<_arity> = 'UNARY';
+                push @termstack, $nop._REDUCE('EXPR');
             }
             default {
@@ -3465 +3470 @@
 
                 self.deb($op.dump) if $*DEBUG +& DEBUG::EXPR;
-                $op<right> = (pop @termstack).cleanup;
-                $op<left> = (pop @termstack).cleanup;
-                $op<_from> = $op<left><_from>;
-                $op<_to> = $op<right><_to>;
-                $op<_arity> = 'BINARY';
-                push @termstack, $op._REDUCE('EXPR');
+                my $nop = $op.cursor_fresh();
+                $nop<right> = (pop @termstack).cleanup;
+                $nop<left> = (pop @termstack).cleanup;
+                $nop<_from> = $nop<left><_from>;
+                $nop<_to> = $nop<right><_to>;
+                $nop<_arity> = 'BINARY';
+                push @termstack, $nop._REDUCE('EXPR');
             }
         }

src/perl6/viv

@@ -275 +275 @@
 }
 
-{ package VAST::AddSym; our @ISA = 'VAST::Base';
+{ package VAST::PreSym; our @ISA = 'VAST::Base';
     sub emit_p6 { my $self = shift;
         my $text = $self->get_ws;
         $text .= $self->{sym};
         $text .= $self->SUPER::emit_p6(@_);
+        $text;
+    }
+}
+
+{ package VAST::CircumSym; our @ISA = 'VAST::Base';
+    sub emit_p6 { my $self = shift;
+        my $text = $self->get_ws;
+        $text .= $self->{sym}[0];
+        $text .= $self->SUPER::emit_p6(@_);
+        $text .= $self->{sym}[1];
+        $text;
+    }
+}
+
+{ package VAST::FirstLast; our @ISA = 'VAST::Base';
+    sub emit_p6 { my $self = shift;
+        my $text = $self->get_ws;
+        $text .= $self->{FIRST};
+        $text .= $self->SUPER::emit_p6(@_);
+        $text .= $self->{LAST};
         $text;
     }
@@ -364 +384 @@
 }
 
-{ package VAST::scope_declarator; our @ISA = 'VAST::AddSym'; }
-{ package VAST::statement_control; our @ISA = 'VAST::AddSym'; }
-{ package VAST::version; our @ISA = 'VAST::AddSym'; }
-
 { package VAST::variable_declarator; our @ISA = 'VAST::Base';
     sub emit_p6 { my $self = shift;
@@ -379 +395 @@
 }
 
+{ package VAST::scope_declarator; our @ISA = 'VAST::PreSym'; }
+{ package VAST::statement_control; our @ISA = 'VAST::PreSym'; }
+{ package VAST::statement_prefix; our @ISA = 'VAST::PreSym'; }
+{ package VAST::version; our @ISA = 'VAST::PreSym'; }
+
+{ package VAST::block; our @ISA = 'VAST::CircumSym'; }
+{ package VAST::circumfix; our @ISA = 'VAST::CircumSym'; }
+{ package VAST::postcircumfix; our @ISA = 'VAST::CircumSym'; }
+{ package VAST::args; our @ISA = 'VAST::FirstLast'; }
+
 if ($0 eq __FILE__) {
     ::MAIN(@ARGV);