hash-copy

compiler/kernel-primitives.rkt

@@ -101,6 +101,7 @@
                                     'make-immutable-hash
                                     'make-immutable-hasheqv
                                     'make-immutable-hasheq
+                                    'hash-copy
                                     'hash-ref
                                     'hash-has-key?
                                     'hash-set!

js-assembler/runtime-src/baselib-hashes.js

@@ -133,6 +133,10 @@
         this.hash = hash;
     };
 
+    WhalesongHashtable.prototype.clone = function() {
+        return new WhalesongHashtable(this.type, this.hash_function, this.equality_function, this.hash.clone());
+    };
+
     WhalesongHashtable.prototype.toWrittenString = function (cache) {
         var keys = this.hash.keys();
         var ret = [], i;

js-assembler/runtime-src/baselib-primitives.js

@@ -2571,6 +2571,13 @@
             return initializeHash(lst, plt.baselib.hashes.makeEqualHashtable());
         });
 
+    installPrimitiveProcedure(
+        'hash-copy',
+        1,
+        function(M) {
+            var hash = checkMutableHash(M, 'hash-copy', 0);
+            return hash.clone();
+        });
 
     installPrimitiveProcedure(
         'hash',

lang/kernel.rkt

@@ -161,6 +161,7 @@
          make-immutable-hash
          make-immutable-hasheqv
          make-immutable-hasheq
+         hash-copy
          hash-ref
          hash-set!
          hash-set

tests/more-tests/hashes.expected

@@ -52,3 +52,6 @@ true
 #hash((1 . one) (2 . two))
 #hasheqv((1 . one) (2 . two))
 #hasheq((1 . one) (2 . two))
+
+A
+alphabet

tests/more-tests/hashes.rkt

@@ -125,3 +125,10 @@
 (hasheqv 1 'one 2 'two)
 (hasheq 1 'one 2 'two)
 
+
+(newline)
+(let* ([h1 (make-hash '((a . "A")))]
+       [h2 (hash-copy h1)])
+  (hash-set! h2 'a "alphabet")
+  (displayln (hash-ref h1 'a))
+  (displayln (hash-ref h2 'a)))