add array in regex interpolation feature

Arrays withinn regex will be treated as alternations of its elements. Preceding | or || will change its behaviour, || means sequential alt- ernation and | LTM, while the LTM is just a basic approach and needs tweeking.
rakudo · Feb 19, 2013 · 8e6fa0b · 8e6fa0b
1 parent 5101a54
commit 8e6fa0b
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 5 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -5888,7 +5888,8 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions {
         make QAST::Regex.new( QAST::Node.new(
                                     QAST::SVal.new( :value('INTERPOLATE') ),
                                     $<var>.ast,
-                                    QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ) ),
+                                    QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ),
+                                    QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ) ),
                               :rxtype<subrule>, :subtype<method>, :node($/));
     }
 

diff --git a/src/core/Cursor.pm b/src/core/Cursor.pm
@@ -45,10 +45,34 @@ my class Cursor does NQPCursorRole {
         $match;
     }
 
-    method INTERPOLATE($var, $i = 0) {
-        nqp::isconcrete($var) ??
-            ($var ~~ Callable ?? $var(self) !! self."!LITERAL"(nqp::unbox_s($var.Str), $i)) !!
+    method INTERPOLATE($var, $i = 0, $s = 0) {
+        if nqp::isconcrete($var) {
+            if nqp::istype($var, Positional) # for array-likes
+            || nqp::istype($var, Capture) {  # for references to arrays
+                my $maxlen := -1;
+                my $cur := self.'!cursor_start_cur'();
+                my $pos := nqp::getattr_i($cur, $?CLASS, '$!from');
+                my $tgt := $cur.target;
+                my $eos := nqp::chars($tgt);
+                for $var.list {
+                    my $topic := $_ ~~ Callable ?? $_(self) !! $_;
+                    my $len := nqp::chars($topic);
+                    if $len > $maxlen && $pos + $len <= $eos
+                        && nqp::substr($tgt, $pos, $len) eq $topic {
+                        $maxlen := $len;
+                        last if $s; # stop here for sequential alternation
+                    }
+                }
+                $cur.'!cursor_pass'($pos + $maxlen, '') if $maxlen >= 0;
+                $cur
+            }
+            else {
+                $var ~~ Callable ?? $var(self) !! self."!LITERAL"(nqp::unbox_s($var.Str), $i)
+            }
+        }
+        else {
             self."!cursor_start_cur"()
+        }
     }
 
     method OTHERGRAMMAR($grammar, $name, |) {

diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION
@@ -1 +1 @@
-2013.01-192-g98a623e
+2013.01-193-gf8a37df