[svn:parrot] r44864 - in branches/ops_pct/compilers/opsc/src/Ops: . Compiler

[bacek at svn.parrot.org]

Author: bacek
Date: Thu Mar 11 05:09:41 2010
New Revision: 44864
URL: https://trac.parrot.org/parrot/changeset/44864

Log:
Implement generating C code for new Ops::Op past

Modified:
   branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
   branches/ops_pct/compilers/opsc/src/Ops/Op.pm

Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Thu Mar 11 05:09:01 2010	(r44863)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Thu Mar 11 05:09:41 2010	(r44864)
@@ -90,10 +90,12 @@
     $op<normalized_args> := @norm_args;
 
     if !%flags<flow> {
-        $op.push(PAST::Op.new(
-            :pasttype('inline'),
-            :inline("\n" ~ 'goto_next')
-            ));
+        my $goto_next := PAST::Op.new(
+            :pasttype('call'),
+            :name('goto_offset')
+        );
+        $goto_next<is_next> := 1;
+        $op.push($goto_next);
     }
 
     my $past := PAST::Stmts.new(
@@ -247,7 +249,7 @@
         else {
             $past.push(PAST::Op.new(
                 :pasttype('inline'),
-                $prev_words
+                :inline($prev_words),
             ));
             $prev_words := '';
 
@@ -265,7 +267,7 @@
     if $prev_words {
         $past.push(PAST::Op.new(
             :pasttype('inline'),
-            $prev_words
+            :inline($prev_words)
         ));
     }
     make $past;
@@ -273,7 +275,7 @@
 
 method macro_param($/) {
     make PAST::Var.new(
-        :name(~$/),
+        :name(~$<num>),
         :node($/),
     );
 }
@@ -302,7 +304,8 @@
 
 method op_macro($/) {
     #say('# op_macro');
-    my $macro_name := ~$<macro_type> ~ '_' ~ lc(~$<macro_destination>);
+    my $is_next    := ~$<macro_destination> eq 'NEXT';
+    my $macro_name := ~$<macro_type> ~ '_' ~ lc($is_next ?? 'offset' !! ~$<macro_destination>);
 
     my $past := PAST::Op.new(
         :pasttype('call'),
@@ -318,6 +321,7 @@
     for $<body_word> {
         $past.push($_.ast);
     }
+    $past<is_next> := $is_next;
     make $past;
 }
 

Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Thu Mar 11 05:09:01 2010	(r44863)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Thu Mar 11 05:09:41 2010	(r44864)
@@ -253,7 +253,7 @@
 method source( $trans ) {
 
     my $prelude := $trans.body_prelude;
-    return self.get_body( $prelude, $trans );
+    return $prelude ~ self.get_body( $trans );
 }
 
 
@@ -326,7 +326,7 @@
 
 =begin
 
-=item C<get_body($prelude, $trans)>
+=item C<get_body($trans)>
 
 Performs the various macro substitutions using the specified transform,
 correctly handling nested substitions, and repeating over the whole string
@@ -337,19 +337,71 @@
 
 =end
 
-method get_body( $prelude, $trans ) {
+method get_body( $trans ) {
 
-    my $body := $prelude;
+    my @body := list();
 
     #work through the op_body tree
-    for $self<op_body> {
-
-        pir::say("found an op body thing");
+    for @(self) {
+        my $chunk := self.process_body_chunk($trans, $_);
+        #pir::say('# chunk ' ~ $chunk);
+        @body.push($chunk);
     }
 
-    return self.substitute( $body, $trans );
+    join('', |@body);
 }
 
+# Recursively process body chunks returning string.
+# Ideally bunch of multisubs, but...
+method process_body_chunk($trans, $chunk) {
+    my $what := $chunk.WHAT;
+    # Poor man multis...
+    if $what eq 'PAST::Var()' {
+        my $n := +$chunk.name;
+        return $trans.access_arg( self.arg_type($n - 1), $n);
+    }
+    elsif $what eq 'PAST::Op()' {
+        my $type := $chunk.pasttype;
+        #say('OP ' ~ $type);
+        if $type eq 'inline' {
+            #_dumper($chunk);
+            #pir::say('RET ' ~ $chunk<inline>);
+            return $chunk.inline;
+        }
+        elsif $type eq 'call' {
+            my $name     := $chunk.name;
+            my $is_next  := $chunk<is_next>;
+            #say('NAME '~$name ~ ' ' ~ $is_next);
+            my $children;
+            if $is_next {
+                #say('is_next');
+                $children := ~self.size;
+            }
+            else {
+                my @children := list();
+                for @($chunk) {
+                    @children.push(self.process_body_chunk($trans, $_));
+                }
+                $children := join('', |@children);
+            }
+            #pir::say('children ' ~ $children);
+            my $ret := Q:PIR<
+                $P0 = find_lex '$trans'
+                $P1 = find_lex '$name'
+                $S0 = $P1
+                $P1 = find_lex '$children'
+                %r  = $P0.$S0($P1)
+            >;
+            #pir::say('RET ' ~ $ret);
+            return $ret;
+        }
+    }
+    else {
+        pir::die('HOLEY');
+    }
+}
+
+
 =begin
 
 =item C<size()>