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
