Make 'my %h is Set = ...' DWIM

- also for SetHash, Bag, BagHash, Mix, MixHash - by implementing .STORE for all QuantHash types - .STORE is now also sent a :$initialize flag which is True for initialization - True for: my %h is Set = ...; - not set for: %h = ...; - throws X::Assignment::RO when trying to change Set|Bag|Mix - as in: %h = ...;
rakudo · Oct 30, 2017 · b6a4d5b · b6a4d5b
1 parent aab2b98
commit b6a4d5b
Show file tree

Hide file tree

Showing 7 changed files with 98 additions and 2 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -3157,7 +3157,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
                     }
                 }
                 elsif $<initializer><sym> eq '=' {
-                    $past := assign_op($/, $past, $initast);
+                    $past := assign_op($/, $past, $initast, :initialize);
                 }
                 elsif $<initializer><sym> eq '.=' {
                     $past := make_dot_equals($past, $initast);
@@ -6960,7 +6960,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
     }
 
     my @native_assign_ops := ['', 'assign_i', 'assign_n', 'assign_s'];
-    sub assign_op($/, $lhs_ast, $rhs_ast) {
+    sub assign_op($/, $lhs_ast, $rhs_ast, :$initialize) {
         my $past;
         my $var_sigil;
         $lhs_ast := WANTED($lhs_ast,'assign_op/lhs');
@@ -6976,6 +6976,13 @@ class Perl6::Actions is HLL::Actions does STDActions {
                 }
             }
         }
+
+        # get the sigil out of the my %h is Set = case
+        elsif nqp::istype($lhs_ast,QAST::Op) && $lhs_ast.op eq 'bind'
+          && nqp::istype($lhs_ast[0], QAST::Var) {
+            $var_sigil := nqp::substr($lhs_ast[0].name, 0, 1);
+        }
+
         if nqp::istype($lhs_ast, QAST::Var)
                 && nqp::objprimspec($lhs_ast.returns) -> $spec {
             # Native assignment is only possible to a reference; complain now
@@ -6996,6 +7003,14 @@ class Perl6::Actions is HLL::Actions does STDActions {
             $past := QAST::Op.new(
                 :op('callmethod'), :name('STORE'),
                 $lhs_ast, $rhs_ast);
+
+            # let STORE know if this is the first time
+            if $initialize {
+                $past.push(QAST::WVal.new(
+                  :named('initialize'),
+                  :value($*W.find_symbol(['Bool', 'True']))
+                ));
+            }
             $past.nosink(1);
         }
         elsif $var_sigil eq '$' {

diff --git a/src/core/Bag.pm b/src/core/Bag.pm
@@ -23,6 +23,22 @@ my class Bag does Baggy {
     }
 
 #--- interface methods
+    method STORE(*@pairs, :$initialize --> Bag:D) {
+        nqp::if(
+          (my $iterator := @pairs.iterator).is-lazy,
+          Failure.new(X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))),
+          nqp::if(
+            $initialize,
+            self.SET-SELF(
+              Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
+                nqp::create(Rakudo::Internals::IterationSet), $iterator
+              )
+            ),
+            X::Assignment::RO.new(value => self).throw
+          )
+        )
+    }
+
     multi method DELETE-KEY(Bag:D: \k) {
         X::Immutable.new(method => 'DELETE-KEY', typename => self.^name).throw;
     }

diff --git a/src/core/BagHash.pm b/src/core/BagHash.pm
@@ -1,6 +1,17 @@
 my class BagHash does Baggy {
 
 #--- interface methods
+    method STORE(*@pairs --> BagHash:D) {
+        nqp::if(
+          (my $iterator := @pairs.iterator).is-lazy,
+          Failure.new(X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))),
+          self.SET-SELF(
+            Rakudo::QuantHash.ADD-PAIRS-TO-BAG(
+              nqp::create(Rakudo::Internals::IterationSet), $iterator
+            )
+          )
+        )
+    }
     multi method AT-KEY(BagHash:D: \k) is raw {
         Proxy.new(
           FETCH => {

diff --git a/src/core/Mix.pm b/src/core/Mix.pm
@@ -4,6 +4,21 @@ my class Mix does Mixy {
     has Real $!total-positive;
 
 #--- interface methods
+    method STORE(*@pairs, :$initialize --> Mix:D) {
+        nqp::if(
+          (my $iterator := @pairs.iterator).is-lazy,
+          Failure.new(X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))),
+          nqp::if(
+            $initialize,
+            self.SET-SELF(
+              Rakudo::QuantHash.ADD-PAIRS-TO-MIX(
+                nqp::create(Rakudo::Internals::IterationSet), $iterator
+              )
+            ),
+            X::Assignment::RO.new(value => self).throw
+          )
+        )
+    }
     multi method DELETE-KEY(Mix:D: \k) {
         X::Immutable.new(method => 'DELETE-KEY', typename => self.^name).throw;
     }

diff --git a/src/core/MixHash.pm b/src/core/MixHash.pm
@@ -4,6 +4,17 @@ my class MixHash does Mixy {
     method total() { Rakudo::QuantHash.MIX-TOTAL($!elems) }
     method !total-positive() { Rakudo::QuantHash.MIX-TOTAL-POSITIVE($!elems) }
 
+    method STORE(*@pairs --> MixHash:D) {
+        nqp::if(
+          (my $iterator := @pairs.iterator).is-lazy,
+          Failure.new(X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))),
+          self.SET-SELF(
+            Rakudo::QuantHash.ADD-PAIRS-TO-MIX(
+              nqp::create(Rakudo::Internals::IterationSet), $iterator
+            )
+          )
+        )
+    }
     multi method AT-KEY(MixHash:D: \k) is raw {
         Proxy.new(
           FETCH => {

diff --git a/src/core/Set.pm b/src/core/Set.pm
@@ -88,6 +88,22 @@ my class Set does Setty {
     }
 
 #--- interface methods
+    method STORE(*@pairs, :$initialize --> Set:D) {
+        nqp::if(
+          (my $iterator := @pairs.iterator).is-lazy,
+          Failure.new(X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))),
+          nqp::if(
+            $initialize,
+            self.SET-SELF(
+              Rakudo::QuantHash.ADD-PAIRS-TO-SET(
+                nqp::create(Rakudo::Internals::IterationSet), $iterator
+              )
+            ),
+            X::Assignment::RO.new(value => self).throw
+          )
+        )
+    }
+
     multi method AT-KEY(Set:D: \k --> Bool:D) {
         nqp::p6bool($!elems && nqp::existskey($!elems,k.WHICH))
     }

diff --git a/src/core/SetHash.pm b/src/core/SetHash.pm
@@ -176,6 +176,18 @@ my class SetHash does Setty {
     }
 
 #--- interface methods
+    method STORE(*@pairs --> SetHash:D) {
+        nqp::if(
+          (my $iterator := @pairs.iterator).is-lazy,
+          Failure.new(X::Cannot::Lazy.new(:action<initialize>,:what(self.^name))),
+          self.SET-SELF(
+            Rakudo::QuantHash.ADD-PAIRS-TO-SET(
+              nqp::create(Rakudo::Internals::IterationSet), $iterator
+            )
+          )
+        )
+    }
+
     multi method AT-KEY(SetHash:D: \k --> Bool:D) is raw {
         Proxy.new(
           FETCH => {