[svn:parrot] r34319 - in trunk/languages/perl6/src: builtins classes

Author: pmichaud
Date: Wed Dec 24 00:02:32 2008
New Revision: 34319

Modified:
   trunk/languages/perl6/src/builtins/any-str.pir
   trunk/languages/perl6/src/classes/Code.pir
   trunk/languages/perl6/src/classes/Match.pir

Log:
[rakudo]:  Matches now produce Rakudo Match objects instead of PGE::Match.


Modified: trunk/languages/perl6/src/builtins/any-str.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/any-str.pir	(original)
+++ trunk/languages/perl6/src/builtins/any-str.pir	Wed Dec 24 00:02:32 2008
@@ -313,7 +313,7 @@
 .sub 'match' :method :multi(_)
     .param pmc x
     .local pmc match
-    match = x(self)
+    match = x(self, 'grammar'=>'Match')
     .return(match)
 .end
 

Modified: trunk/languages/perl6/src/classes/Code.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Code.pir	(original)
+++ trunk/languages/perl6/src/classes/Code.pir	Wed Dec 24 00:02:32 2008
@@ -34,6 +34,11 @@
     .param pmc topic
     .local pmc match
 
+    .local pmc pgesave
+    pgesave = get_hll_global ['PGE'], '$!MATCH'
+    $P0 = get_hll_global 'Match'
+    set_hll_global ['PGE'], '$!MATCH', $P0
+
     # If topic is an Array or Hash, need special treatment.
     $I0 = isa topic, 'Perl6Array'
     if $I0 goto is_array
@@ -72,6 +77,7 @@
     $P1['$/'] = match
   not_regex:
 
+    set_hll_global ['PGE'], '$!MATCH', pgesave
     .return (match)
 .end
 
@@ -82,7 +88,12 @@
 .sub 'REJECTS' :method
     .param pmc topic
     .local pmc match
+    .local pmc pgesave
+    pgesave = get_hll_global ['PGE'], '$!MATCH'
+    $P0 = get_hll_global 'Match'
+    set_hll_global ['PGE'], '$!MATCH', $P0
     match = self(topic)
+    set_hll_global ['PGE'], '$!MATCH', pgesave
     $P0 = getinterp
     $P1 = $P0['lexpad';1]
     $P1['$/'] = match

Modified: trunk/languages/perl6/src/classes/Match.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Match.pir	(original)
+++ trunk/languages/perl6/src/classes/Match.pir	Wed Dec 24 00:02:32 2008
@@ -6,52 +6,18 @@
 
 =head1 Description
 
-At the moment file is a dummy file, it does nothing more than
-cause PGE::Match objects to act as mutables via the Scalar method.
-Eventually we'll derive a proper Match subclass here that can
-do it the same way as other Rakudo classes, but this is a
-good workaround for now.
-
-(We have to handle mutable-ness specially here, because PGE::Match
-is derived from Parrot's Hash class, and Rakudo's Mapping class
-causes Parrot's Hash to act like an immutable.  HLL mapping would
-help here, too.)
-
-=over 4
-
-=item onload
-
 =cut
 
-.namespace ['PGE';'Match']
-
 .sub '' :anon :load :init
-    $P0 = get_hll_global ['PGE'], 'Match'
-    $P0.'!MUTABLE'()
-
-    # Also install Match proto in our HLL namespace.
-    set_hll_global 'Match', $P0
-
-    .local pmc p6meta
+    .local pmc p6meta, matchproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    $P1 = get_hll_global 'Positional'
-    p6meta.'add_role'($P1, 'to'=>$P0)
+    matchproto = p6meta.'new_class'('Match', 'parent'=>'PGE::Match Any')
+    $P0 = get_hll_global 'Positional'
+    p6meta.'add_role'($P0, 'to'=>matchproto)
+    $P0 = get_hll_global 'Associative'
+    p6meta.'add_role'($P0, 'to'=>matchproto)
 .end
 
-#
-#.sub 'Scalar' :method
-#    $I0 = isa self, 'ObjectRef'
-#    unless $I0 goto not_ref
-#    .return (self)
-#  not_ref:
-#    $P0 = new 'ObjectRef', self
-#    .return ($P0)
-#.end
-
-=back
-
-=cut
-
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

• [svn:parrot] r34319 - in trunk/languages/perl6/src: builtins classes by pmichaud