[svn:parrot] r48050 - in branches/gsoc_past_optimization: runtime/parrot/library/PAST t/library

[tcurtis at svn.parrot.org]

Author: tcurtis
Date: Thu Jul  8 03:44:59 2010
New Revision: 48050
URL: https://trac.parrot.org/parrot/changeset/48050

Log:
Add tests for PAST::Transformer transforming PAST::Var.viviself and .vivibase, and implement it.

Modified:
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Transformer.nqp
   branches/gsoc_past_optimization/t/library/pasttransformer.t

Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Transformer.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Transformer.nqp	Thu Jul  8 03:08:57 2010	(r48049)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Transformer.nqp	Thu Jul  8 03:44:59 2010	(r48050)
@@ -6,11 +6,37 @@
     pir::load_bytecode('Tree/Transformer.pbc');
 }
 
-# This class doesn't differ in behavior from Tree::Transformer, but having
-# it provides both a specification of what you expect to be transforming
-# and a way to easily change its behavior if that becomes necessary in the
-# future.
-class PAST::Transformer is Tree::Transformer { }
+class PAST::Transformer is Tree::Transformer {
+    our multi method walkable ($node) { 0; }
+    our multi method walkable (PAST::Node $node) { 1; }
+}
+
+module Tree::Walker {
+    our multi sub walkChildren (PAST::Transformer $walker, PAST::Var $var) {
+        my $results := pir::new__PP(Capture);
+        my $index := 0;
+        my $max := pir::elements__IP($var);
+        while ($index < $max) {
+            $results[$index] := walk($walker, $var[$index]);
+            $index++;
+        }
+        $results['viviself'] := $walker.walk($var.viviself)
+          if $walker.walkable($var.viviself);
+        $results['vivibase'] := $walker.walk($var.vivibase)
+          if $walker.walkable($var.vivibase);
+        $results;
+    }
+
+    our multi sub replaceChildren (PAST::Var $node, $newChildren) {
+        $node := null;
+        for $newChildren.list -> $child {
+            pir::push($node, $child);
+        }
+        for $newChildren.hash {
+            $node.attr($_.key, $_.value, 1);
+        }
+    }
+}
 
 # Local Variables:
 #   mode: cperl

Modified: branches/gsoc_past_optimization/t/library/pasttransformer.t
==============================================================================
--- branches/gsoc_past_optimization/t/library/pasttransformer.t	Thu Jul  8 03:08:57 2010	(r48049)
+++ branches/gsoc_past_optimization/t/library/pasttransformer.t	Thu Jul  8 03:44:59 2010	(r48050)
@@ -8,10 +8,11 @@
     pir::load_bytecode('PAST/Pattern.pbc');
 }
 
-plan(3);
+plan(4);
 test_change_node_attributes();
 test_change_node_types();
 test_delete_nodes();
+test_traverse_var_attributes();
 
 class Increment is PAST::Transformer { }
 class Negate is PAST::Transformer { }
@@ -107,6 +108,19 @@
        "Nodes can be deleted by PAST::Transformers.");
 }
 
+sub test_traverse_var_attributes () {
+    my $past :=
+      PAST::Var.new(:viviself(PAST::Val.new(:value(5))),
+                    :vivibase(PAST::Val.new(:value(6))));
+    my $transformer := Increment.new;
+    my $result := $transformer.walk($past);
+    my $target :=
+      PAST::Pattern::Var.new(:viviself(PAST::Pattern::Val.new(:value(6))),
+                             :vivibase(PAST::Pattern::Val.new(:value(7))));
+    ok($result.match($target, :pos($result)),
+       "PAST::Transformer walks PAST::Var.viviself and .vivibase.");
+}
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4