Changeset 22929 for v6

Timestamp:

11/08/08 12:42:28 (2 months ago)

Author:

pmurias

Message:

[mildew] reverted 22887 and 22888 as they output broken m0ld, 22888 likely needs to be reapplied once things works again

Location:

v6/mildew

Files:

• mildew (modified) (11 diffs)
• src/AST.pm (modified) (7 diffs)

v6/mildew/mildew

@@ -15 +15 @@
 use Getopt::Long;
 use Carp 'confess';
-use Scalar::Util qw(blessed);
 
 my ($desugar,$debug,$file,$exec);
@@ -42 +41 @@
 }
 
-sub VAST::ws::emit_m0ld {
-    my $m = shift;
-    ( map {
-        warn ' extracting '.$_.' from ws ';
-        $m->{$_}->emit_m0ld
-      } grep { blessed $m->{$_} } keys %{$m} ),
-    ( map {
-        warn ' extracting '.ref($_).' from ws ';
-        $_->emit_m0ld
-      } map { @{$m->{$_}} } grep { ref $m->{$_} eq 'ARRAY' } keys %{$m} ),
-}
+sub VAST::ws::emit_m0ld {}
 
 sub VAST::longname::canonical {
@@ -89 +78 @@
                     ),
                 );
-            } else {
-                XXX;
             }
-        } else {
-            XXX;
         }
     } else {
@@ -136 +121 @@
         if ($name->{morename} and !$name->{identifier}) {
             lookup join '',map {$_->{identifier}[0]{TEXT}} @{$name->{morename}};
-        } else {
-            XXX;
-        }
-    } else {
-        XXX;
+            
+        }
     }
 }
@@ -223 +205 @@
 sub VAST::sublongname::canonical {
     my $m = shift;
-    XXX;
 }
 sub varname {
@@ -246 +227 @@
 sub VAST::Comma::emit_m0ld {
     my $m = shift;
-    AST::List->new(
-        elements => [ map {$_->emit_m0ld} @{$m->{list}} ]
-    );
+    map {$_->emit_m0ld} @{$m->{list}};
 }
 sub VAST::nulltermish::emit_m0ld {
@@ -259 +238 @@
     if (my $methodop = $m->{dottyop}{methodop}) {
         if ($methodop->{longname}) {
-            my $positional = [ map { map { $_->emit_m0ld } @{$_->{statement}} } @{$methodop->{semilist}} ];
+            my $positional = $methodop->{semilist}[0]{statement}[0];
+            my @positional = $positional ? $positional->emit_m0ld : ();
             my $ident = $methodop->{longname}->canonical;
             if ($m->{sym} eq '^!') {
@@ -266 +246 @@
             AST::Call->new(
                 identifier=>string $ident,
-                capture=>AST::Capture->new(invocant=>FETCH($noun),positional=>$positional),
+                capture=>AST::Capture->new(invocant=>FETCH($noun),positional=>[@positional]),
             );
         } else {
@@ -273 +253 @@
     } elsif (my $postop = $m->{dottyop}{postop}) {
         if (my $postcircumfix = $postop->{postcircumfix}) {
-            my $positional = [ map { map { $_->emit_m0ld } @{$_->{statement}} } @{$methodop->{semilist}} ];
+            my $positional = $methodop->{semilist}[0]{statement}[0];
+            my @positional = $positional ? $positional->emit_m0ld : ();
             AST::Call->new(
                 identifier => string 'postcircumfix:'.$postcircumfix->{FIRST}.' '.$postcircumfix->{LAST},
-                capture => AST::Capture->new(invocant=>FETCH($noun),positional=>$positional),
+                capture => AST::Capture->new(invocant=>FETCH($noun),positional=>[@positional]),
             );
         } else {
@@ -313 +294 @@
 sub VAST::Methodcall::emit_m0ld {
     my $m = shift;
-    $m->{dotty}->emit_m0ld($m->{arg}{noun}->emit_m0ld);
+    $m->{arg}->emit_m0ld;
 }
 sub VAST::List_assignment::emit_m0ld {
@@ -381 +362 @@
 print $mold->pretty,"\n" if $desugar;
 exit if $desugar;
-my $m0ld = <<'BOILERPLATE'.$mold->m0ld('$main').<<'CALL_MAIN';
+my $m0ld = <<'BOILERPLATE'.$mold->emit_('$main').<<'CALL_MAIN';
 my $void;
 BOILERPLATE

v6/mildew/src/AST.pm

@@ -1 +1 @@
 {
 package AST;
-use utf8;
 my $id=0;
 sub unique_id {
@@ -23 +22 @@
     my $self = shift;
     my $id = AST::unique_id;
-    return $self->m0ld($id);
-
+    $AST::CODE .= do {local $AST::CODE='';$AST::CODE . $self->m0ld($id)};
+    return $id;
+
+}
+sub emit_ {
+    local $AST::CODE = '';
+    my ($self,$ret) = @_;
+    my $mold = $self->m0ld($ret);
+    $AST::CODE . $mold;
 }
 sub pretty {
@@ -46 +52 @@
     my $then = $self->then->m0ld($id_then);
 
-    $cond.
+    $cond.$/.
     'my '.$id_cond.'_val = '.$id_cond.'."FETCH"();'.$/.
     'my '.$id_cond.'_bool = '.$id_cond.'_val."bool"();'.$/.
@@ -64 +70 @@
     "my $ret = mold {\n"
         . join('',map {'my $'.$_.";\n"} @{$self->regs})
-        . join("",map { $_->m0ld('$void') } @{$self->stmts})
+        . join("",map { $_->emit_('$void') } @{$self->stmts})
     . "};\n";
 }
@@ -96 +102 @@
 has 'stmt';
 
-package AST::List;
-use Moose;
-extends 'AST::Base';
-has 'elements' => (is=>'ro');
-
-sub m0ld {
-    my ($self, $ret) = @_;
-    my @args;
-    my $code;
-    for (@{$self->elements}) {
-        my $id = AST::unique_id();
-        $code .= $_->m0ld($id);
-        push @args, $id;
-    }
-    $code .= 'my '.$ret.' = ?SMOP__S1P__List."new"('.join(',',@args).');'.$/;
-}
-
 package AST::Named;
 use Moose;
@@ -149 +138 @@
     my ($self,$ret) = @_;
     if ($self->capture->isa("AST::Capture")) {
-        my @args;
-        my $code = '';
-        for ($self->arguments) {
-            my $id = AST::unique_id();
-            $code .= $_->m0ld($id);
-            push @args, $id;
-        }
-        my $invocant = AST::unique_id();
-        $code .= $self->capture->invocant->m0ld($invocant);
-        my $identifier = AST::unique_id();
-        $code .= $self->identifier->m0ld($identifier);
-        $code .= "my $ret = "
-          . $invocant
-          . "." . $identifier
-          . "(" . join(',', @args) . ")" . ";\n";
+        "my $ret = "
+        . $self->capture->invocant->emit
+        . "." . $self->identifier->emit
+        . "(" . join(',', map {$_->emit} $self->arguments) . ")" . ";\n";
     } else {
         die 'unimplemented';
@@ -228 +206 @@
 }
 sub m0ld {
-    my ($self,$ret) = @_;
-    "my $ret = ".$self->name."\n";
+    die "method m0ld is not supported on AST::Reg, m0ld doesn't support register aliasing\n"
 }
 sub pretty {