[svn:parrot] r47285 - in branches/gsoc_past_optimization: runtime/parrot/library/PAST t/library
tcurtis at svn.parrot.org
tcurtis at svn.parrot.org
Wed Jun 2 07:49:24 UTC 2010
Author: tcurtis
Date: Wed Jun 2 07:49:24 2010
New Revision: 47285
URL: https://trac.parrot.org/parrot/changeset/47285
Log:
All tests pass. More attributes tomorrow(fortunately, should be easy). Also, make codetest happy.
Modified:
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp (contents, props changed)
branches/gsoc_past_optimization/t/library/pastpattern.t
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp Wed Jun 2 06:18:21 2010 (r47284)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp Wed Jun 2 07:49:24 2010 (r47285)
@@ -16,8 +16,44 @@
has $flat;
has $lvalue;
+ method new (*@children, *%attrs) {
+ my $result := Q:PIR {
+ $P0 = self.'HOW'()
+ $P0 = getattribute $P0, 'parrotclass'
+ %r = new $P0
+ };
+
+ for %attrs {
+ $result{$_} := %attrs{$_};
+ }
+ for @children {
+ pir::push($result, $_);
+ }
+ $result;
+ }
+
+ sub check_attribute ($pattern, $node, $attribute) {
+ my $pVal := $pattern{$attribute};
+ my $nVal := $node{$attribute};
+ my $result;
+ if $pVal {
+ if pir::iseq__i_p_p($pVal, $nVal) {
+ $result := ?1;
+ } else {
+ $result := ?0;
+ }
+ } else {
+ $result := ?1;
+ }
+ $result;
+ }
+
+ sub check_node_attributes ($pattern, $node) {
+ check_attribute($pattern, $node, "name");
+ }
+
method ACCEPTS ($node) {
- 0;
+ ?0;
}
}
@@ -38,35 +74,40 @@
has $pirflags;
method ACCEPTS ($node) {
- $node ~~ PAST::Block;
+ (($node ~~ PAST::Block)
+ && PAST::Pattern::check_node_attributes(self, $node));
}
}
-class PAST::Pattern::Op {
+
+class PAST::Pattern::Op is PAST::Pattern {
has $pasttype;
has $pirop;
has $inline;
method ACCEPTS ($node) {
- $node ~~ PAST::Op;
+ ($node ~~ PAST::Op
+ && PAST::Pattern::check_node_attributes(self, $node));
}
}
-class PAST::Pattern::Stmts {
+class PAST::Pattern::Stmts is PAST::Pattern {
method ACCEPTS ($node) {
- $node ~~ PAST::Stmts;
+ ($node ~~ PAST::Stmts
+ && PAST::Pattern::check_node_attributes(self, $node));
}
}
-class PAST::Pattern::Val {
+class PAST::Pattern::Val is PAST::Pattern {
has $value;
method ACCEPTS ($node) {
- $node ~~ PAST::Val;
+ ($node ~~ PAST::Val
+ && PAST::Pattern::check_node_attributes(self, $node));
}
}
-class PAST::Pattern::Var {
+class PAST::Pattern::Var is PAST::Pattern {
has $scope;
has $isdecl;
has $namespace;
@@ -77,13 +118,15 @@
has $multitype;
method ACCEPTS ($node) {
- $node ~~ PAST::Var;
+ ($node ~~ PAST::Var
+ && PAST::Pattern::check_node_attributes(self, $node));
}
}
-class PAST::Pattern::VarList {
+class PAST::Pattern::VarList is PAST::Pattern {
method ACCEPTS ($node) {
- $node ~~ PAST::VarList;
+ ($node ~~ PAST::VarList
+ && PAST::Pattern::check_node_attributes(self, $node));
}
}
Modified: branches/gsoc_past_optimization/t/library/pastpattern.t
==============================================================================
--- branches/gsoc_past_optimization/t/library/pastpattern.t Wed Jun 2 06:18:21 2010 (r47284)
+++ branches/gsoc_past_optimization/t/library/pastpattern.t Wed Jun 2 07:49:24 2010 (r47285)
@@ -104,6 +104,7 @@
"Non-matching PAST::Pattern::Block.name " ~ ($iota++) );
}
+ $right := PAST::Op.new(:name("foo"));
$pattern := PAST::Pattern::Op.new(:name("foo"));
ok($right ~~ $pattern, "Matching PAST::Pattern::Op.name.");
@@ -122,6 +123,7 @@
"Non-matching PAST::Pattern::Op.name " ~ ($iota++) );
}
+ $right := PAST::Stmts.new(:name("foo"));
$pattern := PAST::Pattern::Stmts.new(:name("foo"));
ok($right ~~ $pattern, "Matching PAST::Pattern::Stmts.name.");
@@ -139,6 +141,7 @@
"Non-matching PAST::Pattern::Stmts.name " ~ ($iota++) );
}
+ $right := PAST::Val.new(:name("foo"));
$pattern := PAST::Pattern::Val.new(:name("foo"));
ok($right ~~ $pattern, "Matching PAST::Pattern::Val.name.");
@@ -157,6 +160,7 @@
"Non-matching PAST::Pattern::Val.name " ~ ($iota++) );
}
+ $right := PAST::Var.new(:name("foo"));
$pattern := PAST::Pattern::Var.new(:name("foo"));
ok($right ~~ $pattern, "Matching PAST::Pattern::Var.name.");
@@ -175,6 +179,7 @@
"Non-matching PAST::Pattern::Var.name " ~ ($iota++) );
}
+ $right := PAST::VarList.new(:name("foo"));
$pattern := PAST::Pattern::VarList.new(:name("foo"));
ok($right ~~ $pattern, "Matching PAST::Pattern::VarList.name.");
More information about the parrot-commits
mailing list