[svn:parrot] r47772 - in branches/gsoc_past_optimization: . config/gen/makefiles runtime/parrot/library/PAST runtime/parrot/library/PAST/Pattern runtime/parrot/library/Tree runtime/parrot/library/Tree/Pattern t/library
tcurtis at svn.parrot.org
tcurtis at svn.parrot.org
Wed Jun 23 03:01:55 UTC 2010
Author: tcurtis
Date: Wed Jun 23 03:01:54 2010
New Revision: 47772
URL: https://trac.parrot.org/parrot/changeset/47772
Log:
Refactored ACCEPTS and ACCEPTSGLOBALLY logic from PAST::Pattern to Tree::Pattern.
Added:
branches/gsoc_past_optimization/runtime/parrot/library/Tree/ (props changed)
branches/gsoc_past_optimization/runtime/parrot/library/Tree/Pattern/ (props changed)
branches/gsoc_past_optimization/runtime/parrot/library/Tree/Pattern.nqp
branches/gsoc_past_optimization/runtime/parrot/library/Tree/Pattern/Match.nqp
Deleted:
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Match.nqp
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/runtime/parrot/library/PAST/Pattern/Any.nqp
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp
branches/gsoc_past_optimization/t/library/pastpattern.t
Modified: branches/gsoc_past_optimization/MANIFEST
==============================================================================
--- branches/gsoc_past_optimization/MANIFEST Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/MANIFEST Wed Jun 23 03:01:54 2010 (r47772)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 23 00:09:53 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 23 01:55:58 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1178,7 +1178,6 @@
runtime/parrot/library/PAST/Pattern/Any.nqp [library]
runtime/parrot/library/PAST/Pattern/Closure.nqp [library]
runtime/parrot/library/PAST/Pattern/Constant.nqp [library]
-runtime/parrot/library/PAST/Pattern/Match.nqp [library]
runtime/parrot/library/PAST/Pattern/Node.nqp [library]
runtime/parrot/library/PAST/Pattern/Transformer.nqp [library]
runtime/parrot/library/PAST/Transformer.pir [library]
@@ -1239,6 +1238,8 @@
runtime/parrot/library/Test/Builder/Tester.pir [library]
runtime/parrot/library/Test/Class.pir [library]
runtime/parrot/library/Test/More.pir [library]
+runtime/parrot/library/Tree/Pattern.nqp [library]
+runtime/parrot/library/Tree/Pattern/Match.nqp [library]
runtime/parrot/library/URI.pir [library]
runtime/parrot/library/URI/Escape.pir [library]
runtime/parrot/library/YAML/Dumper.pir [library]
Modified: branches/gsoc_past_optimization/MANIFEST.SKIP
==============================================================================
--- branches/gsoc_past_optimization/MANIFEST.SKIP Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/MANIFEST.SKIP Wed Jun 23 03:01:54 2010 (r47772)
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 23 00:09:53 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 23 01:55:58 2010 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
@@ -648,6 +648,16 @@
# generated from svn:ignore of 'runtime/parrot/library/Test/Builder/'
^runtime/parrot/library/Test/Builder/.*\.pbc$
^runtime/parrot/library/Test/Builder/.*\.pbc/
+# generated from svn:ignore of 'runtime/parrot/library/Tree/'
+^runtime/parrot/library/Tree/.*\.pbc$
+^runtime/parrot/library/Tree/.*\.pbc/
+^runtime/parrot/library/Tree/Tree\.pir$
+^runtime/parrot/library/Tree/Tree\.pir/
+# generated from svn:ignore of 'runtime/parrot/library/Tree/Pattern/'
+^runtime/parrot/library/Tree/Pattern/.*\.pbc$
+^runtime/parrot/library/Tree/Pattern/.*\.pbc/
+^runtime/parrot/library/Tree/Pattern/Match\.pir$
+^runtime/parrot/library/Tree/Pattern/Match\.pir/
# generated from svn:ignore of 'runtime/parrot/library/URI/'
^runtime/parrot/library/URI/.*\.pbc$
^runtime/parrot/library/URI/.*\.pbc/
Modified: branches/gsoc_past_optimization/config/gen/makefiles/root.in
==============================================================================
--- branches/gsoc_past_optimization/config/gen/makefiles/root.in Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/config/gen/makefiles/root.in Wed Jun 23 03:01:54 2010 (r47772)
@@ -281,12 +281,17 @@
$(LIBRARY_DIR)/osutils.pbc \
$(LIBRARY_DIR)/P6object.pbc \
$(LIBRARY_DIR)/PAST/Pattern.pbc \
+ $(LIBRARY_DIR)/PAST/Pattern.pir \
$(LIBRARY_DIR)/PAST/Pattern/Any.pbc \
+ $(LIBRARY_DIR)/PAST/Pattern/Any.pir \
$(LIBRARY_DIR)/PAST/Pattern/Closure.pbc \
+ $(LIBRARY_DIR)/PAST/Pattern/Closure.pir \
$(LIBRARY_DIR)/PAST/Pattern/Constant.pbc \
- $(LIBRARY_DIR)/PAST/Pattern/Match.pbc \
+ $(LIBRARY_DIR)/PAST/Pattern/Constant.pir \
$(LIBRARY_DIR)/PAST/Pattern/Node.pbc \
+ $(LIBRARY_DIR)/PAST/Pattern/Node.pir \
$(LIBRARY_DIR)/PAST/Pattern/Transformer.pbc \
+ $(LIBRARY_DIR)/PAST/Pattern/Transformer.pir \
$(LIBRARY_DIR)/PAST/Transformer.pbc \
$(LIBRARY_DIR)/PAST/Transformer/Dynamic.pbc \
$(LIBRARY_DIR)/PAST/Walker.pbc \
@@ -330,6 +335,10 @@
$(LIBRARY_DIR)/Test/More.pbc \
$(LIBRARY_DIR)/Tcl/Glob.pbc \
$(LIBRARY_DIR)/TclLibrary.pbc \
+ $(LIBRARY_DIR)/Tree/Pattern.pbc \
+ $(LIBRARY_DIR)/Tree/Pattern.pir \
+ $(LIBRARY_DIR)/Tree/Pattern/Match.pbc \
+ $(LIBRARY_DIR)/Tree/Pattern/Match.pir \
$(LIBRARY_DIR)/URI.pbc \
$(LIBRARY_DIR)/URI/Escape.pbc \
$(LIBRARY_DIR)/uuid.pbc \
@@ -1121,15 +1130,6 @@
$(NQP_RX) --target=pir $(LIBRARY_DIR)/PAST/Pattern/Closure.nqp\
> $@
-$(LIBRARY_DIR)/PAST/Pattern/Match.pbc: \
- $(LIBRARY_DIR)/PAST/Pattern/Match.pir
- $(PARROT) -o $@ $(LIBRARY_DIR)/PAST/Pattern/Match.pir
-
-$(LIBRARY_DIR)/PAST/Pattern/Match.pir: \
- $(LIBRARY_DIR)/PAST/Pattern/Match.nqp $(NQP_RX)
- $(NQP_RX) --target=pir $(LIBRARY_DIR)/PAST/Pattern/Match.nqp \
- > $@
-
$(LIBRARY_DIR)/PAST/Pattern/Node.pbc: \
$(LIBRARY_DIR)/PAST/Pattern/Node.pir
$(PARROT) -o $@ $(LIBRARY_DIR)/PAST/Pattern/Node.pir
@@ -1187,7 +1187,23 @@
$(LIBRARY_DIR)/ProfTest/Matcher.pir: $(LIBRARY_DIR)/ProfTest/Matcher.nqp $(NQP_RX)
$(NQP_RX) --target=pir $(LIBRARY_DIR)/ProfTest/Matcher.nqp > $@
+$(LIBRARY_DIR)/Tree/Pattern.pbc: \
+ $(LIBRARY_DIR)/Tree/Pattern.pir
+ $(PARROT) -o $@ $(LIBRARY_DIR)/Tree/Pattern.pir
+
+$(LIBRARY_DIR)/Tree/Pattern.pir: \
+ $(LIBRARY_DIR)/Tree/Pattern.nqp $(NQP_RX)
+ $(NQP_RX) --target=pir $(LIBRARY_DIR)/Tree/Pattern.nqp \
+ > $@
+$(LIBRARY_DIR)/Tree/Pattern/Match.pbc: \
+ $(LIBRARY_DIR)/Tree/Pattern/Match.pir
+ $(PARROT) -o $@ $(LIBRARY_DIR)/Tree/Pattern/Match.pir
+
+$(LIBRARY_DIR)/Tree/Pattern/Match.pir: \
+ $(LIBRARY_DIR)/Tree/Pattern/Match.nqp $(NQP_RX)
+ $(NQP_RX) --target=pir $(LIBRARY_DIR)/Tree/Pattern/Match.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 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp Wed Jun 23 03:01:54 2010 (r47772)
@@ -3,10 +3,11 @@
# $Id$
INIT {
+ pir::load_bytecode('Tree/Pattern.pbc');
pir::load_bytecode('PAST/Transformer.pbc');
}
-class PAST::Pattern is Capture {
+class PAST::Pattern is Tree::Pattern {
sub patternize ($value) {
unless (pir::can__IPS($value, 'ACCEPTS')) {
if (pir::isa__IPP($value, Sub)) {
@@ -41,63 +42,6 @@
PAST::Pattern::Transformer.new(self, &transSub);
$transformer.walk($past);
}
-
- method ACCEPTS ($node, *%opts) {
- my $global := ?%opts<g> || ?%opts<global>;
- my $pos := %opts<p> || %opts<pos>;
- pir::die("ACCEPTS cannot take both :global and :pos modifiers.")
- if $global && $pos;
- return self.ACCEPTSGLOBALLY($node) if $global;
- return self.ACCEPTSEXACTLY($pos) if $pos;
- my $/ := self.ACCEPTSEXACTLY($node);
- if (!$/ && ($node ~~ PAST::Node)) {
- my $index := 0;
- my $max := pir::elements__IP($node);
- until ($index == $max) {
- $/ := $node[$index] ~~ self;
- return $/ if $/;
- $index++;
- }
- $/ := PAST::Pattern::Match.new(0);
- }
- $/;
- }
-
- method ACCEPTSGLOBALLY ($node) {
- my $/;
- my $first := self.ACCEPTSEXACTLY($node);
- if ($node ~~ PAST::Node) {
- my $matches := ?$first;
- my $index := 0;
- my $max := pir::elements__IP($node);
- my $submatch;
- $/ := PAST::Pattern::Match.new(?$first);
- $/[0] := $first if $first;
- until ($index == $max) {
- $submatch := self.ACCEPTS($node[$index], :g);
- if ($submatch) {
- $/.success(1) unless $matches;
- if pir::defined__iP($submatch.from()) {
- $/[$matches++] := $submatch;
- }
- else { # The submatch is a list of multiple matches.
- my $subIndex := 0;
- my $subMax := pir::elements__IP($submatch);
- until ($subIndex == $subMax) {
- $/[$matches++] := $submatch[$subIndex];
- $subIndex++;
- }
- }
- }
- $index++;
- }
- $/ := $/[0] if $matches == 1;
- }
- else {
- $/ := $first;
- }
- $/;
- }
}
module PAST::Node {
@@ -111,8 +55,6 @@
}
INIT {
- pir::load_bytecode('PAST/Pattern/Match.pbc');
-
pir::load_bytecode('PAST/Pattern/Closure.pbc');
pir::load_bytecode('PAST/Pattern/Constant.pbc');
pir::load_bytecode('PAST/Pattern/Node.pbc');
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Any.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Any.nqp Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Any.nqp Wed Jun 23 03:01:54 2010 (r47772)
@@ -26,7 +26,7 @@
}
$index++;
}
- PAST::Pattern::Match.new(0);
+ Tree::Pattern::Match.new(0);
}
}
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp Wed Jun 23 03:01:54 2010 (r47772)
@@ -19,7 +19,7 @@
}
method ACCEPTSEXACTLY ($node) {
- PAST::Pattern::Match.new(self.code()($node),
+ Tree::Pattern::Match.new(self.code()($node),
$node);
}
}
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp Wed Jun 23 03:01:54 2010 (r47772)
@@ -18,7 +18,7 @@
}
method ACCEPTSEXACTLY ($node) {
- PAST::Pattern::Match.new(pir::iseq__IPP(self.value(), $node),
+ Tree::Pattern::Match.new(pir::iseq__IPP(self.value(), $node),
$node);
}
}
Deleted: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Match.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Match.nqp Wed Jun 23 03:01:54 2010 (r47771)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,71 +0,0 @@
-#!./parrot-nqp
-# Copyright (C) 2010, Parrot Foundation.
-# $Id$
-
-class PAST::Pattern::Match is Capture {
- has $!success;
- has $!ast;
- has $!from;
-
- method new ($success?, $from?) {
- my $self := Q:PIR {
- $P0 = self.'HOW'()
- $P0 = getattribute $P0, 'parrotclass'
- %r = new $P0
- };
- $self.success($success);
- $self.from($from);
- $self;
- }
-
- method Bool () {
- ?self;
- }
-
- method ast () {
- pir::getattribute__PPS(self, '$!ast');
- }
-
- method from ($from?) {
- my $result;
- if pir::defined__IP($from) {
- pir::setattribute(self, ~'$!from', $from);
- } else {
- $result := pir::getattribute__PPS(self, '$!from');
- }
- $result;
- }
-
- method success ($success?) {
- my $result;
- if pir::defined__IP($success) {
- pir::setattribute(self, ~'$!success', $success);
- }
- else {
- $result := pir::getattribute__PPS(self, '$!success');
- }
- $result;
- }
-}
-
-INIT {
- my $pc :=
- pir::getattribute__PPS(PAST::Pattern::Match.HOW(), "parrotclass");
- $pc.add_vtable_override("get_bool",
- method () {
- ?pir::getattribute__PPS(self,
- '$!success');
- });
-
- $pc.add_method("!make",
- method ($ast) {
- pir::setattribute(self, ~'$!ast', $ast);
- });
-}
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp Wed Jun 23 03:01:54 2010 (r47772)
@@ -190,8 +190,8 @@
}
method ACCEPTSEXACTLY ($node) {
- return PAST::Pattern::Match.new(0) unless $node ~~ PAST::Block;
- my $/ := PAST::Pattern::Match.new(1);
+ return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Block;
+ my $/ := Tree::Pattern::Match.new(1);
(PAST::Pattern::Node::check_attribute(self, $node,
"blocktype", $/)
&& PAST::Pattern::Node::check_attribute(self, $node,
@@ -243,8 +243,8 @@
method ACCEPTSEXACTLY ($node) {
- return PAST::Pattern::Match.new(0) unless $node ~~ PAST::Op;
- my $/ := PAST::Pattern::Match.new(1);
+ return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Op;
+ my $/ := Tree::Pattern::Match.new(1);
(PAST::Pattern::Node::check_attribute(self, $node,
"pasttype", $/)
&& PAST::Pattern::Node::check_attribute(self, $node,
@@ -260,8 +260,8 @@
class PAST::Pattern::Stmts is PAST::Pattern::Node {
method ACCEPTSEXACTLY ($node) {
- return PAST::Pattern::Match.new(0) unless $node ~~ PAST::Stmts;
- my $/ := PAST::Pattern::Match.new(1);
+ return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Stmts;
+ my $/ := Tree::Pattern::Match.new(1);
(PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/));
$/.from($node) if $/;
@@ -275,8 +275,8 @@
}
method ACCEPTSEXACTLY ($node) {
- return PAST::Pattern::Match.new(0) unless $node ~~ PAST::Val;
- my $/ := PAST::Pattern::Match.new(1);
+ return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Val;
+ my $/ := Tree::Pattern::Match.new(1);
(PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/)
&& PAST::Pattern::Node::check_attribute(self, $node,
@@ -320,8 +320,8 @@
}
method ACCEPTSEXACTLY ($node) {
- return PAST::Pattern::Match.new(0) unless $node ~~ PAST::Var;
- my $/ := PAST::Pattern::Match.new(1);
+ return Tree::Pattern::Match.new(0) unless $node ~~ PAST::Var;
+ my $/ := Tree::Pattern::Match.new(1);
(PAST::Pattern::Node::check_attribute(self, $node,
"scope", $/)
&& PAST::Pattern::Node::check_attribute(self, $node,
@@ -347,8 +347,8 @@
class PAST::Pattern::VarList is PAST::Pattern::Node {
method ACCEPTSEXACTLY ($node) {
- return PAST::Pattern::Match.new(0) unless $node ~~ PAST::VarList;
- my $/ := PAST::Pattern::Match.new(1);
+ return Tree::Pattern::Match.new(0) unless $node ~~ PAST::VarList;
+ my $/ := Tree::Pattern::Match.new(1);
(PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/));
$/.from($node) if $/;
Added: branches/gsoc_past_optimization/runtime/parrot/library/Tree/Pattern.nqp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_past_optimization/runtime/parrot/library/Tree/Pattern.nqp Wed Jun 23 03:01:54 2010 (r47772)
@@ -0,0 +1,73 @@
+#!./parrot-nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+class Tree::Pattern is Capture {
+ method ACCEPTS ($node, *%opts) {
+ my $global := ?%opts<g> || ?%opts<global>;
+ my $pos := %opts<p> || %opts<pos>;
+ pir::die("ACCEPTS cannot take both :global and :pos modifiers.")
+ if $global && $pos;
+ return self.ACCEPTSGLOBALLY($node) if $global;
+ return self.ACCEPTSEXACTLY($pos) if $pos;
+ my $/ := self.ACCEPTSEXACTLY($node);
+ if (!$/ && pir::isa__iPP($node, Capture)) {
+ my $index := 0;
+ my $max := pir::elements__IP($node);
+ until ($index == $max) {
+ $/ := $node[$index] ~~ self;
+ return $/ if $/;
+ $index++;
+ }
+ $/ := Tree::Pattern::Match.new(0);
+ }
+ $/;
+ }
+
+ method ACCEPTSGLOBALLY ($node) {
+ my $/;
+ my $first := self.ACCEPTSEXACTLY($node);
+ if (pir::isa__iPP($node, Capture)) {
+ my $matches := ?$first;
+ my $index := 0;
+ my $max := pir::elements__IP($node);
+ my $submatch;
+ $/ := Tree::Pattern::Match.new(?$first);
+ $/[0] := $first if $first;
+ until ($index == $max) {
+ $submatch := self.ACCEPTS($node[$index], :g);
+ if ($submatch) {
+ $/.success(1) unless $matches;
+ if pir::defined__iP($submatch.from()) {
+ $/[$matches++] := $submatch;
+ }
+ else { # The submatch is a list of multiple matches.
+ my $subIndex := 0;
+ my $subMax := pir::elements__IP($submatch);
+ until ($subIndex == $subMax) {
+ $/[$matches++] := $submatch[$subIndex];
+ $subIndex++;
+ }
+ }
+ }
+ $index++;
+ }
+ $/ := $/[0] if $matches == 1;
+ }
+ else {
+ $/ := $first;
+ }
+ $/;
+ }
+}
+
+INIT {
+ pir::load_bytecode('Tree/Pattern/Match.pbc');
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Added: branches/gsoc_past_optimization/runtime/parrot/library/Tree/Pattern/Match.nqp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_past_optimization/runtime/parrot/library/Tree/Pattern/Match.nqp Wed Jun 23 03:01:54 2010 (r47772)
@@ -0,0 +1,71 @@
+#!./parrot-nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id: Match.nqp 47631 2010-06-15 00:14:01Z tcurtis $
+
+class Tree::Pattern::Match is Capture {
+ has $!success;
+ has $!ast;
+ has $!from;
+
+ method new ($success?, $from?) {
+ my $self := Q:PIR {
+ $P0 = self.'HOW'()
+ $P0 = getattribute $P0, 'parrotclass'
+ %r = new $P0
+ };
+ $self.success($success);
+ $self.from($from);
+ $self;
+ }
+
+ method Bool () {
+ ?self;
+ }
+
+ method ast () {
+ pir::getattribute__PPS(self, '$!ast');
+ }
+
+ method from ($from?) {
+ my $result;
+ if pir::defined__IP($from) {
+ pir::setattribute(self, ~'$!from', $from);
+ } else {
+ $result := pir::getattribute__PPS(self, '$!from');
+ }
+ $result;
+ }
+
+ method success ($success?) {
+ my $result;
+ if pir::defined__IP($success) {
+ pir::setattribute(self, ~'$!success', $success);
+ }
+ else {
+ $result := pir::getattribute__PPS(self, '$!success');
+ }
+ $result;
+ }
+}
+
+INIT {
+ my $pc :=
+ pir::getattribute__PPS(Tree::Pattern::Match.HOW(), "parrotclass");
+ $pc.add_vtable_override("get_bool",
+ method () {
+ ?pir::getattribute__PPS(self,
+ '$!success');
+ });
+
+ $pc.add_method("!make",
+ method ($ast) {
+ pir::setattribute(self, ~'$!ast', $ast);
+ });
+}
+
+# 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 Wed Jun 23 01:39:47 2010 (r47771)
+++ branches/gsoc_past_optimization/t/library/pastpattern.t Wed Jun 23 03:01:54 2010 (r47772)
@@ -492,7 +492,7 @@
PAST::Pattern::Var.new());
my $past := PAST::Val.new();
my $/ := $past ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
+ ok($/ ~~ Tree::Pattern::Match,
'PAST::Pattern::Any: Matching 1st option produces a match result.');
ok(?$/,
'PAST::Pattern::Any: Matching 1st option matches.');
@@ -501,7 +501,7 @@
$past := PAST::Var.new();
$/ := $past ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
+ ok($/ ~~ Tree::Pattern::Match,
'PAST::Pattern::Any: Matching 2nd option produces a match result.');
ok(?$/,
'PAST::Pattern::Any: Matching 2nd option matches.');
@@ -510,7 +510,7 @@
$past := PAST::Block.new();
$/ := $past ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
+ ok($/ ~~ Tree::Pattern::Match,
'PAST::Pattern::Any: None matching produces a match result.');
ok(!$/,
'PAST::Pattern::Any: None matching does not match.');
@@ -580,8 +580,8 @@
PAST::Block.new()));
my $/ := $pattern.ACCEPTS($past, :g(1));
- ok($/ ~~ PAST::Pattern::Match,
- '$/ is a PAST::Pattern::Match for global matches.');
+ ok($/ ~~ Tree::Pattern::Match,
+ '$/ is a Tree::Pattern::Match for global matches.');
ok(pir::elements__iP($/) == 4,
'$/ has the right number of elements for global matches.');
ok($/[0].from() =:= $past,
@@ -620,8 +620,8 @@
my $pattern := $patternClass.new();
my $node := $class.new();
my $/ := $node ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
- "$begin 1, returns a PAST::Pattern::Match");
+ ok($/ ~~ Tree::Pattern::Match,
+ "$begin 1, returns a Tree::Pattern::Match");
ok(?$/, "$begin 1, Bool conversion");
ok($/.from() =:= $node,
"$begin 1, .from");
@@ -629,8 +629,8 @@
$node := ($class =:= PAST::Block
?? PAST::Op !! PAST::Block).new();
$/ := $node ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
- "$begin 0, returns PAST::Pattern::Match");
+ ok($/ ~~ Tree::Pattern::Match,
+ "$begin 0, returns Tree::Pattern::Match");
ok(!?$/, "$begin 0, Bool conversion.");
}
}
@@ -642,8 +642,8 @@
:returns<Integer>));
my $/ := $node ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
- "Deep match result on Node 1 is a PAST::Pattern::Match.");
+ ok($/ ~~ Tree::Pattern::Match,
+ "Deep match result on Node 1 is a Tree::Pattern::Match.");
ok(?$/,
"Deep match result on Node 1 converts to boolean truth.");
ok($/.from() =:= $node[0],
@@ -659,8 +659,8 @@
my $node := PAST::Val.new(:returns('Integer'));
my $/ := $node ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
- "Match result from Closure 1 is a PAST::Pattern::Match.");
+ ok($/ ~~ Tree::Pattern::Match,
+ "Match result from Closure 1 is a Tree::Pattern::Match.");
ok(?$/,
"Match result from Closure 1 converts to boolean truth.");
ok($/.from =:= $node,
@@ -668,8 +668,8 @@
$node := PAST::Val.new(:returns('String'));
$/ := $node ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
- "Match result from Closure 0 is a PAST::Pattern::Match.");
+ ok($/ ~~ Tree::Pattern::Match,
+ "Match result from Closure 0 is a Tree::Pattern::Match.");
ok(!?$/,
"Match result from Closure 0 converts to boolean falsehood.");
}
@@ -679,8 +679,8 @@
my $node := 5;
my $/ := $node ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
- "Match result from Constant 1 is a PAST::Pattern::Match.");
+ ok($/ ~~ Tree::Pattern::Match,
+ "Match result from Constant 1 is a Tree::Pattern::Match.");
ok(?$/,
"Match result from Constant 1 converts to boolean truth.");
ok($/.from() == 5,
@@ -688,8 +688,8 @@
$node := 6;
$/ := $node ~~ $pattern;
- ok($/ ~~ PAST::Pattern::Match,
- "Match result from Constant 0 is a PAST::Pattern::Match.");
+ ok($/ ~~ Tree::Pattern::Match,
+ "Match result from Constant 0 is a Tree::Pattern::Match.");
ok(!?$/,
"Match result from Constant 0 converts to boolean falsehood.");
}
@@ -818,8 +818,8 @@
my $past := PAST::Block.new();
my $/ := $past.match($pattern);
- ok($/ ~~ PAST::Pattern::Match,
- 'PAST::Node.match returns a PAST::Pattern::Match.');
+ ok($/ ~~ Tree::Pattern::Match,
+ 'PAST::Node.match returns a Tree::Pattern::Match.');
ok(?$/,
'PAST::Node.match returns a true match result when it should.');
ok($/.from() =:= $past,
@@ -830,8 +830,8 @@
my $match1 := $past.match($pattern, :g(1));
my $match2 := $pattern.ACCEPTS($past, :g(1));
- ok($match1 ~~ PAST::Pattern::Match,
- 'PAST::Node.match returns a PAST::Pattern::Match with :g');
+ ok($match1 ~~ Tree::Pattern::Match,
+ 'PAST::Node.match returns a Tree::Pattern::Match with :g');
ok(?$match1 == ?$match2,
'PAST::Node.match with :g has same bool value as ~~.');
ok(pir::elements__iP($match1) == pir::elements__iP($match2),
@@ -840,8 +840,8 @@
$match1 := $past.match($pattern, :global(1));
$match2 := $pattern.ACCEPTS($past, :global(1));
- ok($match1 ~~ PAST::Pattern::Match,
- 'PAST::Node.match returns a PAST::Pattern::Match with :global');
+ ok($match1 ~~ Tree::Pattern::Match,
+ 'PAST::Node.match returns a Tree::Pattern::Match with :global');
ok(?$match1 == ?$match2,
'PAST::Node.match with :global has same bool value as ~~.');
ok(pir::elements__iP($match1) == pir::elements__iP($match2),
@@ -851,8 +851,8 @@
$match1 := $past.match($pattern, :p(1));
$match2 := $pattern.ACCEPTS($past, :p(1));
- ok($match1 ~~ PAST::Pattern::Match,
- 'PAST::Node.match returns a PAST::Pattern::Match with :p');
+ ok($match1 ~~ Tree::Pattern::Match,
+ 'PAST::Node.match returns a Tree::Pattern::Match with :p');
ok(?$match1 == ?$match2,
'PAST::Node.match with :p has same bool value as ~~.');
ok($match1.from() =:= $match2.from(),
@@ -861,8 +861,8 @@
$match1 := $past.match($pattern, :pos(1));
$match2 := $pattern.ACCEPTS($past, :pos(1));
- ok($match1 ~~ PAST::Pattern::Match,
- 'PAST::Node.match returns a PAST::Pattern::Match with :pos');
+ ok($match1 ~~ Tree::Pattern::Match,
+ 'PAST::Node.match returns a Tree::Pattern::Match with :pos');
ok(?$match1 == ?$match2,
'PAST::Node.match with :pos has same bool value as ~~.');
ok($match1.from() =:= $match2.from(),
More information about the parrot-commits
mailing list