[svn:parrot] r41619 - in branches/pct-rx: compilers/pct/src compilers/pct/src/Regex config/gen/makefiles t/compilers/pct/regex
pmichaud at svn.parrot.org
pmichaud at svn.parrot.org
Fri Oct 2 16:53:46 UTC 2009
Author: pmichaud
Date: Fri Oct 2 16:53:41 2009
New Revision: 41619
URL: https://trac.parrot.org/parrot/changeset/41619
Log:
[pct-rx]:
* Add dumper for Regex::Match
* Add Cursor.match_bind and Cursor.match_arrays for capturing submatches.
* Add <termish> and <quantified_atom> subrules for Regex::P6Regex .
Added:
branches/pct-rx/compilers/pct/src/Regex/Dumper.pir
branches/pct-rx/t/compilers/pct/regex/05-p6regex.t
Modified:
branches/pct-rx/compilers/pct/src/Regex.pir
branches/pct-rx/compilers/pct/src/Regex/Cursor.pir
branches/pct-rx/compilers/pct/src/Regex/P6Regex.pir
branches/pct-rx/config/gen/makefiles/pct.in
Modified: branches/pct-rx/compilers/pct/src/Regex.pir
==============================================================================
--- branches/pct-rx/compilers/pct/src/Regex.pir Fri Oct 2 15:52:27 2009 (r41618)
+++ branches/pct-rx/compilers/pct/src/Regex.pir Fri Oct 2 16:53:41 2009 (r41619)
@@ -17,6 +17,8 @@
.include 'src/Regex/P6Regex.pir'
+.include 'src/Regex/Dumper.pir'
+
=head1 AUTHOR
Patrick Michaud <pmichaud at pobox.com> is the author and maintainer.
Modified: branches/pct-rx/compilers/pct/src/Regex/Cursor.pir
==============================================================================
--- branches/pct-rx/compilers/pct/src/Regex/Cursor.pir Fri Oct 2 15:52:27 2009 (r41618)
+++ branches/pct-rx/compilers/pct/src/Regex/Cursor.pir Fri Oct 2 16:53:41 2009 (r41619)
@@ -40,9 +40,9 @@
.local pmc match
match = getattribute self, '$!match'
unless null match goto have_match
+
match = new ['Regex';'Match']
setattribute self, '$!match', match
-
$P0 = getattribute self, '$!target'
setattribute match, '$!target', $P0
$P0 = getattribute self, '$!from'
@@ -111,8 +111,7 @@
from = getattribute self, '$!pos'
from = clone from
setattribute cur, '$!from', from
-
- pos = box -1
+ pos = clone from
setattribute cur, '$!pos', pos
target = getattribute self, '$!target'
@@ -124,10 +123,17 @@
.end
-=item !cursor_bind(subcur, names :slurpy)
+=item !cursor_pos(pos)
+
+Set the cursor's position to C<pos>.
+
+=cut
+
+.sub '!cursor_pos' :method
+ .param pmc pos
+ setattribute self, '$!pos', pos
+.end
-Bind C<subcur>'s match object as submatches of the current cursor
-under C<names>.
=item !mark_push(rep, pos, mark)
@@ -242,6 +248,59 @@
.end
+=item !match_arrays(names :slurpy)
+
+Bind submatches C<names> of the current Match object to arrays.
+
+=cut
+
+.sub '!match_arrays' :method
+ .param pmc names :slurpy
+
+ .local pmc match, names_it
+ match = self.'MATCH'()
+ names_it = iter names
+ names_loop:
+ unless names_it goto names_done
+ $P0 = shift names_it
+ $P1 = new ['ResizablePMCArray']
+ match[$P0] = $P1
+ goto names_loop
+ names_done:
+.end
+
+
+=item !match_bind(subcur, names :slurpy)
+
+Bind C<subcur>'s match object as submatches of the current cursor
+under C<names>.
+
+=cut
+
+.sub '!match_bind' :method
+ .param pmc subcur
+ .param pmc names :slurpy
+
+ .local pmc match, submatch, names_it
+ match = self.'MATCH'()
+ submatch = subcur.'MATCH'()
+ names_it = iter names
+ names_loop:
+ unless names_it goto names_done
+ $P0 = shift names_it
+ $P1 = match[$P0]
+ if null $P1 goto bind_1
+ $I0 = isa $P1, ['ResizablePMCArray']
+ unless $I0 goto bind_1
+ push $P1, submatch
+ goto names_loop
+ bind_1:
+ match[$P0] = submatch
+ goto names_loop
+ names_done:
+.end
+
+
=item !protoregex(name)
Perform a match for protoregex C<name>.
Added: branches/pct-rx/compilers/pct/src/Regex/Dumper.pir
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pct-rx/compilers/pct/src/Regex/Dumper.pir Fri Oct 2 16:53:41 2009 (r41619)
@@ -0,0 +1,92 @@
+# Copyright (C) 2005-2009, Parrot Foundation.
+# $Id$
+
+=head1 TITLE
+
+Regex::Dumper - various methods for displaying PGE structures
+
+=head2 C<Regex::Match> Methods
+
+=over 4
+
+=item C<__dump(PMC dumper, STR label)>
+
+This method enables Data::Dumper to work on Regex::Match objects.
+
+=cut
+
+.namespace ['Regex';'Match']
+
+.sub "__dump" :method
+ .param pmc dumper
+ .param string label
+ .local string indent, subindent
+ .local pmc it, val
+ .local string key
+ .local pmc hash, array
+ .local int hascapts
+
+ (subindent, indent) = dumper."newIndent"()
+ print "=> "
+ $S0 = self
+ dumper."genericString"("", $S0)
+ print " @ "
+ $I0 = self.'from'()
+ print $I0
+ hascapts = 0
+ hash = self.'hash'()
+ if_null hash, dump_array
+ it = iter hash
+ dump_hash_1:
+ unless it goto dump_array
+ if hascapts goto dump_hash_2
+ print " {"
+ hascapts = 1
+ dump_hash_2:
+ print "\n"
+ print subindent
+ key = shift it
+ val = hash[key]
+ print "<"
+ print key
+ print "> => "
+ dumper."dump"(label, val)
+ goto dump_hash_1
+ dump_array:
+ array = self.'list'()
+ if_null array, dump_end
+ $I1 = elements array
+ $I0 = 0
+ dump_array_1:
+ if $I0 >= $I1 goto dump_end
+ if hascapts goto dump_array_2
+ print " {"
+ hascapts = 1
+ dump_array_2:
+ print "\n"
+ print subindent
+ val = array[$I0]
+ print "["
+ print $I0
+ print "] => "
+ dumper."dump"(label, val)
+ inc $I0
+ goto dump_array_1
+ dump_end:
+ unless hascapts goto end
+ print "\n"
+ print indent
+ print "}"
+ end:
+ dumper."deleteIndent"()
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/pct-rx/compilers/pct/src/Regex/P6Regex.pir
==============================================================================
--- branches/pct-rx/compilers/pct/src/Regex/P6Regex.pir Fri Oct 2 15:52:27 2009 (r41618)
+++ branches/pct-rx/compilers/pct/src/Regex/P6Regex.pir Fri Oct 2 16:53:41 2009 (r41619)
@@ -25,6 +25,68 @@
=over 4
+=item termish
+
+ token termish {
+ <noun=quantified_atom>+
+ }
+
+=cut
+
+.sub 'termish' :method
+ .param pmc peek :named('peek') :optional
+
+ if null peek goto peek_done
+ .return ()
+ peek_done:
+
+ .local pmc cur, noun
+ .local int pos
+ cur = self.'!cursor_start'()
+ cur.'!match_arrays'('noun')
+ noun = cur.'quantified_atom'()
+ unless noun goto fail
+ noun_quant_1:
+ pos = noun.'pos'()
+ cur.'!match_bind'(noun, 'noun')
+ cur.'!cursor_pos'(pos)
+ noun = cur.'quantified_atom'()
+ if noun goto noun_quant_1
+ cur.'!matchify'(pos, 'termish')
+ fail:
+ .return (cur)
+.end
+
+
+=item quantified_atom
+
+ token quantified_atom {
+ <atom>
+ }
+
+=cut
+
+.sub 'quantified_atom' :method
+ .param pmc peek :named('peek') :optional
+
+ if null peek goto peek_done
+ .return ()
+ peek_done:
+
+ .local pmc cur, atom
+ .local int pos
+ cur = self.'!cursor_start'()
+ atom = cur.'atom'()
+ unless atom goto fail
+ $P0 = atom.'MATCH'()
+ cur.'!match_bind'(atom, 'atom')
+ pos = atom.'pos'()
+ cur.'!matchify'(pos, 'quantified_atom')
+ fail:
+ .return (cur)
+.end
+
+
=item atom
token atom {
Modified: branches/pct-rx/config/gen/makefiles/pct.in
==============================================================================
--- branches/pct-rx/config/gen/makefiles/pct.in Fri Oct 2 15:52:27 2009 (r41618)
+++ branches/pct-rx/config/gen/makefiles/pct.in Fri Oct 2 16:53:41 2009 (r41619)
@@ -36,7 +36,8 @@
src/POST/Node.pir \
src/Regex/Cursor.pir \
src/Regex/Match.pir \
- src/Regex/P6Regex.pir
+ src/Regex/P6Regex.pir \
+ src/Regex/Dumper.pir
# the default target
all: $(PARROT_LIBRARY)/PCT.pbc
Added: branches/pct-rx/t/compilers/pct/regex/05-p6regex.t
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pct-rx/t/compilers/pct/regex/05-p6regex.t Fri Oct 2 16:53:41 2009 (r41619)
@@ -0,0 +1,45 @@
+#! parrot
+# Copyright (C) 2009, Patrick R. Michaud
+# $Id$
+
+=head1 NAME
+
+t/compilers/pct/regex/05-p6regex.t - basic p6regex tests
+
+=head1 SYNOPSIS
+
+ % prove t/compilers/pct/regex/05-p6regext.t
+
+=cut
+
+.sub 'main' :main
+ load_bytecode 'Test/More.pbc'
+
+ .local pmc exports, curr_namespace, test_namespace
+ curr_namespace = get_namespace
+ test_namespace = get_namespace ['Test';'More']
+ exports = split ' ', 'plan diag ok nok is todo'
+ test_namespace.'export_to'(curr_namespace, exports)
+
+ plan(4)
+
+ load_bytecode 'PCT/Regex.pbc'
+
+ .local pmc p6regex, cur
+ p6regex = get_hll_global ['Regex'], 'P6Regex'
+ cur = p6regex.'!cursor_init'('abcd')
+
+ .local pmc abc, match
+ abc = cur.'atom'()
+ ok(abc, 'Matched <atom> abc')
+ match = abc.'MATCH'()
+ $S0 = match
+ is($S0, 'abc', 'Matched <atom> abc')
+
+ .local pmc d
+ d = abc.'atom'()
+ ok(abc, 'Matched <atom> d')
+ match = d.'MATCH'()
+ $S0 = match
+ is($S0, 'd', 'Matched <atom> d')
+.end
More information about the parrot-commits
mailing list