Author: pmichaud
Date: Mon Dec 15 08:51:39 2008
New Revision: 33922
Modified:
trunk/languages/perl6/src/builtins/assign.pir
trunk/languages/perl6/src/classes/Hash.pir
trunk/languages/perl6/src/classes/Mapping.pir
trunk/languages/perl6/src/classes/Object.pir
trunk/languages/perl6/src/parser/actions.pm
Log:
[rakudo]: Refactor hash construction and assignment.
Modified: trunk/languages/perl6/src/builtins/assign.pir
==============================================================================
--- trunk/languages/perl6/src/builtins/assign.pir (original)
+++ trunk/languages/perl6/src/builtins/assign.pir Mon Dec 15 08:51:39 2008
@@ -64,9 +64,7 @@
.tailcall 'infix:='(cont, source)
cont_hash:
- $P0 = source.'hash'()
- copy cont, $P0
- .return (cont)
+ .tailcall cont.'!STORE'(source)
.end
@@ -126,7 +124,7 @@
goto assign_loop
assign_array:
assign_hash:
- 'infix:='(cont, slist)
+ cont.'!STORE'(slist)
slist = new 'Nil'
goto assign_loop
assign_done:
Modified: trunk/languages/perl6/src/classes/Hash.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Hash.pir (original)
+++ trunk/languages/perl6/src/classes/Hash.pir Mon Dec 15 08:51:39 2008
@@ -4,14 +4,9 @@
src/classes/Hash.pir - Perl 6 Hash class and related functions
-=head2 Object Methods
-
-=over 4
-
=cut
.namespace []
-
.sub 'onload' :anon :load :init
.local pmc p6meta, hashproto
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
@@ -19,29 +14,30 @@
hashproto.'!MUTABLE'()
.end
-=item ACCEPTS()
+=head2 Methods
+
+=over 4
=cut
-.sub 'hash'
- .param pmc args :slurpy
- .param pmc hash :slurpy :named
- args.'!flatten'()
- unless hash goto hash_done
- unshift args, hash
- hash_done:
- .tailcall args.'hash'()
-.end
+=item ACCEPTS()
+=cut
.namespace ['Perl6Hash']
-
.sub 'ACCEPTS' :method
.param pmc topic
.tailcall self.'contains'(topic)
.end
+.namespace ['Perl6Hash']
+.sub 'contains' :method
+ .param pmc key
+ $I0 = exists self[key]
+ .return( $I0 )
+.end
+.namespace ['Perl6Hash']
.sub 'delete' :method
.param pmc keys :slurpy
.local pmc result
@@ -49,7 +45,6 @@
.local pmc tmp
result = new 'List'
keys.'!flatten'()
-
keys_loop:
unless keys goto done
key = shift keys
@@ -57,29 +52,109 @@
push result, tmp
delete self[key]
goto keys_loop
-
done:
.return (result)
.end
+.namespace ['Perl6Hash']
+.sub 'exists' :method
+ .param pmc key
+ $I0 = exists self[key]
+ .return( $I0 )
+.end
+
+.namespace ['Perl6Hash']
.sub 'hash' :method
.return (self)
.end
-.sub 'exists' :method
- .param pmc key
+.namespace ['Perl6Hash']
+.sub 'Hash' :method
+ .return (self)
+.end
- $I0 = exists self[key]
- .return( $I0 )
+=back
+
+=head2 Operators
+
+=over
+
+=item circumfix:<{ }>
+
+Create a Hash (hashref).
+
+=cut
+
+.namespace []
+.sub 'circumfix:{ }'
+ .param pmc values :slurpy
+ $P0 = values.'Hash'()
+ $P0 = new 'ObjectRef', $P0
+ .return ($P0)
.end
-.sub 'contains' :method
- .param pmc key
+=back
- $I0 = exists self[key]
- .return( $I0 )
+=head2 Private methods
+
+=over
+
+=item !STORE
+
+Store a value into a hash.
+
+=cut
+
+.namespace ['Perl6Hash']
+.sub '!STORE' :method
+ .param pmc source
+ ## we create a new hash here instead of emptying self in case
+ ## the source argument contains self or elements of self.
+ .local pmc hash, it
+ hash = new 'Perl6Hash'
+ source = 'list'(source)
+ it = iter source
+ iter_loop:
+ unless it goto iter_done
+ .local pmc elem, key, value
+ elem = shift it
+ $I0 = does elem, 'hash'
+ if $I0 goto iter_hash
+ $I0 = isa elem, 'Perl6Pair'
+ if $I0 goto iter_pair
+ unless it goto err_odd_list
+ key = elem
+ value = shift it
+ goto iter_kv
+ iter_pair:
+ key = elem.'key'()
+ value = elem.'value'()
+ iter_kv:
+ value = 'Scalar'(value)
+ hash[key] = value
+ goto iter_loop
+ iter_hash:
+ .local pmc hashiter
+ hashiter = iter elem
+ hashiter_loop:
+ unless hashiter goto hashiter_done
+ $S0 = shift hashiter
+ value = elem[$S0]
+ value = 'Scalar'(value)
+ value = clone value
+ hash[$S0] = value
+ goto hashiter_loop
+ hashiter_done:
+ goto iter_loop
+ iter_done:
+ copy self, hash
+ .return (self)
+
+ err_odd_list:
+ die "Odd number of elements found where hash expected"
.end
+
=back
=cut
Modified: trunk/languages/perl6/src/classes/Mapping.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Mapping.pir (original)
+++ trunk/languages/perl6/src/classes/Mapping.pir Mon Dec 15 08:51:39 2008
@@ -24,29 +24,16 @@
=item Scalar
-When we're going to be stored as an item, become a Hash and then return
-ourself in a ObjectRef.
+When we're going to be stored as an item, become a Hash and
+return an ObjectRef to it.
=cut
+.namespace ['Mapping']
.sub 'Scalar' :method
- # Create a hash with our values.
- .local pmc hash, it
- hash = get_hll_global "Hash"
- hash = hash.'new'()
- it = iter self
- it_loop:
- unless it goto it_loop_end
- $P0 = shift it
- $P1 = self[$P0]
- hash[$P0] = $P1
- goto it_loop
- it_loop_end:
-
- # Wrap it up in an object ref and return it.
- .local pmc ref
- ref = new 'ObjectRef', hash
- .return (ref)
+ $P0 = self.'Hash'()
+ $P0 = new 'ObjectRef', $P0
+ .return ($P0)
.end
Modified: trunk/languages/perl6/src/classes/Object.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Object.pir (original)
+++ trunk/languages/perl6/src/classes/Object.pir Mon Dec 15 08:51:39 2008
@@ -43,14 +43,19 @@
=item hash
-Return invocant in hash context. Default is to build a Hash from C<.list>.
+Return invocant in hash context.
=cut
.namespace ['Perl6Object']
.sub 'hash' :method
- $P0 = self.'list'()
- .tailcall $P0.'hash'()
+ .tailcall self.'Hash'()
+.end
+
+.namespace []
+.sub 'hash'
+ .param pmc values :slurpy
+ .tailcall values.'Hash'()
.end
=item item
@@ -144,6 +149,17 @@
.return ($P0)
.end
+=item Hash()
+
+=cut
+
+.namespace ['Perl6Object']
+.sub 'Hash' :method
+ $P0 = new 'Perl6Hash'
+ $P0.'!STORE'(self)
+ .return ($P0)
+.end
+
=item Iterator()
=cut
Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Mon Dec 15 08:51:39 2008
@@ -2639,7 +2639,7 @@
my @children := @($past[1]);
$past := PAST::Op.new(
:pasttype('call'),
- :name('hash'),
+ :name('circumfix:{ }'),
:node($/)
);
for @children {
