develooper Front page | perl.cvs.parrot | Postings from November 2008

[svn:parrot] r32597 - in trunk: . languages/perl6/config/makefiles languages/perl6/src/classes

From:
pmichaud
Date:
November 13, 2008 00:04
Subject:
[svn:parrot] r32597 - in trunk: . languages/perl6/config/makefiles languages/perl6/src/classes
Message ID:
20081113080422.39EE4CB9AF@x12.develooper.com
Author: pmichaud
Date: Thu Nov 13 00:04:20 2008
New Revision: 32597

Added:
   trunk/languages/perl6/src/classes/Match.pir   (contents, props changed)
Modified:
   trunk/MANIFEST
   trunk/languages/perl6/config/makefiles/root.in
   trunk/languages/perl6/src/classes/Array.pir
   trunk/languages/perl6/src/classes/Bool.pir
   trunk/languages/perl6/src/classes/Capture.pir
   trunk/languages/perl6/src/classes/Code.pir
   trunk/languages/perl6/src/classes/Complex.pir
   trunk/languages/perl6/src/classes/Hash.pir
   trunk/languages/perl6/src/classes/Num.pir
   trunk/languages/perl6/src/classes/Object.pir
   trunk/languages/perl6/src/classes/Pair.pir
   trunk/languages/perl6/src/classes/Range.pir
   trunk/languages/perl6/src/classes/Str.pir
   trunk/languages/perl6/src/classes/Whatever.pir

