Add null/fail PAST::Regex nodes (as subtype of 'anchor' pasttype).

Add initial parsing and handling for internal modifiers.
perl6 · Oct 13, 2009 · 8276d6c · 8276d6c
1 parent 105b3e0
commit 8276d6c
Show file tree

Hide file tree

Showing 4 changed files with 49 additions and 1 deletion.
diff --git a/src/PAST/Compiler-Regex.pir b/src/PAST/Compiler-Regex.pir
@@ -328,6 +328,8 @@ Match various anchor points, including ^, ^^, $, $$.
 
     ops.'push_pirop'('inline', subtype, 'inline'=>'  # rxanchor %0')
 
+    if subtype == 'null' goto done
+    if subtype == 'fail' goto anchor_fail
     if subtype == 'bos' goto anchor_bos
     if subtype == 'eos' goto anchor_eos
     if subtype == 'lwb' goto anchor_lwb
@@ -343,6 +345,10 @@ Match various anchor points, including ^, ^^, $, $$.
 
     self.'panic'('Unrecognized subtype "', subtype, '" in PAST::Regex anchor node')
 
+  anchor_fail:
+    ops.'push_pirop'('goto', fail)
+    goto done
+
   anchor_bos:
     ops.'push_pirop'('ne', pos, 0, fail)
     goto done

diff --git a/src/Regex/P6Regex/Actions.pm b/src/Regex/P6Regex/Actions.pm
@@ -1,5 +1,12 @@
 class Regex::P6Regex::Actions;
 
+## this will eventually be handled using contextuals
+our @MODIFIERS := Q:PIR { 
+        %r = new ['ResizablePMCArray'] 
+        $P0 = new ['Hash']
+        push %r, $P0
+    };
+
 method TOP($/) {
     my $rpast := $<nibbler>.ast;
     my %capnames := capnames($rpast, 0);
@@ -15,7 +22,18 @@ method TOP($/) {
     make $past;
 }
 
-method nibbler($/) {
+method nibbler($/, $key?) {
+    if $key eq 'open' {
+        my %old := @MODIFIERS[0];
+        my %new := Q:PIR {
+                       $P0 = find_lex '%old'
+                       %r = clone $P0
+                   };
+        @MODIFIERS.unshift(%new);
+        return 1;
+    }
+
+    @MODIFIERS.shift;
     my $past;
     if +$<termish> > 1 {
         $past := PAST::Regex.new( :pasttype('alt') );
@@ -168,6 +186,10 @@ method metachar:sym<bs>($/) {
     make $<backslash>.ast;
 }
 
+method metachar:sym<mod>($/) {
+    make $<mod_internal>.ast;
+}
+
 method metachar:sym<assert>($/) {
     make $<assertion>.ast;
 }
@@ -391,3 +413,10 @@ sub capnames($ast, $count) {
     %capnames{''} := $count;
     %capnames;
 }
+
+method mod_internal($/) {
+    my %mods := @MODIFIERS[0];
+    %mods{ ~$<mod_ident><sym> } := 1;
+    my $past := PAST::Regex.new( :pasttype('anchor'), :subtype('null') );
+    make $past;
+}
diff --git a/src/Regex/P6Regex/Grammar.pm b/src/Regex/P6Regex/Grammar.pm
@@ -11,6 +11,7 @@ grammar Regex::P6Regex::Grammar is PCT::Grammar;
     }
 
     rule nibbler {
+        {*} #= open
         ['||'|'|'|'&&'|'&']?
         <termish> 
         [ ['||'|'|'] 
@@ -69,6 +70,7 @@ grammar Regex::P6Regex::Grammar is PCT::Grammar;
     token metachar:sym<lwb> { $<sym>=['<<'|'«'] {*} }
     token metachar:sym<rwb> { $<sym>=['>>'|'»'] {*} }
     token metachar:sym<bs> { \\ <backslash> {*} }
+    token metachar:sym<mod> { <mod_internal> {*} }
     token metachar:sym<assert> { 
         '<' <assertion> 
         [ '>' || <.panic: "regex assertion not terminated by angle bracket"> ]
@@ -135,3 +137,8 @@ grammar Regex::P6Regex::Grammar is PCT::Grammar;
         {*}
     }
 
+    token mod_internal { ':' $<n>=['!' | \d+]?  <mod_ident> » {*} }
+
+    token mod_ident:sym<ignorecase> { $<sym>=[i] 'gnorecase'? }
+    token mod_ident:sym<ratchet>    { $<sym>=[r] 'atchet'? }
+    token mod_ident:sym<sigspace>   { $<sym>=[s] 'igspace'? }
diff --git a/src/parrot/p6regex-grammar.pir b/src/parrot/p6regex-grammar.pir
@@ -24,6 +24,12 @@
     .tailcall self.'!protoregex'('assertion', 'action'=>action)
 .end
 
+.sub 'mod_ident' :method
+    .param pmc action          :named('action') :optional
+    .param pmc dba             :named('dba') :optional
+    .tailcall self.'!protoregex'('mod_ident', 'action'=>action)
+.end
+
 .sub 'obs' :method
     .param string oldstr
     .param pmc action          :named('action') :optional