integrating the immutable hashes

compiler/kernel-primitives.rkt

@@ -93,10 +93,13 @@
                                     'make-hash
                                     'make-hasheqv
                                     'make-hasheq
+                                    'make-immutable-hash
+                                    'make-immutable-hasheqv
+                                    'make-immutable-hasheq
                                     'hash-ref
                                     'hash-set!
+                                    'hash-set
                                     'equal-hash-code
-                                    
                                     ))
 (define-predicate KernelPrimitiveName? KernelPrimitiveName)
 

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

@@ -258,6 +258,23 @@
     var checkHash = makeCheckArgumentType(
         baselib.hashes.isHash,
         'hash');
+    var checkHasheq = makeCheckArgumentType(
+        baselib.hashes.isHasheq,
+        'hash');
+    var checkHasheqv = makeCheckArgumentType(
+        baselib.hashes.isHasheqv,
+        'hash');
+    var checkMutableHash = makeCheckArgumentType(
+        function(x) { return baselib.hashes.isHash(x) && ! x.isImmutable()},
+        'mutable hash');
+    var checkImmutableHash = makeCheckArgumentType(
+        function(x) { return baselib.hashes.isHash(x) && x.isImmutable()},
+        'immutable hash');
+
+
+
+
+
 
     //////////////////////////////////////////////////////////////////////
 
@@ -298,5 +315,7 @@
     exports.checkContinuationPromptTag = checkContinuationPromptTag;
     exports.checkExn = checkExn;
     exports.checkHash = checkHash;
+    exports.checkImmutableHash = checkImmutableHash;
+    exports.checkMutableHash = checkMutableHash;
 
 }(this.plt.baselib));

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

@@ -66,7 +66,6 @@
     };
 
 
-
     var makeEqHashtable = function() { 
         return new WhalesongHashtable(
             "hasheq",
@@ -88,8 +87,21 @@
         return new WhalesongHashtable(
             "hasheqv",
             getEqvHashCode,
-            baselib.equality.eqv,
+            eqv,
-            new Hashtable(getEqvHashCode, baselib.equality.eqv));
+            new Hashtable(getEqvHashCode, eqv));
+    };
+
+
+    var makeImmutableEqHashtable = function() { 
+        return makeEqHashtable().toImmutable();
+    };
+
+    var makeImmutableEqualHashtable = function() {
+        return makeEqualHashtable().toImmutable();
+    };
+        
+    var makeImmutableEqvHashtable = function() {
+        return makeEqvHashtable().toImmutable();
     };
 
 
@@ -111,9 +123,6 @@
     };
 
 
-
-
-
     //////////////////////////////////////////////////////////////////////
     // Whalesong's Hashtables are a thin wrapper around the mutable Hashtable
     // class to make it printable and equatable.
@@ -187,10 +196,18 @@
         this.hash.put(key, value);
     };
 
+    WhalesongHashtable.prototype.functionalPut = function(key, value) {
+        return this.toImmutable().functionalPut(key, value);
+    };
+
     WhalesongHashtable.prototype.remove = function(key) {
         this.hash.remove(key);
     };
 
+    WhalesongHashtable.prototype.functionalRemove = function(key) {
+        return this.toImmutable().functionalRemove(key);
+    };
+
     WhalesongHashtable.prototype.containsKey = function(key) {
         return this.hash.containsKey(key);
     };
@@ -199,6 +216,20 @@
         return false;
     };
 
+    WhalesongHashtable.prototype.toImmutable = function() {
+        var keycmp = makeComparator(this.hash_function, this.equality_function)
+        var immutable = new WhalesongImmutableHashtable(
+            this.type,
+            this.hash_function,
+            this.equality_function,
+            LLRBTree.makeMap(keycmp));
+        var keys = this.hash.keys();
+        var i;
+        for (i = 0; i < keys.length; i++) {
+            immutable = immutable.functionalPut(keys[i], this.hash.get(keys[i]));
+        }
+        return immutable;
+    };
 
 
     //////////////////////////////////////////////////////////////////////
@@ -206,12 +237,14 @@
     // Whalesong's immutable hashtables are a thin wrapper around the
     // llrbtree class to make it printable and equatable.
     // llrbtree comes from: https://github.com/dyoo/js-llrbtree
