Permalink
Browse files

interpolation of e.g. regexes in arrays in regexes

  • Loading branch information...
1 parent 483ce86 commit c255f1d91a58d0e4a76d2fa99f43741213a10dfa @FROGGS FROGGS committed Feb 23, 2013
Showing with 59 additions and 29 deletions.
  1. +12 −8 src/Perl6/Actions.pm
  2. +47 −21 src/core/Cursor.pm
View
@@ -5880,7 +5880,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions {
}
else {
make QAST::Regex.new( QAST::Node.new(
- QAST::SVal.new( :value('!LITERAL') ),
+ QAST::SVal.new( :value('INTERPOLATE') ),
$quote,
QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ) ),
:rxtype<subrule>, :subtype<method>, :node($/));
@@ -5900,8 +5900,10 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions {
make QAST::Regex.new(
QAST::Node.new(
QAST::SVal.new( :value('INTERPOLATE') ),
- QAST::Op.new(
- :op<call>, :name<&MAKE_REGEX>, $<codeblock>.ast ) ),
+ $<codeblock>.ast,
+ QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ),
+ QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ),
+ QAST::IVal.new( :value(1) ) ),
:rxtype<subrule>, :subtype<method>, :node($/));
}
@@ -5912,11 +5914,13 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions {
}
method assertion:sym<var>($/) {
- make QAST::Regex.new(
- QAST::Node.new(
- QAST::SVal.new( :value('INTERPOLATE') ),
- QAST::Op.new( :op<call>, :name<&MAKE_REGEX>, $<var>.ast ) ),
- :rxtype<subrule>, :subtype<method>, :node($/));
+ 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($*SEQ ?? 1 !! 0) ),
+ QAST::IVal.new( :value(1) ) ),
+ :rxtype<subrule>, :subtype<method>, :node($/));
}
method assertion:sym<name>($/) {
View
@@ -45,30 +45,56 @@ my class Cursor does NQPCursorRole {
$match;
}
- method INTERPOLATE($var, $i = 0, $s = 0) {
+ # INTERPOLATE will iterate over the string $tgt beginning at position 0.
+ # If it can't match against pattern $var (or any element of $var if it is an array)
+ # it will increment $pos and try again. Therefor it is important to only match
+ # against the current position.
+ # $i is case insensitive flag
+ # $s is for sequential matching instead of junctive
+ # $a is true if we are in an assertion
+ method INTERPOLATE($var, $i = 0, $s = 0, $a = 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
- }
+ # Call it if it is a routine. This will capture if requested.
+ return $var(self) if $var ~~ Callable;
+ 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 nqp::istype($var, Positional) || nqp::istype($var, Capture)
+ ?? $var.list !! $var -> $topic {
+ my $match;
+ my $len;
+
+ # We are in a regex assertion, the strings we get will be treated as
+ # regex rules.
+ if $a {
+ my $rx := eval("my \$x = anon regex \{ ^$topic \}");
+ $match := (nqp::substr($tgt, $pos, $eos - $pos) ~~ $rx).Str;
+ $len := nqp::chars( $match );
+ }
+ # A Regex already.
+ elsif $topic ~~ Regex {
+ $match := (nqp::substr($tgt, $pos, $eos - $pos) ~~ $topic).Str;
+ $len := nqp::chars( $match );
+ }
+ # The pattern is a string.
+ else {
+ $len := nqp::chars( $topic );
+ $match := $len < 1
+ || ($i ?? nqp::lc(nqp::substr($tgt, $pos, $len)) eq nqp::lc($topic)
+ !! nqp::substr($tgt, $pos, $len) eq $topic);
+ }
+
+ if $match && $len > $maxlen && $pos + $len <= $eos {
+ $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)
}
+
+ $cur.'!cursor_pass'($pos + $maxlen, '') if $maxlen >= 0;
+ $cur
}
else {
self."!cursor_start_cur"()

0 comments on commit c255f1d

Please sign in to comment.