# New Ticket Created by  Jarrod 
# Please include the string:  [perl #77066]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=77066 >


The current !STORE method on Hash does not make a copy of the given args to
store, so it gobbles up any values in the top-level container passed to it
(my %h = @a will empty @a, for example). This patch fixes that, and also
offers a substantial performance increase by directly accessing the class's
$!storage attribute.

I should point out there's a fair bit of duplicate code in this patch making
it a lot longer than it should be, but trying to reduce the duplicate code
requires either the use of unnecessary loops or the use of parrot subs,
which I wanted to avoid. Also, there's a lot of perl6scalar creation here
and I'm not sure if it's all needed (do keys need to be put in new scalars?
are they ever changed?)
diff --git a/src/core/Hash.pm b/src/core/Hash.pm
index 23d3847..c3d2804 100644
--- a/src/core/Hash.pm
+++ b/src/core/Hash.pm
@@ -14,29 +14,93 @@ role Hash is EnumMap {
           done:
         }
     }
-
     method !STORE(\$to_store) {
+        Q:PIR {
+        .local pmc self, to_store, items, storage
+        self = find_lex 'self'
+        to_store = find_lex '$to_store'
+
         # We create a new storage hash, in case we are referenced in
         # what is being stored.
-        pir::setattribute__vPsP(self, '$!storage', pir::new__Ps('Hash'));
+        storage = root_new ['parrot';'Hash']
+        setattribute self, '$!storage', storage
 
-        my $items = $to_store.flat;
-        while $items {
-            given $items.shift {
-                when Enum {
-                    self{.key} = .value;
-                }
-                when EnumMap {
-                    for $_.list { self{.key} = .value }
-                }
-                default {
-                    die('Odd number of elements found where hash expected')
-                        unless $items;
-                    self{$_} = $items.shift;
-                }
-            }
+        # Sequencify args
+        $P0 = get_hll_global 'Seq'
+        items = $P0.'new'(to_store)
+
+        #Get enum and enummap objects to call ACCEPTS on
+        .local pmc Enum, EnumMap
+        get_hll_global Enum, "Enum"
+        get_hll_global EnumMap, "EnumMap"
+
+        .local pmc item
+      fill_loop:
+        unless items goto done
+        item = items.'shift'()
+
+        $P0 = Enum.'ACCEPTS'(item)
+        unless $P0 goto check_emap
+        
+        $P1 = getattribute item, '$!key'
+        $P2 = getattribute item, '$!value'
+        $P1 = descalarref $P1
+        $P2 = descalarref $P2
+        $P1 = new ['Perl6Scalar'], $P1
+        $P2 = new ['Perl6Scalar'], $P2
+        setprop $P1, "scalar", true
+        setprop $P1, "rw", true
+        setprop $P2, "scalar", true
+        setprop $P2, "rw", true
+        
+        storage[$P1] = $P2
+        goto fill_loop
+
+      check_emap:
+        $P0 = EnumMap.'ACCEPTS'(item)
+        unless $P0 goto default
+        item = item.'list'()
+      copy_map_loop:
+        unless item goto fill_loop
+        $P0 = item.'shift'()
+
+        $P1 = getattribute $P0, '$!key'
+        $P2 = getattribute $P0, '$!value'
+        $P1 = descalarref $P1
+        $P2 = descalarref $P2
+        $P1 = new ['Perl6Scalar'], $P1
+        $P2 = new ['Perl6Scalar'], $P2
+        setprop $P1, "scalar", true
+        setprop $P1, "rw", true
+        setprop $P2, "scalar", true
+        setprop $P2, "rw", true
+
+        storage[$P1] = $P2
+        goto copy_map_loop
+
+      default:
+        unless items goto die_odd
+        $P0 = items.'shift'()
+        
+        $P1 = new ['Perl6Scalar'], item
+        $P2 = new ['Perl6Scalar'], $P0
+        setprop $P1, "scalar", true
+        setprop $P1, "rw", true
+        setprop $P2, "scalar", true
+        setprop $P2, "rw", true
+        
+        storage[$P1] = $P2
+        goto fill_loop
+
+      die_odd:
+        $P1 = new "Str"
+        $P1 = 'Odd number of elements found where hash expected'
+        '&die'($P1)
+
+      done:
+        %r = self
         }
-        self
     }
 
     method Bool() {

Reply via email to