From 250adbb1ccde9f953123468e3c1ddecbb75104a7 Mon Sep 17 00:00:00 2001
From: pmichaud <pmichaud@pobox.com>
Date: Sat, 29 May 2010 04:12:34 -0500
Subject: [PATCH] Initial fixes towards enabling Rakudo-specific Match objects.
 Most things work, but there are still a couple of issues with getting Match
 ~~ Positional to work (see src/core/Match.pm for details).

---
 build/Makefile.in       |  2 ++
 src/builtins/Cursor.pir | 35 +++++++++++++++++++++++++++++++++++
 src/core/Cool-str.pm    |  4 ++--
 src/core/Grammar.pm     |  2 +-
 src/core/Match.pm       | 35 +++++++++++++++++++++++++++++++++++
 5 files changed, 75 insertions(+), 3 deletions(-)
 create mode 100644 src/builtins/Cursor.pir
 create mode 100644 src/core/Match.pm

diff --git a/build/Makefile.in b/build/Makefile.in
index f2a7b0caa3d..a70d5b4a86f 100644
--- a/build/Makefile.in
+++ b/build/Makefile.in
@@ -136,6 +136,7 @@ BUILTINS_PIR = \
   src/builtins/assign.pir \
   src/builtins/metaops.pir \
   src/builtins/control.pir \
+  src/builtins/Cursor.pir \
 
 # Make sure parrot cheats are last in this list.
 # First parrot cheat must be attriter.pir (to get .HLL),
@@ -216,6 +217,7 @@ CORE_SOURCES = \
   src/core/Date.pm \
   src/core/Temporal.pm \
   src/core/YOU_ARE_HERE.pm \
+  src/core/Match.pm \
 
 # SETTING = \
 #   src/setting/traits.pm \
diff --git a/src/builtins/Cursor.pir b/src/builtins/Cursor.pir
new file mode 100644
index 00000000000..8ca3079b5a8
--- /dev/null
+++ b/src/builtins/Cursor.pir
@@ -0,0 +1,35 @@
+## $Id$
+
+=head1 TITLE
+
+Cursor - Perl 6 cursor objects
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+.namespace [ 'Cursor' ]
+
+.sub 'onload' :anon :init :load
+    .local pmc p6meta, cursorproto
+    p6meta = get_hll_global ['Mu'], '$!P6META'
+    cursorproto = p6meta.'new_class'('Cursor', 'parent'=>'parrot;Regex::Cursor Any')
+.end
+
+
+.sub 'new_match' :method
+    $P0 = new ['Match']
+    .return ($P0)
+.end
+
+=back
+
+=cut
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
diff --git a/src/core/Cool-str.pm b/src/core/Cool-str.pm
index 6a1730a8366..e28aff97dc2 100644
--- a/src/core/Cool-str.pm
+++ b/src/core/Cool-str.pm
@@ -216,7 +216,7 @@ augment class Cool {
 
             my $taken = 0;
             my $i = 1;
-            my @r = gather while my $m = Regex::Cursor.parse(self, :rule($pat), |%opts) {
+            my @r = gather while my $m = Cursor.parse(self, :rule($pat), |%opts) {
                 my $m-copy = $m;
                 if !$nth.defined || $i == $next-index {
                     take $m-copy;
@@ -249,7 +249,7 @@ augment class Cool {
             }
             return |@r;
         } else {
-            Regex::Cursor.parse(self, :rule($pat), |%opts);
+            Cursor.parse(self, :rule($pat), |%opts);
         }
     }
     multi method match($pat, *%options) {
diff --git a/src/core/Grammar.pm b/src/core/Grammar.pm
index 5ee040df897..f2b835d8027 100644
--- a/src/core/Grammar.pm
+++ b/src/core/Grammar.pm
@@ -1,4 +1,4 @@
-class Grammar is Regex::Cursor {
+class Grammar is Cursor {
     method parsefile($file, *%options) {
         my $fh = open($file, :r)
             || die "$file: $!";
diff --git a/src/core/Match.pm b/src/core/Match.pm
new file mode 100644
index 00000000000..5f8581d4f66
--- /dev/null
+++ b/src/core/Match.pm
@@ -0,0 +1,35 @@
+class Match is Regex::Match is Cool does Associative {
+    multi method postcircumfix:<{ }>($key) {
+        Q:PIR {
+            $P0 = find_lex 'self'
+            $P1 = find_lex '$key'
+            %r = $P0[$P1]
+            unless null %r goto done
+            %r = new ['Proxy']
+            setattribute %r, '$!base', $P0
+            setattribute %r, '$!key', $P1
+          done:
+        }
+    }
+
+    # We shouldn't need to provide this -- we should be able to
+    # simply write "does Positional" in the class declaration
+    # and it would provide us the postcircumfix:<[ ]> methods
+    # for free.  But there seems to be a bug or problem in the
+    # role composer that prevents us from having both "does Positional"
+    # and "does Associative" in the class declaration, so we'll
+    # provide the simple .[] for now.
+    multi method postcircumfix:<[ ]>(Int $key) {
+        Q:PIR {
+            $P0 = find_lex 'self'
+            $P1 = find_lex '$key'
+            $I1 = $P1
+            %r = $P0[$I1]
+            unless null %r goto done
+            %r = new ['Proxy']
+            setattribute %r, '$!base', $P0
+            setattribute %r, '$!key', $P1
+          done:
+        }
+    }
+}