RakuAST support for basic regex quantifiers

Along with backtrack modifiers.
rakudo · Jul 7, 2020 · 724c683 · 724c683
1 parent 5469d3c
commit 724c683
Show file tree

Hide file tree

Showing 2 changed files with 144 additions and 4 deletions.
diff --git a/src/Raku/Actions.nqp b/src/Raku/Actions.nqp
@@ -860,8 +860,24 @@ class Raku::RegexActions is HLL::Actions {
     }
 
     method quantified_atom($/) {
-        # TODO quantifier, separator, sigspace
-        make $<atom>.ast;
+        my $atom := $<atom>.ast;
+        if $<quantifier> {
+            my $quantifier := $<quantifier>.ast;
+            if $<separator> {
+                my $separator := $<separator>.ast;
+                make self.r('Regex', 'QuantifiedAtom').new(:$atom, :$quantifier, :$separator);
+            }
+            else {
+                make self.r('Regex', 'QuantifiedAtom').new(:$atom, :$quantifier);
+            }
+        }
+        else {
+            if $<separator> {
+                $/.panic("'" ~ $<separator><septype> ~
+                    "' may only be used immediately following a quantifier")
+            }
+            make $atom;
+        }
     }
 
     method atom($/) {
@@ -873,6 +889,34 @@ class Raku::RegexActions is HLL::Actions {
         }
     }
 
+    method quantifier:sym<*>($/) {
+        make self.r('Regex', 'Quantifier', 'ZeroOrMore').new(backtrack => $<backmod>.ast);
+    }
+
+    method quantifier:sym<+>($/) {
+        make self.r('Regex', 'Quantifier', 'OneOrMore').new(backtrack => $<backmod>.ast);
+    }
+
+    method quantifier:sym<?>($/) {
+        make self.r('Regex', 'Quantifier', 'ZeroOrOne').new(backtrack => $<backmod>.ast);
+    }
+
+    method backmod($/) {
+        my str $backmod := ~$/;
+        if $backmod eq ':' {
+            self.r('Regex', 'Backtrack', 'Ratchet')
+        }
+        elsif $backmod eq ':?' || $backmod eq '?' {
+            self.r('Regex', 'Backtrack', 'Frugal')
+        }
+        elsif $backmod eq ':!' || $backmod eq '!' {
+            self.r('Regex', 'Backtrack', 'Greedy')
+        }
+        else {
+            self.r('Regex', 'Backtrack')
+        }
+    }
+
     method metachar:sym<.>($/) {
         make self.r('Regex', 'CharClass', 'Any').new;
     }

