implement Cool.samecase, .subst(:samespace) and ss///

Patch partly by flussence++
rakudo · Oct 8, 2010 · 668719b · 668719b
1 parent 5ce8fcf
commit 668719b
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 5 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -2874,6 +2874,9 @@ method quote:sym<s>($/) {
         $regex, $closure
     );
     self.handle_and_check_adverbs($/, %SUBST_ALLOWED_ADVERBS, 'substitution', $past);
+    if $/[0] {
+        pir::push__vPP($past, PAST::Val.new(:named('samespace'), :value(1)));
+    }
 
     $past := PAST::Op.new(
         :node($/),

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1461,11 +1461,10 @@ token quote:sym<s> {
     <sym> (s)? >>
     [ <quotepair> <.ws> ]*
     :my @*REGEX_ADVERBS;
-    { @*REGEX_ADVERBS := $<quotepair>; }
     {
+        @*REGEX_ADVERBS := $<quotepair>;
         if $/[0] {
             pir::push__vPP(@*REGEX_ADVERBS, $/.CURSOR.match_with_adverb('s'));
-            pir::push__vPP(@*REGEX_ADVERBS, $/.CURSOR.match_with_adverb('samespace'));
         }
     }
     <.setup_quotepairs>

diff --git a/src/core/Cool-str.pm b/src/core/Cool-str.pm
@@ -33,7 +33,8 @@ augment class Cool {
         }
     }
 
-    multi method subst($matcher, $replacement, :ii(:$samecase), *%options) {
+    multi method subst($matcher, $replacement,
+                       :ii(:$samecase), :ss(:$samespace), *%options) {
         my @matches = self.match($matcher, |%options);
         return self unless @matches;
         return self if @matches == 1 && !@matches[0];
@@ -42,8 +43,9 @@ augment class Cool {
         for @matches -> $m {
             $result ~= self.substr($prev, $m.from - $prev);
 
-	    my $real_replacement = ~($replacement ~~ Callable ?? $replacement($m) !! $replacement);
-	    $real_replacement    = $real_replacement.samecase(~$m) if $samecase;
+            my $real_replacement = ~($replacement ~~ Callable ?? $replacement($m) !! $replacement);
+            $real_replacement    = $real_replacement.samecase(~$m) if $samecase;
+            $real_replacement    = $real_replacement.samespace(~$m) if $samespace;
             $result ~= $real_replacement;
             $prev = $m.to;
         }
@@ -84,6 +86,24 @@ augment class Cool {
         $result;
     }
 
+    method samespace($other as Str) {
+        my @pieces = self.split(/\s+/);
+        my @new_spaces = $other.comb(/\s+/, @pieces-1);
+
+        my @new = @pieces[0..^@new_spaces] Z @new_spaces;
+
+        if @new_spaces < @pieces-1 {
+            my $remainder = self ~~ m:nth(@pieces-1)/\s+/;
+            @new.push(self.substr($remainder.from-1));
+        }
+        else {
+            @new.push(@pieces[*-1]);
+        }
+
+        return @new.join;
+    }
+
+
     multi method split(Regex $matcher, $limit = *, :$all) {
         my $c = 0;
         my $l = $limit ~~ ::Whatever ?? Inf !! $limit - 1;