[svn:parrot] r47886 - in branches/gsoc_past_optimization/runtime/parrot/library: PAST PCT
tcurtis at svn.parrot.org
tcurtis at svn.parrot.org
Sun Jun 27 02:45:14 UTC 2010
Author: tcurtis
Date: Sun Jun 27 02:45:14 2010
New Revision: 47886
URL: https://trac.parrot.org/parrot/changeset/47886
Log:
Refactor the way ACCEPTSEXACTLY works to minimize additional work in writing subclasses.
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 Sun Jun 27 00:57:41 2010 (r47885)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp Sun Jun 27 02:45:14 2010 (r47886)
@@ -27,13 +27,16 @@
self.attr("lvalue", $val, !pir::isnull__iP($val));
}
- 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", $/));
+ my @attributes := pir::clone__PP(PCT::Pattern.attributes());
+ for (<returns arity named flat lvalue>) {
+ pir::push(@attributes, $_);
+ }
+ method attributes () {
+ @attributes;
+ }
+
+ method target_class () {
+ PAST::Node;
}
}
@@ -94,27 +97,17 @@
self.attr("pirflags", $val, !pir::isnull__iP($val));
}
- method ACCEPTSEXACTLY ($node) {
- return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Block;
- my $/ := Tree::Pattern::Match.new(1);
- (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 $/;
- $/;
+ my @attributes := pir::clone__PP(PAST::Pattern.attributes());
+ for (<blocktype closure control loadinit namespace multi hll
+ subid nsentry symtable lexical compiler compiler_args pirflags>) {
+ pir::push(@attributes, $_);
+ }
+ method attributes () {
+ @attributes;
+ }
+
+ method target_class () {
+ PAST::Block;
}
}
@@ -132,29 +125,17 @@
self.attr("inline", $val, !pir::isnull__iP($val));
}
-
- method ACCEPTSEXACTLY ($node) {
- return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Op;
- my $/ := Tree::Pattern::Match.new(1);
- (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 $/;
- $/;
+ my @attributes := pir::clone__PP(PAST::Pattern.attributes());
+ for (<pasttype pirop inline>) {
+ pir::push(@attributes, $_);
}
+ method attributes () { @attributes; }
+
+ method target_class () { PAST::Op; }
}
class PAST::Pattern::Stmts is PAST::Pattern {
- method ACCEPTSEXACTLY ($node) {
- return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Stmts;
- my $/ := Tree::Pattern::Match.new(1);
- (self.check_children($node, $/)
- && self.check_past_node_attributes($node, $/));
- $/.from($node) if $/;
- $/;
- }
+ method target_class () { PAST::Stmts; }
}
class PAST::Pattern::Val is PAST::Pattern {
@@ -162,15 +143,11 @@
self.attr("value", $val, !pir::isnull__iP($val));
}
- method ACCEPTSEXACTLY ($node) {
- return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Val;
- my $/ := Tree::Pattern::Match.new(1);
- (self.check_children($node, $/)
- && self.check_past_node_attributes($node, $/)
- && self.check_attribute($node, "value", $/));
- $/.from($node) if $/;
- $/;
- }
+ my @attributes := pir::clone__PP(PAST::Pattern.attributes());
+ @attributes.pop();
+ @attributes.push('value');
+ method attributes () { @attributes; }
+ method target_class () { PAST::Val; }
}
class PAST::Pattern::Var is PAST::Pattern {
@@ -206,39 +183,27 @@
self.attr("multitype", $val, !pir::isnull__iP($val));
}
- method ACCEPTSEXACTLY ($node) {
- return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Var;
- my $/ := Tree::Pattern::Match.new(1);
- (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 $/;
- $/;
+ my @attributes := pir::clone__PP(PAST::Pattern.attributes());
+ for (<scope isdecl namespace slurpy call_sig viviself
+ vivibase multitype>) {
+ pir::push(@attributes, $_);
}
+ method attributes () { @attributes; }
+
+ method target_class () { PAST::Var; }
}
class PAST::Pattern::VarList is PAST::Pattern {
- method ACCEPTSEXACTLY ($node) {
- return Tree::Pattern::Match.new(0) unless $node ~~ PAST::VarList;
- my $/ := Tree::Pattern::Match.new(1);
- (self.check_children($node, $/)
- && self.check_past_node_attributes($node, $/));
- $/.from($node) if $/;
- $/;
- }
+ method target_class () { PAST::VarList; }
}
-INIT {
- PAST::Pattern.new_subtype('PAST::Pattern::Control',
- PAST::Control,
- :attr(<handle_types handle_types_except>));
+class PAST::Pattern::Control is PAST::Pattern {
+ my @attributes := pir::clone__PP(PAST::Pattern.attributes());
+ pir::push(@attributes, 'handle_types');
+ pir::push(@attributes, 'handle_types_except');
+ method attributes () { @attributes; }
+
+ method target_class () { PAST::Control; }
}
# Local Variables:
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PCT/Pattern.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PCT/Pattern.nqp Sun Jun 27 00:57:41 2010 (r47885)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PCT/Pattern.nqp Sun Jun 27 02:45:14 2010 (r47886)
@@ -18,43 +18,7 @@
}
class PCT::Pattern is Tree::Pattern {
- method new_subtype ($name, $targetClass, *%adverbs) {
- my $parent := %adverbs<parent> || self;
- my $class := P6metaclass.new().new_class($name, :parent($parent));
-
- my @attributes := %adverbs<attr> || [];
-
- for (@attributes) {
- $class.HOW().add_method($class, $_,
- sub ($value?) {
- self.attr($_, $value,
- pir::defined__iP($value));
- });
- }
-
- my &ACCEPTSEXACTLY := method ($node) {
- return Tree::Pattern::Match.new(0)
- unless pir::isa__iPP($node, $targetClass);
- my $/ := Tree::Pattern::Match.new(1);
- self.check_children($node, $/);
- for @attributes {
- last unless self.check_attribute($node, $_, $/);
- }
- if self ~~ PAST::Pattern {
- self.check_past_node_attributes($node, $/);
- }
- elsif self ~~ POST::Pattern {
- self.check_post_node_attributes($node, $/);
- }
- else {
- self.check_pct_node_attributes($node, $/);
- }
- $/.from($node) if $/;
- $/;
- }
- $class.HOW().add_method($class, 'ACCEPTSEXACTLY', &ACCEPTSEXACTLY);
- }
method new (*@children, *%attrs) {
my $result := Q:PIR {
@@ -149,17 +113,32 @@
$result;
}
- method check_pct_node_attributes ($node, $/) {
- (self.check_attribute($node, "name", $/)
- && self.check_attribute($node, "source", $/)
- && self.check_attribute($node, "pos", $/));
- $/;
+ method check_attributes ($node, $/) {
+ for self.attributes() {
+ last unless self.check_attribute($node, $_, $/);
+ }
+ ?$/;
}
-}
-INIT {
- pir::load_bytecode('PAST/Pattern.pbc');
- pir::load_bytecode('POST/Pattern.pbc');
+ method ACCEPTSEXACTLY ($node) {
+ if !($node ~~ self.target_class()) {
+ Tree::Pattern::Match.new(0);
+ }
+ else {
+ my $/ := Tree::Pattern::Match.new(1, $node);
+ (self.check_attributes($node, $/)
+ && self.check_children($node, $/));
+ $/;
+ }
+ }
+
+ method attributes () {
+ <name source pos>;
+ }
+
+ method target_class () {
+ PCT::Node;
+ }
}
# Local Variables:
More information about the parrot-commits
mailing list