diff --git a/src/Raku/ast/regex.rakumod b/src/Raku/ast/regex.rakumod
@@ -36,7 +36,7 @@ class RakuAST::Regex::Branching is RakuAST::Regex {
     method IMPL-REGEX-QAST(RakuAST::IMPL::QASTContext $context, %mods) {
         my $qast := QAST::Regex.new(:rxtype(self.IMPL-QAST-REGEX-TYPE));
         for $!branches {
-            $qast.push($_.IMPL-REGEX-QAST($context, $_));
+            $qast.push($_.IMPL-REGEX-QAST($context, %mods));
         }
         $qast
     }
@@ -86,7 +86,7 @@ class RakuAST::Regex::Sequence is RakuAST::Regex {
     method IMPL-REGEX-QAST(RakuAST::IMPL::QASTContext $context, %mods) {
         my $concat := QAST::Regex.new(:rxtype<concat>);
         for $!terms {
-            $concat.push($_.IMPL-REGEX-QAST($context, $_));
+            $concat.push($_.IMPL-REGEX-QAST($context, %mods));
         }
         $concat
     }
@@ -219,3 +219,99 @@ class RakuAST::Regex::CharClass::Word is RakuAST::Regex::CharClass::Negatable {
         QAST::Regex.new( :rxtype<cclass>, :name<w>, :negate(self.negated) )
     }
 }
+
+# A quantified atom in a regex - that is, an atom with a quantifier and
+# optional separator.
+class RakuAST::Regex::QuantifiedAtom is RakuAST::Regex::Term {
+    has RakuAST::Atom $.atom;
+    has RakuAST::Quantifier $.quantifier;
+    has RakuAST::Term $.separator;
+
+    method new(RakuAST::Atom :$atom!, RakuAST::Quantifier :$quantifier!,
+               RakuAST::Separator :$separator) {
+        my $obj := nqp::create(self);
+        nqp::bindattr($obj, RakuAST::Regex::QuantifiedAtom, '$!atom', $atom);
+        nqp::bindattr($obj, RakuAST::Regex::QuantifiedAtom, '$!quantifier', $quantifier);
+        nqp::bindattr($obj, RakuAST::Regex::QuantifiedAtom, '$!separator',
+            $separator // RakuAST::Term);
+        $obj
+    }
+
+    method IMPL-REGEX-QAST(RakuAST::IMPL::QASTContext $context, %mods) {
+        my $atom := $!atom.IMPL-REGEX-QAST($context, %mods);
+        my $quantified := $!quantifier.IMPL-QAST-QUANTIFY($context, $atom, %mods);
+        if $!separator {
+            nqp::die("Cannot yet compile separators");
+        }
+        else {
+            $quantified
+        }
+    }
+}
+
+# The base of all regex quantifiers.
+class RakuAST::Regex::Quantifier {
+    has RakuAST::Regex::Backtrack $.backtrack;
+
+    method new(RakuAST::Regex::Backtrack :$backtrack) {
+        my $obj := nqp::create(self);
+        nqp::bindattr($obj, RakuAST::Regex::Quantifier, '$!backtrack',
+            nqp::istype($backtrack, RakuAST::Regex::Backtrack)
+                ?? $backtrack
+                !! RakuAST::Regex::Backtrack);
+        $obj
+    }
+}
+
+# The zero or one (?) quantifier. 
+class RakuAST::Regex::Quantifier::ZeroOrOne is RakuAST::Regex::Quantifier {
+    method IMPL-QAST-QUANTIFY(RakuAST::IMPL::QASTContext $context, Mu $atom-qast, %mods) {
+        self.backtrack.IMPL-QAST-APPLY:
+            QAST::Regex.new( :rxtype<quant>, :min(0), :max(1), $atom-qast ),
+            %mods
+    }
+}
+
+# The zero or more (*) quantifier. 
+class RakuAST::Regex::Quantifier::ZeroOrMore is RakuAST::Regex::Quantifier {
+    method IMPL-QAST-QUANTIFY(RakuAST::IMPL::QASTContext $context, Mu $atom-qast, %mods) {
+        self.backtrack.IMPL-QAST-APPLY:
+            QAST::Regex.new( :rxtype<quant>, :min(0), :max(-1), $atom-qast ),
+            %mods
+    }
+}
+
+# The one or more (+) quantifier. 
+class RakuAST::Regex::Quantifier::OneOrMore is RakuAST::Regex::Quantifier {
+    method IMPL-QAST-QUANTIFY(RakuAST::IMPL::QASTContext $context, Mu $atom-qast, %mods) {
+        self.backtrack.IMPL-QAST-APPLY:
+            QAST::Regex.new( :rxtype<quant>, :min(1), :max(-1), $atom-qast ),
+            %mods
+    }
+}
+
+# Backtracking modifiers.
+class RakuAST::Regex::Backtrack {
+    method IMPL-QAST-APPLY(Mu $quant-qast, %mods) {
+        $quant-qast.backtrack('r') if %mods<r>;
+        $quant-qast
+    }
+}
+class RakuAST::Regex::Backtrack::Greedy is RakuAST::Regex::Backtrack {
+    method IMPL-QAST-APPLY(Mu $quant-qast, %mods) {
+        $quant-qast.backtrack('r');
+        $quant-qast
+    }
+}
+class RakuAST::Regex::Backtrack::Frugal is RakuAST::Regex::Backtrack {
+    method IMPL-QAST-APPLY(Mu $quant-qast, %mods) {
+        $quant-qast.backtrack('f');
+        $quant-qast
+    }
+}
+class RakuAST::Regex::Backtrack::Ratchet is RakuAST::Regex::Backtrack {
+    method IMPL-QAST-APPLY(Mu $quant-qast, %mods) {
+        $quant-qast.backtrack('g');
+        $quant-qast
+    }
+}