[svn:parrot] r47395 - in branches/gsoc_past_optimization: . config/gen/makefiles runtime/parrot/library/PAST runtime/parrot/library/PAST/Pattern t/library

tcurtis at svn.parrot.org tcurtis at svn.parrot.org
Sat Jun 5 22:26:27 UTC 2010


Author: tcurtis
Date: Sat Jun  5 22:26:27 2010
New Revision: 47395
URL: https://trac.parrot.org/parrot/changeset/47395

Log:
Refactored so that every attribute and child is a ~~-able object, preparatory to implementing PAST::Pattern::Match result objects.

Added:
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/   (props changed)
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp   (contents, props changed)
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp   (contents, props changed)
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp   (contents, props changed)
Modified:
   branches/gsoc_past_optimization/MANIFEST
   branches/gsoc_past_optimization/MANIFEST.SKIP
   branches/gsoc_past_optimization/config/gen/makefiles/root.in
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp
   branches/gsoc_past_optimization/t/library/pastpattern.t

Modified: branches/gsoc_past_optimization/MANIFEST
==============================================================================
--- branches/gsoc_past_optimization/MANIFEST	Sat Jun  5 22:26:26 2010	(r47394)
+++ branches/gsoc_past_optimization/MANIFEST	Sat Jun  5 22:26:27 2010	(r47395)
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun  2 04:07:25 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat Jun  5 22:12:05 2010 UT
 #
 # See below for documentation on the format of this file.
 #
@@ -1158,6 +1158,9 @@
 runtime/parrot/library/OpenGL/Math.pir                      [library]
 runtime/parrot/library/P6object.pir                         [library]
 runtime/parrot/library/PAST/Pattern.nqp                     [library]
+runtime/parrot/library/PAST/Pattern/Closure.nqp             [library]
+runtime/parrot/library/PAST/Pattern/Constant.nqp            [library]
+runtime/parrot/library/PAST/Pattern/Node.nqp                [library]
 runtime/parrot/library/PAST/Transformer.pir                 [library]
 runtime/parrot/library/PAST/Transformer/Dynamic.pir         [library]
 runtime/parrot/library/PAST/Walker.pir                      [library]

Modified: branches/gsoc_past_optimization/MANIFEST.SKIP
==============================================================================
--- branches/gsoc_past_optimization/MANIFEST.SKIP	Sat Jun  5 22:26:26 2010	(r47394)
+++ branches/gsoc_past_optimization/MANIFEST.SKIP	Sat Jun  5 22:26:27 2010	(r47395)
@@ -1,6 +1,6 @@
 # ex: set ro:
 # $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun  2 04:07:25 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sat Jun  5 22:12:05 2010 UT
 #
 # This file should contain a transcript of the svn:ignore properties
 # of the directories in the Parrot subversion repository. (Needed for
@@ -581,6 +581,15 @@
 ^runtime/parrot/library/PAST/.*\.pbc/
 ^runtime/parrot/library/PAST/Pattern\.pir$
 ^runtime/parrot/library/PAST/Pattern\.pir/
+# generated from svn:ignore of 'runtime/parrot/library/PAST/Pattern/'
+^runtime/parrot/library/PAST/Pattern/.*\.pbc$
+^runtime/parrot/library/PAST/Pattern/.*\.pbc/
+^runtime/parrot/library/PAST/Pattern/Closure\.pir$
+^runtime/parrot/library/PAST/Pattern/Closure\.pir/
+^runtime/parrot/library/PAST/Pattern/Constant\.pir$
+^runtime/parrot/library/PAST/Pattern/Constant\.pir/
+^runtime/parrot/library/PAST/Pattern/Node\.pir$
+^runtime/parrot/library/PAST/Pattern/Node\.pir/
 # generated from svn:ignore of 'runtime/parrot/library/PAST/Transformer/'
 ^runtime/parrot/library/PAST/Transformer/.*\.pbc$
 ^runtime/parrot/library/PAST/Transformer/.*\.pbc/

