Changeset 22553 for src/perl6

Timestamp:

10/09/08 06:16:28 (6 weeks ago)

Author:

lwall

Message:

[viv] can now reconstruct the p6 from the ast for simple expressions

Location:

src/perl6

Files:

• STD.pm (modified) (4 diffs)
• viv (modified) (5 diffs)

src/perl6/STD.pm

@@ -914 +914 @@
     [
     | <fatarrow>
-    | <variable> { $<sigil> = $<variable><sigil> }
+    | <variable> { $<SIGIL> = $<variable><sigil> }
     | <package_declarator>
     | <scope_declarator>
@@ -1185 +1185 @@
 token variable_declarator {
     :my $IN_DECL is context<rw> = 1;
-    <variable> { $<sigil> = $<variable><sigil> }
+    <variable> { $<SIGIL> = $<variable><sigil> }
     { $IN_DECL = 0; }
     [   # Is it a shaped array or hash declaration?
@@ -1206 +1206 @@
     :dba('variable initializer')
     [
-    | '=' <.ws> <EXPR( ($<sigil> // '') eq '$' ?? item %item_assignment !! item %list_prefix )>
+    | '=' <.ws> <EXPR( ($<SIGIL> // '') eq '$' ?? item %item_assignment !! item %list_prefix )>
     | '.=' <.ws> <dottyop>
     ]?
@@ -3147 +3147 @@
 {
     <sym>
-    { $¢ = (self.<sigil>//'') eq '$' 
+    { $¢ = (self.<SIGIL> // self.<sigil> // '') eq '$' 
         ?? STD::Item_assignment.coerce($¢)
         !! STD::List_assignment.coerce($¢);

src/perl6/viv

@@ -50 +50 @@
 
     our $AUTOLOAD;
+    my $SEQ = 1;
 
     sub AUTOLOAD {
@@ -74 +75 @@
                     $r{$key} = $$v{$key};
                 }
+            }
+            elsif ($k eq 'SIGIL') {
+                $r{SIGIL} = $v;
             }
             elsif ($k eq '_arity') {
@@ -95 +99 @@
                     }
                     $r{$k} = $zyg;
+                    $r{zygs}{$k} = $SEQ++ if @$zyg;
                 }
                 elsif (ref $v) {
@@ -103 +108 @@
                         $r{$k} = $v;
                     }
+                    $r{zygs}{$k} = $SEQ++;
                     unless (ref($r{$k}) =~ /^VAST/) {
                         my $class = "VAST::$k";
@@ -144 +150 @@
     sub emit_p6 { my $self = shift;
         my $text;
-        # XXX bogus
-        if (exists $self->{TEXT}) {
-            $text = $self->{TEXT};
-        }
-        elsif (exists $self->{sym}) {
+        my @sym;
+        if (exists $self->{sym}) {
             my $sym = $self->{sym};
             if (ref $sym eq 'ARRAY') {
-                $text = join '?', @$sym;
+                @sym = @$sym;
             }
             else {
-                $text = $sym;
-            }
-        }
-        else {
-            for my $key (sort keys %$self) {
-                my $part = $$self{$key};
+                @sym = $sym;
+            }
+        }
+        if ($self->{zygs}) {
+            my @zyg = $self->visit_zygs;
+            my $arity = $self->{arity} // '';
+            if ($arity eq 'BINARY') {
+                $text .= shift @zyg;
+                $text .= shift @sym;
+                $text .= shift @zyg;
+            }
+            elsif ($arity eq 'UNARY') {
+                if ($self->{post}) {
+                    $text .= shift @zyg;
+                    $text .= shift @sym;
+                }
+                else {
+                    $text .= shift @sym;
+                    $text .= shift @zyg;
+                }
+            }
+            else {
+                $text .= join('', @zyg);
+            }
+        }
+        elsif (exists $self->{TEXT}) {
+            $text = $self->{TEXT};
+        }
+        elsif (@sym) {
+            $text .= join('', @sym);
+        }
+        $text;
+    }
+
+    sub visit_zygs { my $self = shift;
+        my @zygs;
+        if ($self->{zygs}) {
+            my $zygs = $self->{zygs};
+            for my $key (sort {$zygs->{$a} <=> $zygs->{$b}} keys %$zygs) {
+                my $part = $self->{$key};
                 if (ref $part eq 'ARRAY') {
                     my @kids = @$part;
                     for my $kid (@kids) {
-                        $text .= $kid->emit_p6;
+                        push @zygs, $kid->emit_p6 // '';
                     }
                 }
                 elsif (ref $part) {
-                    $text .= $part->emit_p6;
+                    push @zygs, $part->emit_p6 // '';
                 }
                 else {
-                    $text = $key . '=' . $part;
-                }
-            }
-        }
-        $text;
+                    push @zygs, $key . '=' . $part;
+                }
+            }
+        }
+        @zygs;
     }
 }