hashes beginning to run.

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)
 

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));

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;

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)) {
+        if (isClosure(v)) {
-            return coersePrimitiveToJavaScript(v, MACHINE);
-        } else if (isClosure(v)) {
             return coerseClosureToJavaScript(v, MACHINE);
         } else {
             baselib.exceptions.raise(MACHINE,
@@ -234,18 +225,7 @@
                                                                     MACHINE.captureContinuationMarks()));
         }
 
-        if (isPrimitiveProcedure(proc)) {
+        if (isClosure(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)) {
             oldVal = MACHINE.v;
             oldArgcount = MACHINE.a;
             oldProc = MACHINE.p;
@@ -339,20 +319,24 @@
 
 
     var renameProcedure = function (f, name) {
-        if (isPrimitiveProcedure(f)) {
+        return makeClosure(name, f.racketArity, f.label, f.closedVals);
-            return makePrimitiveProcedure(
-                name,
-                f.racketArity,
-                function (MACHINE) {
-                    return f(MACHINE);
-                });
-        } else {
-            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));

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) {
+    WhalesongHashtable.prototype.put = function(key, value) {
-        return this.hash.put(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);
     };

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;
+            return proc.label(M);
-            if (baselib.functions.isPrimitiveProcedure(proc)) {
-                return finalizeClosureCall(M, proc(M));
-            } else {
-                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;

lang/kernel.rkt

@@ -149,7 +149,10 @@
          let/cc
 	 with-continuation-mark
 
-
+         hash?
+         make-hash
+         make-hasheqv
+         make-hasheq
          
 
 

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)))