[pct-rx]:

* Move reduction operation into Cursor.!matchify
* Hold action method object as Cursor attribute
* Create P6Regex grammar for parsing simple Perl 6 regexes
* Initial <atom> subrule for P6Regex



git-svn-id: https://svn.parrot.org/parrot/branches/pct-rx@41615 d31e2699-5ff4-0310-a27c-f18f2fbe73fe

compilers/pct/src/Regex.pir

@@ -15,6 +15,8 @@ Regex.pbc .
 
 .include 'src/Regex/Match.pir'
 
+.include 'src/Regex/P6Regex.pir'
+
 =head1 AUTHOR
 
 Patrick Michaud <pmichaud@pobox.com> is the author and maintainer.

compilers/pct/src/Regex/Cursor.pir

@@ -19,7 +19,7 @@ grammars.
     load_bytecode 'P6object.pbc'
     .local pmc p6meta
     p6meta = new 'P6metaclass'
-    $P0 = p6meta.'new_class'('Regex::Cursor', 'attr'=>'$!target $!from $!pos $!match @!bstack @!mstack')
+    $P0 = p6meta.'new_class'('Regex::Cursor', 'attr'=>'$!target $!from $!pos $!match $!action @!bstack @!mstack')
     $P0 = box 0
     set_global '$!generation', $P0
     .return ()
@@ -57,7 +57,7 @@ Return the cursor's current position.
 
 =over 4
 
-=item !cursor_init(target, pos)
+=item !cursor_init(target)
 
 Create a new cursor for matching C<target>.
 
@@ -94,7 +94,7 @@ Create and initialize a new cursor from C<self>.
     parrotclass = getattribute $P0, 'parrotclass'
     cur = new parrotclass
 
-    .local pmc from, pos, target
+    .local pmc from, pos, target, action
     from = getattribute self, '$!pos'
     from = clone from
     setattribute cur, '$!from', from
@@ -104,6 +104,8 @@ Create and initialize a new cursor from C<self>.
 
     target = getattribute self, '$!target'
     setattribute cur, '$!target', target
+    action = getattribute self, '$!action'
+    setattribute cur, '$!action', action
 
     .return (cur, from, target)
 .end
@@ -199,6 +201,8 @@ Generate a successful match at pos.
 
 .sub '!matchify' :method
     .param int pos
+    .param string name         :optional
+    .param int has_name        :opt_flag
 
     .local pmc match
     match = new ['Regex';'Match']
@@ -211,6 +215,16 @@ Generate a successful match at pos.
     setattribute match, '$!from', $P0
     $P0 = getattribute self, '$!target'
     setattribute match, '$!target', $P0
+
+    .local pmc action
+    unless has_name goto action_done
+    action = getattribute self, '$!action'
+    if null action goto action_done
+    $P0 = find_method action, name
+    if null $P0 goto action_done
+    action.$P0(match)
+  action_done:
+
     .return (match)
 .end
 

compilers/pct/src/Regex/P6Regex.pir

@@ -0,0 +1,81 @@
+# Copyright (C) 2009, Patrick R. Michaud
+# $Id$
+
+=head1 NAME
+
+Regex::P6Regex - Parser/compiler for Perl 6 regexes
+
+=head1 DESCRIPTION
+
+=cut
+
+.namespace ['Regex';'P6Regex']
+
+.include 'cclass.pasm'
+
+.sub '' :anon :load :init
+    load_bytecode 'P6object.pbc'
+    .local pmc p6meta
+    p6meta = new 'P6metaclass'
+    $P0 = p6meta.'new_class'('Regex::P6Regex', 'parent'=>'Regex::Cursor')
+    .return ()
+.end
+
+=head2 Methods
+
+=over 4
+
+=item atom
+
+    token atom {
+        :dba('regex atom')
+        [
+        | \w [\w+! <?before \w>]
+        | <metachar> ::
+        ]
+    }
+
+=cut
+
+.sub 'atom' :method
+    .param pmc peek            :named('peek') :optional
+
+    if null peek goto peek_done
+    .return ()
+  peek_done:
+
+    .local pmc cur
+    .local string target
+    .local int pos, eos
+    (cur, pos, target) = self.'!cursor_start'()
+    eos = length target
+
+    # \w [\w+! <?before \w>]
+    .local int eow, len
+    eow = find_not_cclass .CCLASS_WORD, target, pos, eos
+    if eow == pos goto metachar
+    .local int len
+    len = eow - pos
+    if len == 1 goto word_done
+    dec eow
+  word_done:
+    cur.'!matchify'(eow, 'atom')
+    .return (cur)
+
+  metachar:
+    .return (cur)
+.end
+
+=back
+
+=head1 AUTHORS
+
+Patrick Michaud <pmichaud@pobox.com> is the author and maintainer.
+
+=cut
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

config/gen/makefiles/pct.in

@@ -35,7 +35,8 @@ PCT_SOURCES := \
   src/POST/Compiler.pir \
   src/POST/Node.pir \
   src/Regex/Cursor.pir \
-  src/Regex/Match.pir
+  src/Regex/Match.pir \
+  src/Regex/P6Regex.pir
 
 # the default target
 all: $(PARROT_LIBRARY)/PCT.pbc