Author: pmichaud
Date: Mon Dec 15 07:06:01 2008
New Revision: 33916
Modified:
trunk/languages/perl6/src/builtins/assign.pir
trunk/languages/perl6/src/classes/Array.pir
trunk/languages/perl6/src/classes/Object.pir
Log:
[rakudo]: Refactor Array 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 07:06:01 2008
@@ -48,6 +48,7 @@
.return (cont)
.end
+
.sub 'infix:=' :multi(['Perl6Array'], _)
.param pmc cont
.param pmc source
@@ -59,22 +60,7 @@
.tailcall 'infix:='(cont, source)
cont_array:
- .local pmc list, it, array
- ## empty the array
- array = new 'ResizablePMCArray'
- source = 'list'(source)
- it = iter source
- array_loop:
- unless it goto array_done
- $P0 = shift it
- $P0 = $P0.'Scalar'()
- $P0 = clone $P0
- push array, $P0
- goto array_loop
- array_done:
- $I0 = elements cont
- splice cont, array, 0, $I0
- .return (cont)
+ .tailcall cont.'!STORE'(source)
.end
Modified: trunk/languages/perl6/src/classes/Array.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Array.pir (original)
+++ trunk/languages/perl6/src/classes/Array.pir Mon Dec 15 07:06:01 2008
@@ -233,6 +233,35 @@
.return (self)
.end
+=item !STORE()
+
+Store things into an Array (e.g., upon assignment)
+
+=cut
+
+.namespace ['Perl6Array']
+.sub '!STORE' :method
+ .param pmc source
+ .local pmc array, it
+ ## we create a new array here instead of emptying self in case
+ ## the source argument contains self or elements of self.
+ array = new 'ResizablePMCArray'
+ $P0 = get_hll_global 'list'
+ source = $P0(source)
+ it = iter source
+ array_loop:
+ unless it goto array_done
+ $P0 = shift it
+ $P0 = $P0.'Scalar'()
+ $P0 = clone $P0
+ push array, $P0
+ goto array_loop
+ array_done:
+ $I0 = elements self
+ splice self, array, 0, $I0
+ .return (self)
+.end
+
=back
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 07:06:01 2008
@@ -140,7 +140,7 @@
.namespace ['Perl6Object']
.sub 'Array' :method
$P0 = new 'Perl6Array'
- 'infix:='($P0, self)
+ $P0.'!STORE'(self)
.return ($P0)
.end