Modified: branches/gsoc_past_optimization/config/gen/makefiles/root.in
==============================================================================
--- branches/gsoc_past_optimization/config/gen/makefiles/root.in	Sat Jun  5 22:26:26 2010	(r47394)
+++ branches/gsoc_past_optimization/config/gen/makefiles/root.in	Sat Jun  5 22:26:27 2010	(r47395)
@@ -286,6 +286,9 @@
     $(LIBRARY_DIR)/osutils.pbc \
     $(LIBRARY_DIR)/P6object.pbc \
     $(LIBRARY_DIR)/PAST/Pattern.pbc \
+    $(LIBRARY_DIR)/PAST/Pattern/Closure.pbc \
+    $(LIBRARY_DIR)/PAST/Pattern/Constant.pbc \
+    $(LIBRARY_DIR)/PAST/Pattern/Node.pbc \
     $(LIBRARY_DIR)/PAST/Transformer.pbc \
     $(LIBRARY_DIR)/PAST/Transformer/Dynamic.pbc \
     $(LIBRARY_DIR)/PAST/Walker.pbc \
@@ -1060,6 +1063,34 @@
 
 $(LIBRARY_DIR)/PAST/Pattern.pir: $(LIBRARY_DIR)/PAST/Pattern.nqp $(NQP_RX)
 	$(NQP_RX) --target=pir $(LIBRARY_DIR)/PAST/Pattern.nqp > $@
