diff --git a/compiler/kernel-primitives.rkt b/compiler/kernel-primitives.rkt index 1141792..e9aa2bc 100644 --- a/compiler/kernel-primitives.rkt +++ b/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) diff --git a/js-assembler/runtime-src/baselib-check.js b/js-assembler/runtime-src/baselib-check.js index d207bfa..10b4119 100644 --- a/js-assembler/runtime-src/baselib-check.js +++ b/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)); diff --git a/js-assembler/runtime-src/baselib-hashes.js b/js-assembler/runtime-src/baselib-hashes.js index c68fe22..50688f5 100644 --- a/js-assembler/runtime-src/baselib-hashes.js +++ b/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, - new Hashtable(getEqvHashCode, baselib.equality.eqv)); + 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 = LLRBTree.makeMap(keycmp); + this.map = map; }; 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)); \ No newline at end of file diff --git a/js-assembler/runtime-src/baselib-primitives.js b/js-assembler/runtime-src/baselib-primitives.js index 7cf7019..b2b0851 100644 --- a/js-assembler/runtime-src/baselib-primitives.js +++ b/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 { - M.p = thunk; - M.e.length -= M.a; - M.a = 0; - baselib.functions.rawApply(M); + } else { + if (isProcedure(thunkOrFailVal)) { + M.p = thunkOrFailVal; + M.e.length -= M.a; + 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, diff --git a/lang/kernel.rkt b/lang/kernel.rkt index 135d78a..ee1eb2e 100644 --- a/lang/kernel.rkt +++ b/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 diff --git a/tests/more-tests/hashes.expected b/tests/more-tests/hashes.expected index 824533c..9437153 100644 --- a/tests/more-tests/hashes.expected +++ b/tests/more-tests/hashes.expected @@ -21,3 +21,6 @@ not-found 1 1 1 +danny +dyoo@hashcollision.org +unknown diff --git a/tests/more-tests/hashes.rkt b/tests/more-tests/hashes.rkt index 5a815ff..c735e4c 100644 --- a/tests/more-tests/hashes.rkt +++ b/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!") \ No newline at end of file +(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")))