-    var WhalesongImmutableHashtable = function (type, hash_function, equality_function) {
+    var WhalesongImmutableHashtable = function (type,
+                                                hash_function,
+                                                equality_function,
+                                                map) {
         this.type = type;
         this.hash_function = hash_function;
         this.equality_function = equality_function;
-        this.keycmp = makeComparator(hash_function, equality_function);
+        this.map = map;
-        this.map = LLRBTree.makeMap(keycmp);
     };
 
     WhalesongImmutableHashtable.prototype.toWrittenString = function (cache) {
@@ -249,7 +282,6 @@
         if (litems.length !== ritems.length) { 
             return false;
         }
-
         var i;
         for (i = 0; i < litems.length; i++) {
             if (!(baselib.equality.equals(litems[i][0], ritems[i][0], aUnionFind))) {
@@ -284,6 +316,10 @@
     };
 
     WhalesongImmutableHashtable.prototype.functionalPut = function(key, value) {
+        return new WhalesongImmutableHashtable(this.type,
+                                               this.hash_function,
+                                               this.equality_function,
+                                               this.map.put(key, value));
     };
 
     WhalesongImmutableHashtable.prototype.remove = function(key) {
@@ -291,7 +327,10 @@
     };
 
     WhalesongImmutableHashtable.prototype.functionalRemove = function(key) {
-        // this.hash.remove(key);
+        return new WhalesongImmutableHashtable(this.type,
+                                               this.hash_function,
+                                               this.equality_function,
+                                               this.map.remove(key));
     };
 
     WhalesongImmutableHashtable.prototype.containsKey = function(key) {
@@ -305,12 +344,6 @@
 
 
 
-
-
-
-
-
-
     var isHash = function (x) { 
         return (x instanceof WhalesongHashtable || x instanceof WhalesongImmutableHashtable);
     };
@@ -325,8 +358,6 @@
 
 
 
-
-
     // Arbitrary magic number.  We have to cut off the hashing at some point.
     var MAX_HASH_DEPTH = 128;
 
@@ -377,6 +408,8 @@
 
     exports.getEqHashCode = getEqHashCode;
     exports.getEqualHashCode = getEqualHashCode;
+    exports.getEqvHashCode = getEqvHashCode;
+
     exports.hashMix = hashMix;
 
     exports.makeEqHashCode = makeEqHashCode;
@@ -386,9 +419,11 @@
     exports.makeEqvHashtable = makeEqvHashtable;
     exports.makeEqualHashtable = makeEqualHashtable;
 
+    exports.makeImmutableEqHashtable = makeImmutableEqHashtable;
+    exports.makeImmutableEqvHashtable = makeImmutableEqvHashtable;
+    exports.makeImmutableEqualHashtable = makeImmutableEqualHashtable;
+
     exports.isHash = isHash;
     exports.isHashEqv = isHashEqv;
     exports.isHashEq = isHashEq;
-
-
 }(window.plt.baselib, Hashtable));

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

@@ -15,6 +15,7 @@
     // show up outside this section!
     var isNumber = baselib.numbers.isNumber;
 
+    var isProcedure = baselib.functions.isProcedure;
     var isReal = baselib.numbers.isReal;
     var isInexact = baselib.numbers.isInexact;
     var isComplex = baselib.numbers.isComplex;
@@ -118,6 +119,8 @@
     var checkContinuationMarkSet = baselib.check.checkContinuationMarkSet;
     var checkExn = baselib.check.checkExn;
     var checkHash = baselib.check.checkHash;
+    var checkMutableHash = baselib.check.checkMutableHash;
+    var checkImmutableHash = baselib.check.checkImmutableHash;
     var checkAny = baselib.check.makeCheckArgumentType(
         function(x) { return true; },
         'any');
@@ -127,12 +130,6 @@
 
 
 
-
-
-
-
-
-
     // Primitives are the set of primitive values.  Not all primitives
     // are coded here; several of them (including call/cc) are injected by
     // the bootstrapping code in compiler/boostrapped-primitives.rkt
@@ -1385,7 +1382,7 @@
         'procedure?',
         1,
         function (M) {
-            return baselib.functions.isProcedure(M.e[M.e.length - 1]);
+            return isProcedure(M.e[M.e.length - 1]);
         });
 
     installPrimitiveProcedure(
@@ -2504,6 +2501,15 @@
 	return hash;
     };
 
+    var initializeImmutableHash = function(lst, hash) {
+	while (lst !== NULL) {
+	    hash = hash.functionalPut(lst.first.first, lst.first.rest);
+	    lst = lst.rest;
+	}
+	return hash;
+    };
+
+
     installPrimitiveProcedure(
         'hash?',
         1,
@@ -2544,15 +2550,48 @@
             return initializeHash(lst, plt.baselib.hashes.makeEqualHashtable());
         });
 