Log:
[rakudo]: Fix objectref semantics for Match objects (RT #60456, chrisdolan++)
* Refactor setup of mutable/immutable builtin types


Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	(original)
+++ trunk/MANIFEST	Thu Nov 13 00:04:20 2008
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Mon Nov 10 17:28:12 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Thu Nov 13 07:42:11 2008 UT
 #
 # See tools/dev/install_files.pl for documentation on the
 # format of this file.
@@ -2109,6 +2109,7 @@
 languages/perl6/src/classes/Junction.pir                    [perl6]
 languages/perl6/src/classes/List.pir                        [perl6]
 languages/perl6/src/classes/Mapping.pir                     [perl6]
+languages/perl6/src/classes/Match.pir                       [perl6]
 languages/perl6/src/classes/Method.pir                      [perl6]
 languages/perl6/src/classes/Module.pir                      [perl6]
 languages/perl6/src/classes/Num.pir                         [perl6]

Modified: trunk/languages/perl6/config/makefiles/root.in
==============================================================================
--- trunk/languages/perl6/config/makefiles/root.in	(original)
+++ trunk/languages/perl6/config/makefiles/root.in	Thu Nov 13 00:04:20 2008
@@ -51,7 +51,6 @@
 BUILTINS_PIR = \
   src/classes/Object.pir \
   src/classes/Any.pir \
-  src/classes/Scalar.pir \
   src/classes/Bool.pir \
   src/classes/Str.pir \
   src/classes/Num.pir \
@@ -75,6 +74,7 @@
   src/classes/Pair.pir \
   src/classes/Whatever.pir \
   src/classes/Capture.pir \
+  src/classes/Match.pir \
   src/classes/Signature.pir \
   src/classes/Subset.pir \
   src/classes/Grammar.pir \

Modified: trunk/languages/perl6/src/classes/Array.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Array.pir	(original)
+++ trunk/languages/perl6/src/classes/Array.pir	Thu Nov 13 00:04:20 2008
@@ -12,6 +12,7 @@
     .local pmc p6meta, arrayproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     arrayproto = p6meta.'new_class'('Perl6Array', 'parent'=>'List', 'name'=>'Array')
+    arrayproto.'!MUTABLE'()
 
     $P0 = get_hll_namespace ['Perl6Array']
     '!EXPORT'('delete exists pop push shift unshift', 'from'=>$P0)
@@ -34,25 +35,9 @@
 
 =over 4
 
-=item Scalar()
-
-Returns an ObjectRef referencing itself, unless it already is one in which
-case just returns as is.
-
 =cut
 
 .namespace ['Perl6Array']
-
-.sub 'Scalar' :method
-    $I0 = isa self, 'ObjectRef'
-    unless $I0 goto not_ref
-    .return (self)
-  not_ref:
-    $P0 = new 'ObjectRef', self
-    .return ($P0)
-.end
-
-
 .sub 'delete' :method :multi(Perl6Array)
     .param pmc indices :slurpy
     .local pmc result

Modified: trunk/languages/perl6/src/classes/Bool.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Bool.pir	(original)
+++ trunk/languages/perl6/src/classes/Bool.pir	Thu Nov 13 00:04:20 2008
@@ -17,6 +17,7 @@
     .local pmc p6meta, boolproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     boolproto = p6meta.'new_class'('Bool', 'parent'=>'Boolean Any')
+    boolproto.'!IMMUTABLE'()
     p6meta.'register'('Boolean', 'parent'=>boolproto, 'protoobject'=>boolproto)
 
     $P0 = boolproto.'new'()
@@ -29,17 +30,6 @@
 .end
 
 
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
-.end
-
-
 .sub 'ACCEPTS' :method
     .param pmc topic
     .return (self)

Modified: trunk/languages/perl6/src/classes/Capture.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Capture.pir	(original)
+++ trunk/languages/perl6/src/classes/Capture.pir	Thu Nov 13 00:04:20 2008
@@ -17,17 +17,7 @@
     .local pmc p6meta, captureproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     captureproto = p6meta.'new_class'('Perl6Capture', 'parent'=>'Capture_PIR Any', 'name'=>'Capture')
-.end
-
-
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
+    captureproto.'!IMMUTABLE'()
 .end
 
 

Modified: trunk/languages/perl6/src/classes/Code.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Code.pir	(original)
+++ trunk/languages/perl6/src/classes/Code.pir	Thu Nov 13 00:04:20 2008
@@ -17,22 +17,12 @@
     .local pmc p6meta, codeproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     codeproto = p6meta.'new_class'('Code', 'parent'=>'Any')
+    codeproto.'!IMMUTABLE'()
     p6meta.'register'('Sub', 'parent'=>codeproto, 'protoobject'=>codeproto)
     p6meta.'register'('Closure', 'parent'=>codeproto, 'protoobject'=>codeproto)
 .end
 
 
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
-.end
-
-
 =over 4
 
 =item ACCEPTS(topic)

Modified: trunk/languages/perl6/src/classes/Complex.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Complex.pir	(original)
+++ trunk/languages/perl6/src/classes/Complex.pir	Thu Nov 13 00:04:20 2008
@@ -23,6 +23,7 @@
     .local pmc p6meta, complexproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     complexproto = p6meta.'new_class'('Perl6Complex', 'parent'=>'Complex Any', 'name'=>'Complex')
+    complexproto.'!IMMUTABLE'()
     p6meta.'register'('Complex', 'parent'=>complexproto, 'protoobject'=>complexproto)
 
     $P0 = get_hll_namespace ['Perl6Complex']
@@ -30,17 +31,6 @@
 .end
 
 
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
-.end
-
-
 =item perl()
 
 Returns a Perl representation of the Complex.

Modified: trunk/languages/perl6/src/classes/Hash.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Hash.pir	(original)
+++ trunk/languages/perl6/src/classes/Hash.pir	Thu Nov 13 00:04:20 2008
@@ -16,6 +16,7 @@
     .local pmc p6meta, hashproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     hashproto = p6meta.'new_class'('Perl6Hash', 'parent'=>'Mapping', 'name'=>'Hash')
+    hashproto.'!MUTABLE'()
 .end
 
 =item ACCEPTS()
@@ -35,23 +36,6 @@
 
 .namespace ['Perl6Hash']
 
-=item Scalar()
-
-Returns an ObjectRef referencing itself, unless it already is one in which
-case just returns as is.
-
-=cut
-
-.sub 'Scalar' :method
-    $I0 = isa self, 'ObjectRef'
-    unless $I0 goto not_ref
-    .return (self)
-  not_ref:
-    $P0 = new 'ObjectRef', self
-    .return ($P0)
-.end
-
-
 .sub 'ACCEPTS' :method
     .param pmc topic
     .tailcall self.'contains'(topic)

Added: trunk/languages/perl6/src/classes/Match.pir
==============================================================================
--- (empty file)
+++ trunk/languages/perl6/src/classes/Match.pir	Thu Nov 13 00:04:20 2008
@@ -0,0 +1,51 @@
+## $Id$
+
+=head1 TITLE
+
+Match - Perl 6 match objects
+
+=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'()
+.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
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

Modified: trunk/languages/perl6/src/classes/Num.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Num.pir	(original)
+++ trunk/languages/perl6/src/classes/Num.pir	Thu Nov 13 00:04:20 2008
@@ -18,6 +18,7 @@
     .local pmc p6meta, numproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     numproto = p6meta.'new_class'('Num', 'parent'=>'Float Any')
+    numproto.'!IMMUTABLE'()
     p6meta.'register'('Float', 'parent'=>numproto, 'protoobject'=>numproto)
 
     # Override the proto's ACCEPT method so we also accept Ints.
@@ -44,17 +45,6 @@
 .end
 
 
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
-.end
-
-
 =item ACCEPTS()
 
 =cut

Modified: trunk/languages/perl6/src/classes/Object.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Object.pir	(original)
+++ trunk/languages/perl6/src/classes/Object.pir	Thu Nov 13 00:04:20 2008
@@ -33,22 +33,12 @@
 .end
 
 
-.namespace ['Perl6Object']
-
 =back
 
 =head2 Object methods
 
 =over 4
 
-=item hash()
-
-Return the scalar as a Hash.
-
-=cut
-
-.namespace ['Perl6Object']
-
 =item Scalar()
 
 Default implementation gives reference type semantics, and returns an object
@@ -56,6 +46,7 @@
 
 =cut
 
+.namespace ['Perl6Object']
 .sub 'Scalar' :method
     $I0 = isa self, 'ObjectRef'
     unless $I0 goto not_ref
@@ -694,6 +685,26 @@
     .return (res)
 .end
 
+=item !IMMUTABLE()
+
+=item !MUTABLE()
+
+Indicate that objects in the class are mutable or immutable.
+
+=cut
+
+.sub '!IMMUTABLE' :method
+    $P0 = get_hll_global ['Int'], 'Scalar'
+    $P1 = self.'HOW'()
+    $P1.'add_method'('Scalar', $P0, 'to'=>self)
+.end
+
+.sub '!MUTABLE' :method
+    $P0 = get_hll_global ['Perl6Object'], 'Scalar'
+    $P1 = self.'HOW'()
+    $P1.'add_method'('Scalar', $P0, 'to'=>self)
+.end
+
 =back
 
 =cut

Modified: trunk/languages/perl6/src/classes/Pair.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Pair.pir	(original)
+++ trunk/languages/perl6/src/classes/Pair.pir	Thu Nov 13 00:04:20 2008
@@ -13,20 +13,10 @@
 .namespace ['Perl6Pair']
 
 .sub 'onload' :anon :load :init
-    .local pmc p6meta
+    .local pmc p6meta, pairproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    p6meta.'new_class'('Perl6Pair', 'parent'=>'Any', 'attr'=>'$!key $!value', 'name'=>'Pair')
-.end
-
-
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
+    pairproto = p6meta.'new_class'('Perl6Pair', 'parent'=>'Any', 'attr'=>'$!key $!value', 'name'=>'Pair')
+    pairproto.'!IMMUTABLE'()
 .end
 
 

Modified: trunk/languages/perl6/src/classes/Range.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Range.pir	(original)
+++ trunk/languages/perl6/src/classes/Range.pir	Thu Nov 13 00:04:20 2008
@@ -15,20 +15,10 @@
 .namespace ['Range']
 
 .sub 'onload' :anon :load :init
-    .local pmc p6meta
+    .local pmc p6meta, rangeproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    p6meta.'new_class'('Range', 'parent'=>'Any', 'attr'=>'$!from $!to $!from_exclusive $!to_exclusive')
-.end
-
-
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
+    rangeproto = p6meta.'new_class'('Range', 'parent'=>'Any', 'attr'=>'$!from $!to $!from_exclusive $!to_exclusive')
+    rangeproto.'!IMMUTABLE'()
 .end
 
 

Modified: trunk/languages/perl6/src/classes/Str.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Str.pir	(original)
+++ trunk/languages/perl6/src/classes/Str.pir	Thu Nov 13 00:04:20 2008
@@ -23,6 +23,7 @@
     .local pmc p6meta, strproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
     strproto = p6meta.'new_class'('Str', 'parent'=>'Perl6Str Any')
+    strproto.'!IMMUTABLE'()
     p6meta.'register'('Perl6Str', 'parent'=>strproto, 'protoobject'=>strproto)
     p6meta.'register'('String', 'parent'=>strproto, 'protoobject'=>strproto)
 
@@ -31,17 +32,6 @@
 .end
 
 
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
-.end
-
-
 .sub 'ACCEPTS' :method
     .param string topic
     .tailcall 'infix:eq'(topic, self)

Modified: trunk/languages/perl6/src/classes/Whatever.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Whatever.pir	(original)
+++ trunk/languages/perl6/src/classes/Whatever.pir	Thu Nov 13 00:04:20 2008
@@ -13,20 +13,10 @@
 .namespace ['Whatever']
 
 .sub 'onload' :anon :init :load
-    .local pmc p6meta
+    .local pmc p6meta, whateverproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    p6meta.'new_class'('Whatever', 'parent'=>'Perl6Object')
-.end
-
-
-=item Scalar
-
-This is a value type, so just returns itself.
-
-=cut
-
-.sub 'Scalar' :method
-    .return (self)
+    whateverproto = p6meta.'new_class'('Whatever', 'parent'=>'Perl6Object')
+    whateverproto.'!IMMUTABLE'()
 .end
 
 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About