From fd28c199e9a8b3515c8f114c2b7977287751d2c4 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 3 Nov 2011 18:12:30 -0400 Subject: [PATCH] hashes beginning to run. --- compiler/kernel-primitives.rkt | 6 ++ js-assembler/runtime-src/baselib-check.js | 5 ++ .../runtime-src/baselib-exceptions.js | 6 ++ js-assembler/runtime-src/baselib-functions.js | 52 +++++--------- js-assembler/runtime-src/baselib-hashes.js | 14 +++- .../runtime-src/baselib-primitives.js | 71 ++++++++++++++++--- lang/kernel.rkt | 5 +- tests/more-tests/hashes.rkt | 36 ++++++++++ 8 files changed, 149 insertions(+), 46 deletions(-) create mode 100644 tests/more-tests/hashes.rkt diff --git a/compiler/kernel-primitives.rkt b/compiler/kernel-primitives.rkt index 616bac0..472cd09 100644 --- a/compiler/kernel-primitives.rkt +++ b/compiler/kernel-primitives.rkt @@ -88,6 +88,12 @@ 'raise-type-error 'struct:exn:fail 'prop:exn:srclocs + + 'hash? + 'make-hash + 'make-hasheqv + 'make-hasheq + )) (define-predicate KernelPrimitiveName? KernelPrimitiveName) diff --git a/js-assembler/runtime-src/baselib-check.js b/js-assembler/runtime-src/baselib-check.js index 7b3af48..d207bfa 100644 --- a/js-assembler/runtime-src/baselib-check.js +++ b/js-assembler/runtime-src/baselib-check.js @@ -255,6 +255,10 @@ baselib.exceptions.isExn, 'exn'); + var checkHash = makeCheckArgumentType( + baselib.hashes.isHash, + 'hash'); + ////////////////////////////////////////////////////////////////////// @@ -293,5 +297,6 @@ exports.checkContinuationMarkSet = checkContinuationMarkSet; exports.checkContinuationPromptTag = checkContinuationPromptTag; exports.checkExn = checkExn; + exports.checkHash = checkHash; }(this.plt.baselib)); diff --git a/js-assembler/runtime-src/baselib-exceptions.js b/js-assembler/runtime-src/baselib-exceptions.js index 98df0a2..e2ea93f 100644 --- a/js-assembler/runtime-src/baselib-exceptions.js +++ b/js-assembler/runtime-src/baselib-exceptions.js @@ -79,6 +79,11 @@ }; + var raiseContractError = function(MACHINE, msg) { + var contMarks = MACHINE.captureContinuationMarks(); + raise(MACHINE, ExnFailContract.constructor(msg, contMarks)); + }; + var raiseUnboundToplevelError = function(MACHINE, name) { @@ -224,6 +229,7 @@ exceptions.raise = raise; + exceptions.raiseContractError = raiseContractError; exceptions.raiseUnboundToplevelError = raiseUnboundToplevelError; exceptions.raiseArgumentTypeError = raiseArgumentTypeError; exceptions.raiseContextExpectedValuesError = raiseContextExpectedValuesError; diff --git a/js-assembler/runtime-src/baselib-functions.js b/js-assembler/runtime-src/baselib-functions.js index 83f6424..7931a6c 100644 --- a/js-assembler/runtime-src/baselib-functions.js +++ b/js-assembler/runtime-src/baselib-functions.js @@ -21,13 +21,6 @@ - var isPrimitiveProcedure = function (x) { - return typeof (x) === 'function'; - }; - - - - @@ -207,9 +200,7 @@ // It assumes that it must begin its own trampoline. var asJavaScriptFunction = function (v, MACHINE) { MACHINE = MACHINE || plt.runtime.currentMachine; - if (isPrimitiveProcedure(v)) { - return coersePrimitiveToJavaScript(v, MACHINE); - } else if (isClosure(v)) { + if (isClosure(v)) { return coerseClosureToJavaScript(v, MACHINE); } else { baselib.exceptions.raise(MACHINE, @@ -234,18 +225,7 @@ MACHINE.captureContinuationMarks())); } - if (isPrimitiveProcedure(proc)) { - oldArgcount = MACHINE.a; - MACHINE.a = arguments.length - 4; - for (i = 0; i < arguments.length - 4; i++) { - MACHINE.e.push(arguments[arguments.length - 1 - i]); - } - var result = proc(MACHINE); - for (i = 0; i < arguments.length - 4; i++) { - MACHINE.e.pop(); - } - success(result); - } else if (isClosure(proc)) { + if (isClosure(proc)) { oldVal = MACHINE.v; oldArgcount = MACHINE.a; oldProc = MACHINE.p; @@ -339,20 +319,24 @@ var renameProcedure = function (f, name) { - if (isPrimitiveProcedure(f)) { - return makePrimitiveProcedure( - name, - f.racketArity, - function (MACHINE) { - return f(MACHINE); - }); - } else { - return makeClosure(name, f.racketArity, f.label, f.closedVals); - } + return makeClosure(name, f.racketArity, f.label, f.closedVals); }; + // Applying a procedure. + // Assumptions: the procedure register has been assigned, as has + // the argcount and environment. + // Must be running in the context of a trampoline. + var rawApply = function(M) { + M.cbt--; + if (baselib.arity.isArityMatching(M.p.racketArity, M.a)) { + return M.p.label(M); + } else { + baselib.exceptions.raiseArityMismatchError(M, M.p, M.a); + } + }; + ////////////////////////////////////////////////////////////////////// @@ -363,7 +347,6 @@ exports.makePrimitiveProcedure = makePrimitiveProcedure; exports.makeClosure = makeClosure; - exports.isPrimitiveProcedure = isPrimitiveProcedure; exports.isClosure = isClosure; exports.isProcedure = isProcedure; @@ -371,7 +354,8 @@ exports.renameProcedure = renameProcedure; - exports.asJavaScriptFunction = asJavaScriptFunction; + exports.rawApply = rawApply; + }(this.plt.baselib, this.plt)); \ No newline at end of file diff --git a/js-assembler/runtime-src/baselib-hashes.js b/js-assembler/runtime-src/baselib-hashes.js index a168006..9f5a354 100644 --- a/js-assembler/runtime-src/baselib-hashes.js +++ b/js-assembler/runtime-src/baselib-hashes.js @@ -134,18 +134,26 @@ return true; }; - WhalesongHashtable.prototype.ref = function(key) { + + + + + WhalesongHashtable.prototype.get = function(key) { return this.hash.get(key); }; - WhalesongHashtable.prototype.set = function(key, value) { - return this.hash.put(key, value); + WhalesongHashtable.prototype.put = function(key, value) { + this.hash.put(key, value); }; WhalesongHashtable.prototype.remove = function(key) { this.hash.remove(key); }; + WhalesongHashtable.prototype.containsKey = function(key) { + return this.hash.containsKey(key); + }; + var isHash = function (x) { return (x instanceof WhalesongHashtable); }; diff --git a/js-assembler/runtime-src/baselib-primitives.js b/js-assembler/runtime-src/baselib-primitives.js index f7f5996..f24d611 100644 --- a/js-assembler/runtime-src/baselib-primitives.js +++ b/js-assembler/runtime-src/baselib-primitives.js @@ -116,6 +116,10 @@ var checkContinuationPromptTag = baselib.check.checkContinuationPromptTag; var checkContinuationMarkSet = baselib.check.checkContinuationMarkSet; var checkExn = baselib.check.checkExn; + var checkHash = baselib.check.checkHash; + var checkAny = baselib.check.makeCheckArgumentType( + function(x) { return true; }, + 'any'); ////////////////////////////////////////////////////////////////////// @@ -1354,17 +1358,14 @@ M.a--; checkList(M, 'apply', M.a - 1); M.spliceListIntoStack(M.a - 1); + M.p = proc; if (baselib.arity.isArityMatching(proc.racketArity, M.a)) { - M.p = proc; - if (baselib.functions.isPrimitiveProcedure(proc)) { - return finalizeClosureCall(M, proc(M)); - } else { - return proc.label(M); - } + return proc.label(M); } else { raiseArityMismatchError(M, proc, M.a); } }; + installPrimitiveClosure( 'apply', baselib.arity.makeArityAtLeast(2), @@ -2263,14 +2264,14 @@ }); }); - installPrimitiveClosure( + installPrimitiveProcedure( 'struct?', 1, function(M) { return isStruct(M.e[M.e.length - 1]); }); - installPrimitiveClosure( + installPrimitiveProcedure( 'struct-type?', 1, function(M) { @@ -2502,6 +2503,13 @@ return hash; }; + installPrimitiveProcedure( + 'hash?', + 1, + function(M) { + return baselib.hashes.isHash(checkAny(M, 'hash?', 0)); + }); + installPrimitiveProcedure( 'make-hasheq', makeList(0, 1), @@ -2535,6 +2543,53 @@ return initializeHash(lst, plt.baselib.hashes.makeEqualHashtable()); }); + installPrimitiveClosure( + 'hash-ref', + makeList(2, 3), + function(M) { + var hash = checkHash(M, 'hash-ref', 0); + var key = checkAny(M, 'hash-ref', 1); + var thunk; + if (M.a === 3) { + thunk = checkProcedure(M, 'hash-ref', 2); + } + if (hash.containsKey(key)) { + finalizeClosureCall(M, hash.get(key)); + } else { + if (M.a === 2) { + raiseContractError( + plt.baselib.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(); + } + } + }); + + installPrimitiveProcedure( + 'hash-set!', + 3, + function(M){ + var hash = checkHash(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-has-key?', + 2, + function(M){ + var hash = checkHash(M, 'hash-set!', 0); + var key = checkAny(M, 'hash-set!', 1); + return hash.containsKey(key); + }); + + exports['Primitives'] = Primitives; exports['installPrimitiveProcedure'] = installPrimitiveProcedure; exports['installPrimitiveClosure'] = installPrimitiveClosure; diff --git a/lang/kernel.rkt b/lang/kernel.rkt index a561a12..a79c723 100644 --- a/lang/kernel.rkt +++ b/lang/kernel.rkt @@ -149,7 +149,10 @@ let/cc with-continuation-mark - + hash? + make-hash + make-hasheqv + make-hasheq diff --git a/tests/more-tests/hashes.rkt b/tests/more-tests/hashes.rkt new file mode 100644 index 0000000..d2e4089 --- /dev/null +++ b/tests/more-tests/hashes.rkt @@ -0,0 +1,36 @@ +#lang planet dyoo/whalesong/base + +(hash? 1) +(hash? "potatoes") +(hash? (make-hash)) +(hash? (make-hash '((1 . one) + (2 . two) + (3 . three) + (4 . four)))) +(hash? (make-hasheqv)) +(hash? (make-hasheqv '((1 . one) + (2 . two) + (3 . three) + (4 . four)))) +(hash? (make-hasheq)) +(hash? (make-hasheq '((1 . one) + (2 . two) + (3 . three) + (4 . four)))) + +(make-hash) +(make-hasheqv) +(make-hasheq) + +(make-hash '((1 . one) + (2 . two) + (3 . three) + (4 . four))) +(make-hasheqv '((1 . one) + (2 . two) + (3 . three) + (4 . four))) +(make-hasheq '((1 . one) + (2 . two) + (3 . three) + (4 . four))) \ No newline at end of file