[svn:parrot] r47780 - in branches/gsoc_past_optimization/runtime/parrot/library: PAST PCT
tcurtis at svn.parrot.org
tcurtis at svn.parrot.org
Wed Jun 23 08:00:36 UTC 2010
Author: tcurtis
Date: Wed Jun 23 08:00:36 2010
New Revision: 47780
URL: https://trac.parrot.org/parrot/changeset/47780
Log:
Move check_attribute, check_children into methods on PCT::Pattern. Rename check_node_attributes to
check_past_node_attributes now that PCT::Pattern exists.
Add check_pct_node_attributes.
Modified:
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp
branches/gsoc_past_optimization/runtime/parrot/library/PCT/Pattern.nqp
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp Wed Jun 23 07:39:38 2010 (r47779)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp Wed Jun 23 08:00:36 2010 (r47780)
@@ -43,70 +43,13 @@
$result;
}
- sub check_attribute ($pattern, $node, $attribute, $/) {
- my $pAttr := $pattern.attr($attribute, null, 0);
- unless pir::defined__IP($pAttr) {
- return 1;
- }
- my $nAttr := $node.attr($attribute, null, 0);
- my $result :=
- ($pAttr ~~ Tree::Pattern
- ?? $pAttr.ACCEPTS($nAttr, :p($nAttr))
- !! $nAttr ~~ $pAttr);
- if ($result) {
- $/{$attribute} := $result;
- }
- else {
- $/.success(0);
- }
- $result;
- }
-
- sub check_children ($pattern, $node, $/) {
- my $pLen := pir::elements($pattern);
- my $nLen := pir::elements($node);
- my $pChild;
- my $nChild;
- my $result;
- my $index;
- if $pLen == 0 {
- $result := 1;
- }
- elsif ($pLen == $nLen) {
- $index := 0;
- while ($index < $pLen) {
- $nChild := $node[$index];
- $pChild := $pattern[$index];
- if ($result :=
- ($pChild ~~ Tree::Pattern
- ?? $pChild.ACCEPTS($nChild, :p($nChild))
- !! $nChild ~~ $pChild)) {
- $/[$index] := $result;
- }
- else {
- $/.success(0);
- return 0;
- }
- $index++;
- }
- $result := 1;
- }
- else {
- $/.success(0);
- $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 check_past_node_attributes ($node, $/) {
+ (self.check_pct_node_attributes($node, $/)
+ && self.check_attribute($node, "returns", $/)
+ && self.check_attribute($node, "arity", $/)
+ && self.check_attribute($node, "named", $/)
+ && self.check_attribute($node, "flat", $/)
+ && self.check_attribute($node, "lvalue", $/));
}
}
@@ -170,36 +113,22 @@
method ACCEPTSEXACTLY ($node) {
return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Block;
my $/ := Tree::Pattern::Match.new(1);
- (PAST::Pattern::check_attribute(self, $node,
- "blocktype", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "closure", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "control", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "loadinit", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "namespace", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "multi", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "hll", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "nsentry", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "symtable", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "lexical", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "compiler", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "compiler_args", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "subid", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "pirflags", $/)
- && PAST::Pattern::check_children(self, $node, $/)
- && PAST::Pattern::check_node_attributes(self, $node, $/));
+ (self.check_attribute($node, "blocktype", $/)
+ && self.check_attribute($node, "closure", $/)
+ && self.check_attribute($node, "control", $/)
+ && self.check_attribute($node, "loadinit", $/)
+ && self.check_attribute($node, "namespace", $/)
+ && self.check_attribute($node, "multi", $/)
+ && self.check_attribute($node, "hll", $/)
+ && self.check_attribute($node, "nsentry", $/)
+ && self.check_attribute($node, "symtable", $/)
+ && self.check_attribute($node, "lexical", $/)
+ && self.check_attribute($node, "compiler", $/)
+ && self.check_attribute($node, "compiler_args", $/)
+ && self.check_attribute($node, "subid", $/)
+ && self.check_attribute($node, "pirflags", $/)
+ && self.check_children($node, $/)
+ && self.check_past_node_attributes($node, $/));
$/.from($node) if $/;
$/;
}
@@ -223,14 +152,11 @@
method ACCEPTSEXACTLY ($node) {
return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Op;
my $/ := Tree::Pattern::Match.new(1);
- (PAST::Pattern::check_attribute(self, $node,
- "pasttype", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "pirop", $/)
- && PAST::Pattern::check_attribute(self, $node,
- "inline", $/)
- && PAST::Pattern::check_children(self, $node, $/)
- && PAST::Pattern::check_node_attributes(self, $node, $/));
+ (self.check_attribute($node, "pasttype", $/)
+ && self.check_attribute($node, "pirop", $/)
+ && self.check_attribute($node, "inline", $/)
+ && self.check_children($node, $/)
+ && self.check_past_node_attributes($node, $/));
$/.from($node) if $/;
$/;
}
@@ -240,8 +166,8 @@
method ACCEPTSEXACTLY ($node) {
return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Stmts;
my $/ := Tree::Pattern::Match.new(1);
- (PAST::Pattern::check_children(self, $node, $/)
- && PAST::Pattern::check_node_attributes(self, $node, $/));
+ (self.check_children($node, $/)
+ && self.check_past_node_attributes($node, $/));
$/.from($node) if $/;
$/;
}
@@ -255,10 +181,9 @@
method ACCEPTSEXACTLY ($node) {
return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Val;
my $/ := Tree::Pattern::Match.new(1);
- (PAST::Pattern::check_children(self, $node, $/)
- && PAST::Pattern::check_node_attributes(self, $node, $/)
- && PAST::Pattern::check_attribute(self, $node,
- "value", $/));
+ (self.check_children($node, $/)
+ && self.check_past_node_attributes($node, $/)
+ && self.check_attribute($node, "value", $/));
$/.from($node) if $/;
$/;
}
@@ -300,24 +225,16 @@
method ACCEPTSEXACTLY ($node) {
return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Var;
my $/ := Tree::Pattern::Match.new(1);
- (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", $/)
- && PAST::Pattern::check_children(self, $node, $/)
- && PAST::Pattern::check_node_attributes(self, $node, $/));
+ (self.check_attribute($node, "scope", $/)
+ && self.check_attribute($node, "isdecl", $/)
+ && self.check_attribute($node, "namespace", $/)
+ && self.check_attribute($node, "slurpy", $/)
+ && self.check_attribute($node, "call_sig", $/)
+ && self.check_attribute($node, "viviself", $/)
+ && self.check_attribute($node, "vivibase", $/)
+ && self.check_attribute($node, "multitype", $/)
+ && self.check_children($node, $/)
+ && self.check_past_node_attributes($node, $/));
$/.from($node) if $/;
$/;
}
@@ -327,8 +244,8 @@
method ACCEPTSEXACTLY ($node) {
return Tree::Pattern::Match.new(0) unless $node ~~ PAST::VarList;
my $/ := Tree::Pattern::Match.new(1);
- (PAST::Pattern::check_children(self, $node, $/)
- && PAST::Pattern::check_node_attributes(self, $node, $/));
+ (self.check_children($node, $/)
+ && self.check_past_node_attributes($node, $/));
$/.from($node) if $/;
$/;
}
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PCT/Pattern.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PCT/Pattern.nqp Wed Jun 23 07:39:38 2010 (r47779)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PCT/Pattern.nqp Wed Jun 23 08:00:36 2010 (r47780)
@@ -39,6 +39,68 @@
method pos ($val?) {
self.attr("pos", $val, !pir::isnull__iP($val));
}
+
+ method check_attribute ($node, $attribute, $/) {
+ my $pAttr := self.attr($attribute, null, 0);
+ unless pir::defined__IP($pAttr) {
+ return 1;
+ }
+ my $nAttr := $node.attr($attribute, null, 0);
+ my $result :=
+ ($pAttr ~~ Tree::Pattern
+ ?? $pAttr.ACCEPTS($nAttr, :p($nAttr))
+ !! $nAttr ~~ $pAttr);
+ if ($result) {
+ $/{$attribute} := $result;
+ }
+ else {
+ $/.success(0);
+ }
+ $result;
+ }
+
+ method check_children ($node, $/) {
+ my $pLen := pir::elements(self);
+ my $nLen := pir::elements($node);
+ my $pChild;
+ my $nChild;
+ my $result;
+ my $index;
+ if $pLen == 0 {
+ $result := 1;
+ }
+ elsif ($pLen == $nLen) {
+ $index := 0;
+ while ($index < $pLen) {
+ $nChild := $node[$index];
+ $pChild := self[$index];
+ if ($result :=
+ ($pChild ~~ Tree::Pattern
+ ?? $pChild.ACCEPTS($nChild, :p($nChild))
+ !! $nChild ~~ $pChild)) {
+ $/[$index] := $result;
+ }
+ else {
+ $/.success(0);
+ return 0;
+ }
+ $index++;
+ }
+ $result := 1;
+ }
+ else {
+ $/.success(0);
+ $result := 0;
+ }
+ $result;
+ }
+
+ method check_pct_node_attributes ($node, $/) {
+ (self.check_attribute($node, "name", $/)
+ && self.check_attribute($node, "source", $/)
+ && self.check_attribute($node, "pos", $/));
+
+ }
}
# Local Variables:
More information about the parrot-commits
mailing list