Merge branch 'master' of github.com:rakudo/rakudo

docs/ChangeLog

@@ -1,3 +1,5 @@
++ syntactic adverbs on substitutions, e.g. '$x ~~ s:2nd/a/b/' works
+
 New in 2010.07 release
 + support for delegation via 'handles'
 + implemented binding with := and read-only binding with ::=

src/Perl6/Actions.pm

@@ -2589,11 +2589,11 @@ method typename($/) {
 }
 
 method quotepair($/) {
-    my $h := pir::new__ps('Hash');
-    $h<key>   := $*key;
-    $h<value> := $*value;
-
-    make $h;
+    unless $*value ~~ PAST::Node {
+        $*value := PAST::Val.new( :value($*value) );
+    }
+    $*value.named(~$*key);
+    make $*value;
 }
 
 method quote:sym<apos>($/) { make $<quote_EXPR>.ast; }
@@ -2632,6 +2632,24 @@ method quote:sym<m>($/) {
     make block_closure($past, 'Regex', 0);
 }
 
+our %SUBST_ALLOWED_ADVERBS;
+INIT {
+    %SUBST_ALLOWED_ADVERBS{'g'}         := 1;
+    %SUBST_ALLOWED_ADVERBS{'global'}    := 1;
+    %SUBST_ALLOWED_ADVERBS{'samecase'}  := 1;
+    %SUBST_ALLOWED_ADVERBS{'x'}         := 1;
+    %SUBST_ALLOWED_ADVERBS{'c'}         := 1;
+    %SUBST_ALLOWED_ADVERBS{'continue'}  := 1;
+    %SUBST_ALLOWED_ADVERBS{'p'}         := 1;
+    %SUBST_ALLOWED_ADVERBS{'pos'}       := 1;
+
+    %SUBST_ALLOWED_ADVERBS{'nth'}       := 1;
+    %SUBST_ALLOWED_ADVERBS{'th'}        := 1;
+    %SUBST_ALLOWED_ADVERBS{'st'}        := 1;
+    %SUBST_ALLOWED_ADVERBS{'nd'}        := 1;
+    %SUBST_ALLOWED_ADVERBS{'rd'}        := 1;
+}
+
 method quote:sym<s>($/) {
     # Build the regex.
     my $regex_ast := Regex::P6Regex::Actions::buildsub($<p6regex>.ast);
@@ -2655,10 +2673,10 @@ method quote:sym<s>($/) {
         $regex, $closure
     );
     for $<quotepair> {
-        if $_.ast<key> ne 'g' {
-            $/.CURSOR.panic("Substitution adverbs other than ':g' are not yet implemented");
+        unless %SUBST_ALLOWED_ADVERBS{$_.ast.named} {
+            $/.CURSOR.panic("Adverb '" ~ $_.ast.named ~ "' not allowed on subsitution");
         }
-        $past.push(PAST::Val.new(:named(~$_.ast<key>), :value($_.ast<value>)));
+        $past.push($_.ast);
     }
     make $past;
 }

src/Perl6/Grammar.pm

@@ -1392,9 +1392,12 @@ token quotepair {
     | <identifier> 
         { $*key := ~$<identifier> }
         [
-        || <?before '('> <circumfix> <.panic('Arguments to adverbs on quotes are not yet implemented')>
+        || <?before '('> <circumfix> { $*value := $<circumfix>.ast; }
         || { $*value := 1; }
         ]
+    | (\d+) <identifier>
+        [ <?before '('> <.cirumfix> <.panic('2nd argument not allowed on pair')> ]?
+        { $*key := ~$<identifier>; $*value := +~$/[0] }
     ]
 }
 

src/core/Cool-str.pm

@@ -253,7 +253,7 @@ augment class Cool {
                            :g(:$global),
                            :pos(:$p),
                            :$x,
-                           :$nth,
+                           :st(:nd(:rd(:th(:$nth)))),
                            :ov(:$overlap)) {
         if $continue ~~ Bool {
             note ":c / :continue requires a position in the string";

src/core/Match.pm

@@ -1,9 +1,10 @@
 class Match is Regex::Match is Cool does Positional does Associative {
-    method create(:$from, :$to, :$orig) {
+    method create(:$from, :$to, :$orig, :$ast) {
         my $new = self.bless(*);
         pir::setattribute__vpsp($new, '$!from',   $from);
         pir::setattribute__vpsp($new, '$!to',     $to);
         pir::setattribute__vpsp($new, '$!target', $orig);
+        pir::setattribute__vpsp($new, '$!ast',    $ast);
 
         # TODO: handle :@positional, :%named
 
@@ -148,7 +149,15 @@ class Match is Regex::Match is Cool does Positional does Associative {
             take "$sp  ]";
         }
     }
+}
 
+multi sub infix:<eqv>(Match $a, Match $b) {
+       $a.ast eqv $b.ast
+    && $a.orig eqv $b.orig
+    && $a.from eqv $b.from
+    && $a.to   eqv $b.to
+    && $a.list eqv $b.list
+    && $a.hash eqv $b.hash
 }
 
 # vim: ft=perl6

src/core/Substitution.pm

@@ -1,9 +1,13 @@
 class Substitution {
     has $!matcher;
     has $!replacer;
-    has $!g;
+    has %!adverbs;
+
+    method new(:$matcher, :$replacer, *%adverbs) {
+        self.bless(*, :$matcher, :$replacer, :%adverbs);
+    }
 
     method ACCEPTS($topic is rw) {
-        $topic = $topic.subst($!matcher, $!replacer, :$!g);
+        $topic = $topic.subst($!matcher, $!replacer, |%!adverbs);
     }
 }