Add goal-matching syntax to P6Regex.

perl6 · Oct 21, 2009 · 4ed10a8 · 4ed10a8
1 parent a4bfb16
commit 4ed10a8
Show file tree

Hide file tree

Showing 5 changed files with 39 additions and 3 deletions.
diff --git a/src/Regex/Cursor-builtins.pir b/src/Regex/Cursor-builtins.pir
@@ -176,6 +176,20 @@ Regex::Cursor-builtins - builtin regexes for Cursor objects
     .tailcall '!cclass'(self, 'blank', .CCLASS_BLANK)
 .end
 
+.sub 'FAILGOAL' :method
+    .param string goal
+    .local string dba
+    $P0 = getinterp
+    $P0 = $P0['sub';1]
+    dba = $P0
+  have_dba:
+    .local string message
+    message = concat "Unable to parse ", dba
+    message .= ", couldn't find final "
+    message .= goal
+    die message
+.end
+
 
 =head1 AUTHORS
 

diff --git a/src/Regex/P6Regex/Actions.pm b/src/Regex/P6Regex/Actions.pm
@@ -191,6 +191,19 @@ method metachar:sym<assert>($/) {
     make $<assertion>.ast;
 }
 
+method metachar:sym<~>($/) {
+    make PAST::Regex.new(
+        $<EXPR>.ast,
+        PAST::Regex.new( 
+            $<GOAL>.ast,
+            PAST::Regex.new( 'FAILGOAL', ~$<GOAL>, :pasttype('subrule'), 
+                             :subtype('method') ),
+            :pasttype('alt')
+        ),
+        :pasttype('concat')
+    );
+}
+
 method metachar:sym<{*}>($/) {
     my $past := $<key>
                 ?? PAST::Regex.new( ~$<key>[0], :pasttype('reduce'), :node($/) )

diff --git a/src/Regex/P6Regex/Grammar.pm b/src/Regex/P6Regex/Grammar.pm
@@ -76,6 +76,13 @@ grammar Regex::P6Regex::Grammar;
     token metachar:sym<bs> { \\ <backslash> }
     token metachar:sym<mod> { <mod_internal> }
 
+    ## we cheat here, really should be regex_infix:sym<~>
+    token metachar:sym<~> { 
+        $<sym>=['~'] 
+        <.ws> <GOAL=quantified_atom> 
+        <.ws> <EXPR=quantified_atom>
+    }
+
     token metachar:sym<{*}> { 
         $<sym>=['{*}'] 
         [ \h* '#= ' \h* $<key>=[\S+ [\h+ \S+]*] ]?

diff --git a/t/p6regex/01-regex.t b/t/p6regex/01-regex.t
@@ -81,7 +81,7 @@ Description of the test.
     push test_files, 'rx_captures'
     push test_files, 'rx_modifiers'
     # push test_files, 'rx_syntax'
-    # push test_files, 'rx_goal'
+    push test_files, 'rx_goal'
 
     .local pmc interp     # a handle to our interpreter object.
                interp = getinterp

diff --git a/t/p6regex/rx_goal b/t/p6regex/rx_goal
@@ -4,8 +4,10 @@
 '(' ~ ')' \d+		(123abc)	/couldn't find final/	stuff before goal
 '(' ~ ')' \d+		(abc)		n	can't match internal stuff
 '(' ~ ')' \d+		()		n	missing internal stuff
-['('] ~ [')'] [\d \d+]		(123)		y	goal syntax with brackets
-('(') ~ (')') (\d \d+)		(123)		y	goal syntax with parenthesis
+['('] ~ [')'] \d+		(123)		y	goal syntax with brackets
+['('] ~ [')'] [\d+]		(123)		y	goal syntax with brackets
+['('] ~ [')'] [\d\d+]		(123)		y	goal syntax with brackets
+('(') ~ (')') (\d\d+)		(123)		y	goal syntax with parentheses
 '(' ~ <[()]> \d+		(123)		y	non-literal goal
 '(' ~ <[()]> \d+		(123(		y	non-literal goal
 '(' ~ <[()]> \d+		(123]		/Unable to parse/	failing non-literal goal