+    installPrimitiveProcedure(
+        'make-immutable-hasheq',
+        makeList(0, 1),
+        function(M) {
+            var lst = NULL;
+            if (M.a === 1) {
+                lst = checkListofPairs(M, 'make-hasheq', 0);
+            }
+            return initializeImmutableHash(lst, plt.baselib.hashes.makeImmutableEqHashtable());
+        });
+
+    installPrimitiveProcedure(
+        'make-immutable-hasheqv',
+        makeList(0, 1),
+        function(M) {
+            var lst = NULL;
+            if (M.a === 1) {
+                lst = checkListofPairs(M, 'make-hasheqv', 0);
+            }
+            return initializeImmutableHash(lst, plt.baselib.hashes.makeImmutableEqvHashtable());
+        });
+
+    installPrimitiveProcedure(
+        'make-immutable-hash',
+        makeList(0, 1),
+        function(M) {
+            var lst = NULL;
+            if (M.a === 1) {
+                lst = checkListofPairs(M, 'make-hash', 0);
+            }
+            return initializeImmutableHash(lst, plt.baselib.hashes.makeImmutableEqualHashtable());
+        });
+
     installPrimitiveClosure(
         'hash-ref',
         makeList(2, 3),
         function(M) {
             var hash = checkHash(M, 'hash-ref', 0);
             var key = checkAny(M, 'hash-ref', 1);
-            var thunk;
+            var thunkOrFailVal;
             if (M.a === 3) {
-                thunk = checkProcedure(M, 'hash-ref', 2);
+                thunkOrFailVal = checkAny(M, 'hash-ref', 2);
             }
             if (hash.containsKey(key)) {
                 finalizeClosureCall(M, hash.get(key));
@@ -2562,11 +2601,15 @@
                         M,
                         baselib.format.format("hash-ref: no value found for key: ~e",
                                            [key]));
-                } else {                    
+                } else {
-                    M.p = thunk;
+                    if (isProcedure(thunkOrFailVal)) {
-                    M.e.length -= M.a;
+                        M.p = thunkOrFailVal;
-                    M.a = 0;
+                        M.e.length -= M.a;
-                    baselib.functions.rawApply(M);
+                        M.a = 0;
+                        baselib.functions.rawApply(M);
+                    } else {
+                        finalizeClosureCall(M, thunkOrFailVal);
+                    }
                 }
             }
         });
@@ -2575,13 +2618,23 @@
         'hash-set!',
         3,
         function(M){ 
-            var hash = checkHash(M, 'hash-set!', 0);
+            var hash = checkMutableHash(M, 'hash-set!', 0);
             var key = checkAny(M, 'hash-set!', 1);
             var value = checkAny(M, 'hash-set!', 2);
             hash.put(key, value);
             return VOID;
         });
 
+    installPrimitiveProcedure(
+        'hash-set',
+        3,
+        function(M){ 
+            var hash = checkImmutableHash(M, 'hash-set', 0);
+            var key = checkAny(M, 'hash-set', 1);
+            var value = checkAny(M, 'hash-set', 2);
+            return hash.functionalPut(key, value);
+        });
+
     installPrimitiveProcedure(
         'hash-has-key?',
         2,

lang/kernel.rkt

@@ -153,8 +153,12 @@
          make-hash
          make-hasheqv
          make-hasheq
+         make-immutable-hash
+         make-immutable-hasheqv
+         make-immutable-hasheq
          hash-ref
          hash-set!
+         hash-set
          equal-hash-code
          
 

tests/more-tests/hashes.expected

@@ -21,3 +21,6 @@ not-found
 1
 1
 1
+danny
+dyoo@hashcollision.org
+unknown

tests/more-tests/hashes.rkt

@@ -61,4 +61,12 @@
 (hash-ref ht "test")
 (hash-ref ht "that")
 (hash-ref ht "only")
-(hash-ref ht "test!")
+(hash-ref ht "test!")
+
+
+(let* ([ht (make-immutable-hash)]
+       [ht (hash-set ht 'name "danny")]
+       [ht (hash-set ht 'email "dyoo@hashcollision.org")])
+  (displayln (hash-ref ht 'name "unknown"))
+  (displayln (hash-ref ht 'email "unknown"))
+  (displayln (hash-ref ht 'phone "unknown")))