enable backslash sequences in character classes, enable negated chara…

…cter classes. patch mostly from jnthn++
Raku · Nov 20, 2011 · 856a79c · 856a79c
1 parent fd2fd16
commit 856a79c
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 7 deletions.
diff --git a/src/QRegex/P6Regex/Actions.nqp b/src/QRegex/P6Regex/Actions.nqp
@@ -304,6 +304,12 @@ class QRegex::P6Regex::Actions is HLL::Actions {
         my $qast := QAST::Regex.new( ~$/ , :rxtype('literal'), :node($/) );
         make $qast;
     }
+
+    method backlit($/) {
+        my $qast := QAST::Regex.new( '\\', :rxtype('enumcharlist'),
+                        :node($/) );
+        make $qast;
+    }
 
     method assertion:sym<?>($/) {
         my $qast;
@@ -406,20 +412,39 @@ class QRegex::P6Regex::Actions is HLL::Actions {
         my $qast;
         if $<name> {
             my $name := ~$<name>;
-            $qast := QAST::Regex.new( PAST::Node.new($name), :rxtype<subrule>, :subtype<method>, :node($/) );
+            $qast := QAST::Regex.new( PAST::Node.new($name), :rxtype<subrule>, :subtype<method>,
+                                      :negate( $<sign> eq '-' ), :node($/) );
         }
         else {
+            my @alts;
             for $<charspec> {
-                if $_[1] {
+                if $_<backslash> {
+                    my $bs := $_<backslash>.ast;
+                    $bs.negate(!$bs.negate) if $<sign> eq '-';
+                    @alts.push($bs);
+                }
+                elsif $_<backlit> {
+                    my $bslit := $_<backlit>.ast;
+                    $bslit.negate(!$bslit.negate) if $<sign> eq '-';
+                    @alts.push($bslit);
+                }
+                elsif $_[1] {
                     my $ord0 := nqp::ord($_[0]);
                     my $ord1 := nqp::ord($_[1][0]);
                     $str := nqp::concat($str, nqp::chr($ord0++)) while $ord0 <= $ord1;
                 }
                 else { $str := $str ~ $_[0]; }
             }
-            $qast := QAST::Regex.new( $str, :rxtype<enumcharlist>, :node($/) );
-        }
-        $qast.negate( $<sign> eq '-' );
+            @alts.push(QAST::Regex.new( $str, :rxtype<enumcharlist>, :node($/), :negate( $<sign> eq '-' ) ))
+                if nqp::chars($str);
+            $qast := +@alts == 1 ?? @alts[0] !!
+                $<sign> eq '-' ??
+                    QAST::Regex.new( :rxtype<concat>, :node($/),
+                        QAST::Regex.new( :rxtype<conj>, :subtype<zerowidth>, |@alts ), 
+                        QAST::Regex.new( :rxtype<cclass>, :subtype<.> ) ) !!
+                    QAST::Regex.new( :rxtype<alt>, |@alts );
+        }
+        #$qast.negate( $<sign> eq '-' );
         make $qast;
     }
 

diff --git a/src/QRegex/P6Regex/Grammar.nqp b/src/QRegex/P6Regex/Grammar.nqp
@@ -195,13 +195,17 @@ grammar QRegex::P6Regex::Grammar is HLL::Grammar {
 
     token assertion:sym<[> { <?before '['|'+'|'-'> <cclass_elem>+ }
 
+    token backlit { '\\' }
+
     token cclass_elem {
         $<sign>=['+'|'-'|<?>]
         <.normspace>?
         [
         | '[' $<charspec>=(
-                  | \s* '-' <!before \s* ']'> <.obs: '- as character range','.. for range, for explicit - in character class, escape it or place as last thing'>
-                  | \s* [ \\ (.) | (<-[\]\\]>) ] [ \s* '..' \s* (.) ]?
+                  || \s* '-' <!before \s* ']'> <.obs: '- as character range','.. for range, for explicit - in character class, escape it or place as last thing'>
+                  || \s* '\\' <backlit>
+                  || \s* '\\' <backslash>
+                  || \s* (<-[\]\\]>) [ \s* '..' \s* (.) ]?
               )*
           \s* ']'
         | $<name>=[\w+]