+
+$(LIBRARY_DIR)/PAST/Pattern/Constant.pbc: \
+	$(LIBRARY_DIR)/PAST/Pattern/Constant.pir
+	$(PARROT) -o $@ $(LIBRARY_DIR)/PAST/Pattern/Constant.pir
+
+$(LIBRARY_DIR)/PAST/Pattern/Constant.pir: \
+	$(LIBRARY_DIR)/PAST/Pattern/Constant.nqp $(NQP_RX)
+	$(NQP_RX) --target=pir $(LIBRARY_DIR)/PAST/Pattern/Constant.nqp \
+	> $@
+
+$(LIBRARY_DIR)/PAST/Pattern/Closure.pbc: \
+	$(LIBRARY_DIR)/PAST/Pattern/Closure.pir
+	$(PARROT) -o $@ $(LIBRARY_DIR)/PAST/Pattern/Closure.pir
+
+$(LIBRARY_DIR)/PAST/Pattern/Closure.pir: \
+	$(LIBRARY_DIR)/PAST/Pattern/Closure.nqp $(NQP_RX)
+	$(NQP_RX) --target=pir $(LIBRARY_DIR)/PAST/Pattern/Closure.nqp\
+	> $@
+
+$(LIBRARY_DIR)/PAST/Pattern/Node.pbc: \
+	$(LIBRARY_DIR)/PAST/Pattern/Node.pir
+	$(PARROT) -o $@ $(LIBRARY_DIR)/PAST/Pattern/Node.pir
+
+$(LIBRARY_DIR)/PAST/Pattern/Node.pir: \
+	$(LIBRARY_DIR)/PAST/Pattern/Node.nqp $(NQP_RX)
+	$(NQP_RX) --target=pir $(LIBRARY_DIR)/PAST/Pattern/Node.nqp \
+	> $@
+
 #
 # Profiling runcore test supporting code
 #

Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp	Sat Jun  5 22:26:26 2010	(r47394)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp	Sat Jun  5 22:26:27 2010	(r47395)
@@ -7,323 +7,32 @@
 }
 
 class PAST::Pattern is Capture {
-    method attr ($name, $value, $has_value) {
-        my $result;
-        if ($has_value) {
-            self{$name} := $value;
-        } else {
-            $result := self{$name};
-        }
-        $result;
-    }
-
-    method name ($val?) {
-        self.attr("name", $val, !pir::isnull__iP($val));
-    }
-
-    method source ($val?) {
-        self.attr("source", $val, !pir::isnull__iP($val));
-    }
-
-    method pos ($val?) {
-        self.attr("pos", $val, !pir::isnull__iP($val));
-    }
-
-    method returns ($val?) {
-        self.attr("returns", $val, !pir::isnull__iP($val));
-    }
-
-    method arity ($val?) {
-        self.attr("arity", $val, !pir::isnull__iP($val));
-    }
-
-    method named ($val?) {
-        self.attr("named", $val, !pir::isnull__iP($val));
-    }
-
-    method flat ($val?) {
-        self.attr("flat", $val, !pir::isnull__iP($val));
-    }
-
-    method lvalue ($val?) {
-        self.attr("lvalue", $val, !pir::isnull__iP($val));
-    }    
-
-    method new (*@children, *%attrs) {
-        my $result := Q:PIR {
-            $P0 = self.'HOW'()
-            $P0 = getattribute $P0, 'parrotclass'
-            %r = new $P0
-        };
-
-        for %attrs {
-            $result.attr($_, %attrs{$_}, 1);
-        }
-        for @children {
-            pir::push($result, $_);
-        }
-        $result;
-    }
-    
-    sub check ($patt, $val) {
-        my $result := 1;
-        if (pir::defined__IP($patt)) {
-            if (!pir::defined__IP($val)) {
-                $result := 0;
-            }
-            elsif (pir::can__IPs($patt, "ACCEPTS")) {
-                $result := ?($val ~~ $patt);
-            } elsif (pir::does($patt, "invokable")) {
-                $result := ?$patt($val);
-            }
-            else {
-                $result := pir::iseq__IPP($patt, $val);
-                CATCH {
-                    $result := 0;
-                }
+    sub patternize ($value) {
+        unless (pir::can__IPS($value, 'ACCEPTS')) {
+            if (pir::isa__IPP($value, Sub)) {
+                $value := PAST::Pattern::Closure.new($value);
+            } else {
+                $value := PAST::Pattern::Constant.new($value);
             }
         }
-        $result;
-    }
-
-
-    sub check_attribute ($pattern, $node, $attribute) {
-        check($pattern.attr($attribute, null, 0),
-              $node.attr($attribute, null, 0));
+        $value;
     }
 
-    sub check_children ($pattern, $node) {
-        my $pLen := pir::elements($pattern);
-        my $nLen := pir::elements($node);
+    method attr ($name, $value, $has_value) {
         my $result;
-        my $index;
-        if ($pLen == $nLen) {
-            $index := 0;
-            while ($index < $pLen) {
-                unless (check($pattern[$index], $node[$index])) {
-                    return 0;
-                }
-                $index++;
-            }
-            $result := 1;
+        if ($has_value) {
+            self{$name} := $value;
         } else {
-            $result := 0;
-        }
-        $result;
-    }
-
-    sub check_node_attributes ($pattern, $node) {
-        (check_attribute($pattern, $node, "name")
-         && check_attribute($pattern, $node, "source")
-         && check_attribute($pattern, $node, "pos")
-         && check_attribute($pattern, $node, "returns")
-         && check_attribute($pattern, $node, "arity")
-         && check_attribute($pattern, $node, "named")
-         && check_attribute($pattern, $node, "flat")
-         && check_attribute($pattern, $node, "lvalue"));
-    }
-
-    method ACCEPTS ($node) {
-        my $result := self.ACCEPTSEXACTLY($node);
-        if (!$result && $node ~~ PAST::Node) {
-            my $index := 0;
-            my $max := pir::elements__IP($node);
-            until ($result || $index == $max) {
-                $result := $node[$index] ~~ self;
-                $index++;
-            }
+            $result := self{$name};
         }
         $result;
     }
 }
 
-class PAST::Pattern::Block is PAST::Pattern {
-    method blocktype ($val?) {
-        self.attr("blocktype", $val, !pir::isnull__iP($val));
-    }
-
-    method closure ($val?) {
-        self.attr("closure", $val, !pir::isnull__iP($val));
-    }
-
-    method control ($val?) {
-        self.attr("control", $val, !pir::isnull__iP($val));
-    }
-
-    method loadinit ($val?) {
-        self.attr("loadinit", $val, !pir::isnull__iP($val));
-    }
-
-    method namespace ($val?) {
-        self.attr("namespace", $val, !pir::isnull__iP($val));
-    }
-
-    method multi ($val?) {
-        self.attr("multi", $val, !pir::isnull__iP($val));
-    }
-
-    method hll ($val?) {
-        self.attr("hll", $val, !pir::isnull__iP($val));
-    }
-
-    method nsentry ($val?) {
-        self.attr("nsentry", $val, !pir::isnull__iP($val));
-    }
-
-    method symtable ($val?) {
-        self.attr("symtable", $val, !pir::isnull__iP($val));
-    }
-
-    method lexical ($val?) {
-        self.attr("lexical", $val, !pir::isnull__iP($val));
-    }
-
-    method compiler ($val?) {
-        self.attr("compiler", $val, !pir::isnull__iP($val));
-    }
-
-    method compiler_args ($val?) {
-        self.attr("compiler_args", $val, !pir::isnull__iP($val));
-    }
-
-    method subid ($val?) {
-        self.attr("subid", $val, !pir::isnull__iP($val));
-    }
-
-    method pirflags ($val?) {
-        self.attr("pirflags", $val, !pir::isnull__iP($val));
-    }
-
-    sub check_block_attributes($pattern, $node) {
-        (PAST::Pattern::check_attribute($pattern, $node, "blocktype")
-         && PAST::Pattern::check_attribute($pattern, $node, "closure")
-         && PAST::Pattern::check_attribute($pattern, $node, "control")
-         && PAST::Pattern::check_attribute($pattern, $node, "loadinit")
-         && PAST::Pattern::check_attribute($pattern, $node, "namespace")
-         && PAST::Pattern::check_attribute($pattern, $node, "multi")
-         && PAST::Pattern::check_attribute($pattern, $node, "hll")
-         && PAST::Pattern::check_attribute($pattern, $node, "nsentry")
-         && PAST::Pattern::check_attribute($pattern, $node, "symtable")
-         && PAST::Pattern::check_attribute($pattern, $node, "lexical")
-         && PAST::Pattern::check_attribute($pattern, $node, "compiler")
-         && PAST::Pattern::check_attribute($pattern, $node, 
-                                           "compiler_args")
-         && PAST::Pattern::check_attribute($pattern, $node, "subid")
-         && PAST::Pattern::check_attribute($pattern, $node, "pirflags"));
-    }
-    
-    method ACCEPTSEXACTLY ($node) {
-        ($node ~~ PAST::Block
-         && PAST::Pattern::check_children(self, $node)
-         && PAST::Pattern::check_node_attributes(self, $node)
-         && check_block_attributes(self, $node));
-    }
-}
-
-
-class PAST::Pattern::Op is PAST::Pattern {
-    method pasttype ($val?) {
-        self.attr("pasttype", $val, !pir::isnull__iP($val));
-    }
-
-    method pirop ($val?) {
-        self.attr("pirop", $val, !pir::isnull__iP($val));
-    }
-
-    method inline ($val?) {
-        self.attr("inline", $val, !pir::isnull__iP($val));
-    }
-
-    sub check_op_attributes ($pattern, $node) {
-        (PAST::Pattern::check_attribute($pattern, $node, "pasttype")
-         && PAST::Pattern::check_attribute($pattern, $node, "pirop")
-         && PAST::Pattern::check_attribute($pattern, $node, "inline"));          
-    }
-
-    method ACCEPTSEXACTLY ($node) {
-        (($node ~~ PAST::Op)
-         && PAST::Pattern::check_children(self, $node)
-         && PAST::Pattern::check_node_attributes(self, $node)
-         && check_op_attributes(self, $node));
-    }
-}
-
-class PAST::Pattern::Stmts is PAST::Pattern {
-    method ACCEPTSEXACTLY ($node) {
-        ($node ~~ PAST::Stmts
-         && PAST::Pattern::check_children(self, $node)
-         && PAST::Pattern::check_node_attributes(self, $node));
-    }
-}
-
-class PAST::Pattern::Val is PAST::Pattern {
-    method value ($val?) {
-        self.attr("value", $val, !pir::isnull__iP($val));
-    }
-
-    method ACCEPTSEXACTLY ($node) {
-        ($node ~~ PAST::Val
-         && PAST::Pattern::check_children(self, $node)
-         && PAST::Pattern::check_node_attributes(self, $node)
-         && PAST::Pattern::check_attribute(self, $node, "value"));
-    }
-}
-
-class PAST::Pattern::Var is PAST::Pattern {
-    method scope ($val?) {
-        self.attr("scope", $val, !pir::isnull__iP($val));
-    }
-
-    method isdecl ($val?) {
-        self.attr("isdecl", $val, !pir::isnull__iP($val));
-    }
-
-    method namespace ($val?) {
-        self.attr("namespace", $val, !pir::isnull__iP($val));
-    }
-
-    method slurpy ($val?) {
-        self.attr("slurpy", $val, !pir::isnull__iP($val));
-    }
-
-    method call_sig ($val?) {
-        self.attr("call_sig", $val, !pir::isnull__iP($val));
-    }
-
-    method viviself ($val?) {
-        self.attr("viviself", $val, !pir::isnull__iP($val));
-    }
-
-    method vivibase ($val?) {
-        self.attr("vivibase", $val, !pir::isnull__iP($val));
-    }
-
-    method multitype ($val?) {
-        self.attr("multitype", $val, !pir::isnull__iP($val));
-    }
-
-    method ACCEPTSEXACTLY ($node) {
-        ($node ~~ PAST::Var
-         && PAST::Pattern::check_children(self, $node)
-         && PAST::Pattern::check_node_attributes(self, $node)
-         && PAST::Pattern::check_attribute(self, $node, "scope")
-         && PAST::Pattern::check_attribute(self, $node, "isdecl")
-         && PAST::Pattern::check_attribute(self, $node, "namespace")
-         && PAST::Pattern::check_attribute(self, $node, "slurpy")
-         && PAST::Pattern::check_attribute(self, $node, "call_sig")
-         && PAST::Pattern::check_attribute(self, $node, "viviself")
-         && PAST::Pattern::check_attribute(self, $node, "vivibase")
-         && PAST::Pattern::check_attribute(self, $node, "multitype"));
-    }
-}
-
-class PAST::Pattern::VarList is PAST::Pattern {
-    method ACCEPTSEXACTLY ($node) {
-        my $result := ($node ~~ PAST::VarList
-         && PAST::Pattern::check_children(self, $node)
-         && PAST::Pattern::check_node_attributes(self, $node));
-        $result;
-    }
+INIT {
+    pir::load_bytecode('PAST/Pattern/Closure.pbc');
+    pir::load_bytecode('PAST/Pattern/Constant.pbc');
+    pir::load_bytecode('PAST/Pattern/Node.pbc');
 }
 
 # Local Variables:

Added: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp	Sat Jun  5 22:26:27 2010	(r47395)
@@ -0,0 +1,31 @@
+#!./parrot-nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+class PAST::Pattern::Closure is PAST::Pattern {
+
+    method new (&code) {
+        my $self := Q:PIR {
+            $P0 = self.'HOW'()
+            $P0 = getattribute $P0, 'parrotclass'
+            %r = new $P0
+        };
+        $self.code(&code);
+        $self;
+    }
+
+    method code (&code?) {
+        self.attr("code", &code, pir::defined__IP(&code));
+    }
+
+    method ACCEPTS ($node) {
+        self.code()($node);
+    }
+}
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Added: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp	Sat Jun  5 22:26:27 2010	(r47395)
@@ -0,0 +1,30 @@
+#!./parrot-nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+class PAST::Pattern::Constant is PAST::Pattern {
+    method new ($value) {
+        my $self := Q:PIR {
+            $P0 = self.'HOW'()
+            $P0 = getattribute $P0, 'parrotclass'
+            %r = new $P0
+        };
+        $self.value($value);
+        $self;
+    }
+
+    method value ($value?) {
+        self.attr("value", $value, pir::defined__IP($value));
+    }
+
+    method ACCEPTS ($node) {
+        pir::iseq__IPP(self.value(), $node);
+    }
+}
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Added: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp	Sat Jun  5 22:26:27 2010	(r47395)
@@ -0,0 +1,322 @@
+#!./parrot-nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+class PAST::Pattern::Node is PAST::Pattern {
+    method attr ($name, $value, $has_value) {
+        my $result;
+        if ($has_value) {
+            self{$name} := PAST::Pattern::patternize($value);
+        } else {
+            $result := self{$name};
+        }
+        $result;
+    }
+
+    method name ($val?) {
+        self.attr("name", $val, !pir::isnull__iP($val));
+    }
+
+    method source ($val?) {
+        self.attr("source", $val, !pir::isnull__iP($val));
+    }
+
+    method pos ($val?) {
+        self.attr("pos", $val, !pir::isnull__iP($val));
+    }
+
+    method returns ($val?) {
+        self.attr("returns", $val, !pir::isnull__iP($val));
+    }
+
+    method arity ($val?) {
+        self.attr("arity", $val, !pir::isnull__iP($val));
+    }
+
+    method named ($val?) {
+        self.attr("named", $val, !pir::isnull__iP($val));
+    }
+
+    method flat ($val?) {
+        self.attr("flat", $val, !pir::isnull__iP($val));
+    }
+
+    method lvalue ($val?) {
+        self.attr("lvalue", $val, !pir::isnull__iP($val));
+    }    
+
+    method new (*@children, *%attrs) {
+        my $result := Q:PIR {
+            $P0 = self.'HOW'()
+            $P0 = getattribute $P0, 'parrotclass'
+            %r = new $P0
+        };
+
+        for %attrs {
+            $result.attr($_, %attrs{$_}, 1);
+        }
+        for @children {
+            pir::push($result, PAST::Pattern::patternize($_));
+        }
+        $result;
+    }
+    
+    sub check ($patt, $val) {
+        my $result := 1;
+        if (pir::defined__IP($patt)) {
+            if (!pir::defined__IP($val)) {
+                $result := 0;
+            }
+            else {
+                $result := ($val ~~ $patt);
+            }
+        }
+        $result;
+    }
+
+
+    sub check_attribute ($pattern, $node, $attribute) {
+        check($pattern.attr($attribute, null, 0),
+              $node.attr($attribute, null, 0));
+    }
+
+    sub check_children ($pattern, $node) {
+        my $pLen := pir::elements($pattern);
+        my $nLen := pir::elements($node);
+        my $result;
+        my $index;
+        if ($pLen == $nLen) {
+            $index := 0;
+            while ($index < $pLen) {
+                unless (check($pattern[$index], $node[$index])) {
+                    return 0;
+                }
+                $index++;
+            }
+            $result := 1;
+        } else {
+            $result := 0;
+        }
+        $result;
+    }
+
+    sub check_node_attributes ($pattern, $node) {
+        (check_attribute($pattern, $node, "name")
+         && check_attribute($pattern, $node, "source")
+         && check_attribute($pattern, $node, "pos")
+         && check_attribute($pattern, $node, "returns")
+         && check_attribute($pattern, $node, "arity")
+         && check_attribute($pattern, $node, "named")
+         && check_attribute($pattern, $node, "flat")
+         && check_attribute($pattern, $node, "lvalue"));
+    }
+
+    method ACCEPTS ($node) {
+        my $result := self.ACCEPTSEXACTLY($node);
+        if (!$result && $node ~~ PAST::Node) {
+            my $index := 0;
+            my $max := pir::elements__IP($node);
+            until ($result || $index == $max) {
+                $result := $node[$index] ~~ self;
+                $index++;
+            }
+        }
+        $result;
+    }
+}
+
+class PAST::Pattern::Block is PAST::Pattern::Node {
+    method blocktype ($val?) {
+        self.attr("blocktype", $val, !pir::isnull__iP($val));
+    }
+
+    method closure ($val?) {
+        self.attr("closure", $val, !pir::isnull__iP($val));
+    }
+
+    method control ($val?) {
+        self.attr("control", $val, !pir::isnull__iP($val));
+    }
+
+    method loadinit ($val?) {
+        self.attr("loadinit", $val, !pir::isnull__iP($val));
+    }
+
+    method namespace ($val?) {
+        self.attr("namespace", $val, !pir::isnull__iP($val));
+    }
+
+    method multi ($val?) {
+        self.attr("multi", $val, !pir::isnull__iP($val));
+    }
+
+    method hll ($val?) {
+        self.attr("hll", $val, !pir::isnull__iP($val));
+    }
+
+    method nsentry ($val?) {
+        self.attr("nsentry", $val, !pir::isnull__iP($val));
+    }
+
+    method symtable ($val?) {
+        self.attr("symtable", $val, !pir::isnull__iP($val));
+    }
+
+    method lexical ($val?) {
+        self.attr("lexical", $val, !pir::isnull__iP($val));
+    }
+
+    method compiler ($val?) {
+        self.attr("compiler", $val, !pir::isnull__iP($val));
+    }
+
+    method compiler_args ($val?) {
+        self.attr("compiler_args", $val, !pir::isnull__iP($val));
+    }
+
+    method subid ($val?) {
+        self.attr("subid", $val, !pir::isnull__iP($val));
+    }
+
+    method pirflags ($val?) {
+        self.attr("pirflags", $val, !pir::isnull__iP($val));
+    }
+
+    sub check_block_attributes($pattern, $node) {
+        (PAST::Pattern::Node::check_attribute($pattern, $node, "blocktype")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "closure")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "control")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "loadinit")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "namespace")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "multi")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "hll")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "nsentry")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "symtable")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "lexical")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "compiler")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, 
+                                           "compiler_args")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "subid")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "pirflags"));
+    }
+    
+    method ACCEPTSEXACTLY ($node) {
+        ($node ~~ PAST::Block
+         && PAST::Pattern::Node::check_children(self, $node)
+         && PAST::Pattern::Node::check_node_attributes(self, $node)
+         && check_block_attributes(self, $node));
+    }
+}
+
+
+class PAST::Pattern::Op is PAST::Pattern::Node {
+    method pasttype ($val?) {
+        self.attr("pasttype", $val, !pir::isnull__iP($val));
+    }
+
+    method pirop ($val?) {
+        self.attr("pirop", $val, !pir::isnull__iP($val));
+    }
+
+    method inline ($val?) {
+        self.attr("inline", $val, !pir::isnull__iP($val));
+    }
+
+    sub check_op_attributes ($pattern, $node) {
+        (PAST::Pattern::Node::check_attribute($pattern, $node, "pasttype")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "pirop")
+         && PAST::Pattern::Node::check_attribute($pattern, $node, "inline"));          
+    }
+
+    method ACCEPTSEXACTLY ($node) {
+        (($node ~~ PAST::Op)
+         && PAST::Pattern::Node::check_children(self, $node)
+         && PAST::Pattern::Node::check_node_attributes(self, $node)
+         && check_op_attributes(self, $node));
+    }
+}
+
+class PAST::Pattern::Stmts is PAST::Pattern::Node {
+    method ACCEPTSEXACTLY ($node) {
+        ($node ~~ PAST::Stmts
+         && PAST::Pattern::Node::check_children(self, $node)
+         && PAST::Pattern::Node::check_node_attributes(self, $node));
+    }
+}
+
+class PAST::Pattern::Val is PAST::Pattern::Node {
+    method value ($val?) {
+        self.attr("value", $val, !pir::isnull__iP($val));
+    }
+
+    method ACCEPTSEXACTLY ($node) {
+        ($node ~~ PAST::Val
+         && PAST::Pattern::Node::check_children(self, $node)
+         && PAST::Pattern::Node::check_node_attributes(self, $node)
+         && PAST::Pattern::Node::check_attribute(self, $node, "value"));
+    }
+}
+
+class PAST::Pattern::Var is PAST::Pattern::Node {
+    method scope ($val?) {
+        self.attr("scope", $val, !pir::isnull__iP($val));
+    }
+
+    method isdecl ($val?) {
+        self.attr("isdecl", $val, !pir::isnull__iP($val));
+    }
+
+    method namespace ($val?) {
+        self.attr("namespace", $val, !pir::isnull__iP($val));
+    }
+
+    method slurpy ($val?) {
+        self.attr("slurpy", $val, !pir::isnull__iP($val));
+    }
+
+    method call_sig ($val?) {
+        self.attr("call_sig", $val, !pir::isnull__iP($val));
+    }
+
+    method viviself ($val?) {
+        self.attr("viviself", $val, !pir::isnull__iP($val));
+    }
+
+    method vivibase ($val?) {
+        self.attr("vivibase", $val, !pir::isnull__iP($val));
+    }
+
+    method multitype ($val?) {
+        self.attr("multitype", $val, !pir::isnull__iP($val));
+    }
+
+    method ACCEPTSEXACTLY ($node) {
+        ($node ~~ PAST::Var
+         && PAST::Pattern::Node::check_children(self, $node)
+         && PAST::Pattern::Node::check_node_attributes(self, $node)
+         && PAST::Pattern::Node::check_attribute(self, $node, "scope")
+         && PAST::Pattern::Node::check_attribute(self, $node, "isdecl")
+         && PAST::Pattern::Node::check_attribute(self, $node, "namespace")
+         && PAST::Pattern::Node::check_attribute(self, $node, "slurpy")
+         && PAST::Pattern::Node::check_attribute(self, $node, "call_sig")
+         && PAST::Pattern::Node::check_attribute(self, $node, "viviself")
+         && PAST::Pattern::Node::check_attribute(self, $node, "vivibase")
+         && PAST::Pattern::Node::check_attribute(self, $node, "multitype"));
+    }
+}
+
+class PAST::Pattern::VarList is PAST::Pattern::Node {
+    method ACCEPTSEXACTLY ($node) {
+        my $result := ($node ~~ PAST::VarList
+         && PAST::Pattern::Node::check_children(self, $node)
+         && PAST::Pattern::Node::check_node_attributes(self, $node));
+        $result;
+    }
+}
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Modified: branches/gsoc_past_optimization/t/library/pastpattern.t
==============================================================================
--- branches/gsoc_past_optimization/t/library/pastpattern.t	Sat Jun  5 22:26:26 2010	(r47394)
+++ branches/gsoc_past_optimization/t/library/pastpattern.t	Sat Jun  5 22:26:27 2010	(r47395)
@@ -16,8 +16,10 @@
 test_deep_matching_in_children();
 
 sub node_with_attr_set ($class, $attr, $val) {
+    say("Node of type $class with $attr set to $val made.");
     my $node := $class.new();
-    if ($attr eq "source" || $attr eq "pos") {
+    if (($attr eq "source" || $attr eq "pos")
+        && pir::isa__IPP($class, PAST::Node)) {
         $node{$attr} := $val;
     }
     else {


More information about the parrot-commits mailing list