fixing arity checks

assemble-helpers.rkt

@@ -12,7 +12,8 @@
          assemble-whole-prefix-reference
          assemble-reg
          assemble-label
-         assemble-input)
+         assemble-input
+         assemble-listof-assembled-values)
 
 
 (: assemble-oparg (OpArg -> String))
@@ -41,6 +42,8 @@
      "MACHINE.proc"]
     [(eq? target 'val)
      "MACHINE.val"]
+    [(eq? target 'argcount)
+     "MACHINE.argcount"]
     [(EnvLexicalReference? target)
      (assemble-lexical-reference target)]
     [(EnvPrefixReference? target)
@@ -71,6 +74,15 @@
               [else
                (format "~s" val)])))
 
+(: assemble-listof-assembled-values ((Listof String) -> String))
+(define (assemble-listof-assembled-values vals)
+  (let loop ([vals vals])
+    (cond
+      [(empty? vals)
+       "RUNTIME.NULL"]
+      [else
+       (format "[~a, ~a]" (first vals) (loop (rest vals)))])))
+
 
 
 

assemble.rkt

@@ -156,6 +156,8 @@ EOF
        empty]
       [(CheckClosureArity!? op)
        empty]
+      [(CheckPrimitiveArity!? op)
+       empty]
       [(ExtendEnvironment/Prefix!? op)
        empty]
       [(InstallClosureValues!? op)
@@ -337,7 +339,7 @@ EOF
     [(MakeCompiledProcedure? op)
      (format "new RUNTIME.Closure(~a, ~a, [~a], ~a)"
              (MakeCompiledProcedure-label op)
-             (MakeCompiledProcedure-arity op)
+             (assemble-arity (MakeCompiledProcedure-arity op))
              (string-join (map assemble-env-reference/closure-capture 
                                ;; The closure values are in reverse order
                                ;; to make it easier to push, in bulk, into
@@ -350,7 +352,7 @@ EOF
     [(MakeCompiledProcedureShell? op)
      (format "new RUNTIME.Closure(~a, ~a, undefined, ~a)"
              (MakeCompiledProcedureShell-label op)
-             (MakeCompiledProcedureShell-arity op)
+             (assemble-arity (MakeCompiledProcedureShell-arity op))
              (assemble-display-name (MakeCompiledProcedureShell-display-name op)))]
     
     [(ApplyPrimitiveProcedure? op)
@@ -382,6 +384,28 @@ EOF
      (open-code-kernel-primitive-procedure op)]))
 
 
+(define-predicate natural? Natural)
+
+(: assemble-arity (Arity -> String))
+(define (assemble-arity an-arity)
+  (cond
+    [(natural? an-arity)
+     (format "~a" an-arity)]
+    [(ArityAtLeast? an-arity)
+     (format "(new RUNTIME.ArityAtLeast(~a))" (ArityAtLeast-value an-arity))]
+    [(listof-atomic-arity? an-arity)
+     (assemble-listof-assembled-values
+      (map (lambda: ([atomic-arity : (U Natural ArityAtLeast)])
+                    (cond
+                      [(natural? atomic-arity)
+                       (format "~a" an-arity)]
+                      [(ArityAtLeast? an-arity)
+                       (format "(new RUNTIME.ArityAtLeast(~a))" (ArityAtLeast-value an-arity))]
+                      ;; Can't seem to make the type checker happy without this...
+                      [else (error 'assemble-arity)]))
+           an-arity))]))
+
+
 (: assemble-default-continuation-prompt-tag (-> String))
 (define (assemble-default-continuation-prompt-tag)
   "RUNTIME.DEFAULT_CONTINUATION_PROMPT_TAG")
@@ -402,7 +426,13 @@ EOF
              (CheckToplevelBound!-pos op))]
     
     [(CheckClosureArity!? op)
-     (format "if (! (MACHINE.proc instanceof RUNTIME.Closure && MACHINE.proc.arity === MACHINE.val)) { if (! (MACHINE.proc instanceof RUNTIME.Closure)) { throw new Error(\"not a closure\"); } else { throw new Error(\"arity failure\"); } }")]
+     (format "if (! (MACHINE.proc instanceof RUNTIME.Closure && RUNTIME.isArityMatching(MACHINE.proc.arity, ~a))) { if (! (MACHINE.proc instanceof RUNTIME.Closure)) { throw new Error(\"not a closure\"); } else { throw new Error(\"arity failure:\" + MACHINE.proc.displayName); } }"
+             (assemble-oparg (CheckClosureArity!-arity op)))]
+    
+    [(CheckPrimitiveArity!? op)
+     (format "if (! (typeof(MACHINE.proc) === 'function'  && RUNTIME.isArityMatching(MACHINE.proc.arity, ~a))) { if (! (typeof(MACHINE.proc) === 'function')) { throw new Error(\"not a primitive procedure\"); } else { throw new Error(\"arity failure:\" + MACHINE.proc.displayName); } }"
+             (assemble-oparg (CheckPrimitiveArity!-arity op)))]
+     
     
     [(ExtendEnvironment/Prefix!? op)
      (let: ([names : (Listof (U Symbol False ModuleVariable)) (ExtendEnvironment/Prefix!-names op)])

il-structs.rkt

@@ -365,13 +365,13 @@
 
 
 
-
+(define-type Arity (U Natural ArityAtLeast (Listof (U Natural ArityAtLeast))))
-(define-type Arity (U Natural
-                      ArityAtLeast
-                      (Listof (U Natural ArityAtLeast))))
 (define-struct: ArityAtLeast ([value : Natural])
   #:transparent)
 
+(define-predicate listof-atomic-arity? (Listof (U Natural ArityAtLeast)))
+
+
 
 
 (define-predicate OpArg? OpArg)

runtime.js

@@ -29,14 +29,16 @@
     var isNumber = function(x) { return typeof(x) === 'number'; };
 
     var isPair = function(x) { return (typeof(x) == 'object' && 
-				       x.length === 2) }
+				       x.length === 2) };
+
     var isVector = function(x) { return (typeof(x) == 'object' && 
-					 x.length !== undefined) }
+					 x.length !== undefined) };
 
     var Machine = function() {
 	this.callsBeforeTrampoline = 100;
 	this.val = undefined;
 	this.proc = undefined;
+	this.argcount = undefined;
 	this.env = [];
 	this.control = [];     // Arrayof (U CallFrame PromptFrame)
 	this.running = false;
@@ -234,10 +236,33 @@
     }
 
 
+    // An arity is either a primitive number, an ArityAtLeast instance,
+    // or a list of either primitive numbers or ArityAtLeast instances.
+
     var ArityAtLeast = function(n) {
 	this.value = n;
     };
 
+    // isArityMatching: arity natural -> boolean
+    // Produces true if n satisfies the arity.
+    var isArityMatching = function(arity, n) {
+	if (typeof(arity) === 'number') {
+	    return arity === n;
+	} else if (arity instanceof ArityAtLeast) {
+	    return n >= arity.value;
+	} else {
+	    while (arity !== NULL) {
+		if (typeof(arity[0]) === 'number') {
+		    if (arity[0] === n) { return true; }
+		} else if (arity instanceof ArityAtLeast) {
+		    if (n >= arity[0].value) { return true; }
+		}
+		arity = arity[1];
+	    }
+	    return false;
+	}
+    }
+
 
 
 
@@ -248,40 +273,39 @@
     // the bootstrapping code.
     var Primitives = {};
     Primitives['display'] = function(MACHINE, arity) {
-	testArity('display', arity, 1, 2);
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	var outputPort = MACHINE.params.currentOutputPort;
-	if (arity == 2) { 
+	if (arity === 2) { 
 	    outputPort = MACHINE.env[MACHINE.env.length-2];
 	}
 	outputPort.write(MACHINE, firstArg);
     };
-    // FIXME: need to make a case dispatch here on arity.
+    Primitives['display'].arity = [1, [2, NULL]];
-    Primitives['display'].arity = 1; //new ArityAtLeast(1);
+    Primitives['display'].displayName = 'display';
 
 
     Primitives['newline'] = function(MACHINE, arity) {
-	testArity('newline', arity, 0, 1);
 	var outputPort = MACHINE.params.currentOutputPort;
-	if (arity == 1) { 
+	if (arity === 1) { 
 	    outputPort = MACHINE.env[MACHINE.env.length-1];
 	}
 	outputPort.write(MACHINE, "\n");
     };
-    Primitives['newline'].arity = 1; //new ArityAtLeast(1);
+    Primitives['newline'].arity = [0, [1, NULL]];
+    Primitives['newline'].displayName = 'newline';
 
 
     Primitives['displayln'] = function(MACHINE, arity){
-	testArity('displayln', arity, 1, 2);
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	var outputPort = MACHINE.params.currentOutputPort;
-	if (arity == 2) { 
+	if (arity === 2) { 
 	    outputPort = MACHINE.env[MACHINE.env.length-2];
 	}
 	outputPort.write(MACHINE, firstArg);
 	outputPort.write(MACHINE, "\n");
     };
-    Primitives['displayln'].arity = 1; //new ArityAtLeast(1);
+    Primitives['displayln'].arity = [1, [2, NULL]];
+    Primitives['displayln'].displayName = 'displayln';
 
     Primitives['pi'] = Math.PI;
 
@@ -304,6 +328,7 @@
 	return true;
     };
     Primitives['='].arity = new ArityAtLeast(2);
+    Primitives['='].displayName = '=';
 
 
     Primitives['<'] = function(MACHINE, arity) {
@@ -323,6 +348,7 @@
 	return true;
     };
     Primitives['<'].arity = new ArityAtLeast(2);
+    Primitives['<'].displayName = '<';
 
     Primitives['>'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -341,6 +367,7 @@
 	return true;
     };
     Primitives['>'].arity = new ArityAtLeast(2);
+    Primitives['>'].displayName = '>';
 
     Primitives['<='] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -359,6 +386,7 @@
 	return true;
     };
     Primitives['<='].arity = new ArityAtLeast(2);
+    Primitives['<='].displayName = '<=';
 
 
     Primitives['>='] = function(MACHINE, arity) {
@@ -378,6 +406,7 @@
 	return true;
     };
     Primitives['>='].arity = new ArityAtLeast(2);
+    Primitives['>='].displayName = '>=';
     
 
     Primitives['+'] = function(MACHINE, arity) {
@@ -395,6 +424,7 @@
 	return result;
     };
     Primitives['+'].arity = new ArityAtLeast(0);
+    Primitives['+'].displayName = '+';
     
 
     Primitives['*'] = function(MACHINE, arity) {
@@ -412,6 +442,7 @@
 	return result;
     };
     Primitives['*'].arity = new ArityAtLeast(0);
+    Primitives['*'].displayName = '*';
     
     Primitives['-'] = function(MACHINE, arity) {
 	if (arity === 1) { 
@@ -434,6 +465,7 @@
 	return result;
     };
     Primitives['-'].arity = new ArityAtLeast(1);
+    Primitives['-'].displayName = '-';
     
     Primitives['/'] = function(MACHINE, arity) {
 	testArgument('number',
@@ -448,6 +480,8 @@
 	return result;
     };
     Primitives['/'].arity = new ArityAtLeast(1);
+    Primitives['/'].displayName = '/';
+    
 
     Primitives['cons'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -455,6 +489,7 @@
 	return [firstArg, secondArg];
     };
     Primitives['cons'].arity = 2;
+    Primitives['cons'].displayName = 'cons';
 
 
     Primitives['list'] = function(MACHINE, arity) {
@@ -466,6 +501,7 @@
 	return result;
     };
     Primitives['list'].arity = new ArityAtLeast(0);
+    Primitives['list'].displayName = 'list';
 
     Primitives['car'] = function(MACHINE, arity) {
 	testArgument('pair',
@@ -477,6 +513,7 @@
 	return firstArg[0];
     };
     Primitives['car'].arity = 1;
+    Primitives['car'].displayName = 'car';
 
     Primitives['cdr'] = function(MACHINE, arity) {
 	testArgument('pair',
@@ -488,12 +525,14 @@
 	return firstArg[1];
     };
     Primitives['cdr'].arity = 1;
+    Primitives['cdr'].displayName = 'cdr';
 
     Primitives['pair?'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	return isPair(firstArg);
     };
     Primitives['pair?'].arity = 1;
+    Primitives['pair?'].displayName = 'pair?';
 
     Primitives['set-car!'] = function(MACHINE, arity) {
 	testArgument('pair',
@@ -505,7 +544,8 @@
 	var secondArg = MACHINE.env[MACHINE.env.length-2];
 	firstArg[0] = secondArg;
     };
-    Primitives['set-car!'].arity = 1;
+    Primitives['set-car!'].arity = 2;
+    Primitives['set-car!'].displayName = 'set-car!';
 
     Primitives['set-cdr!'] = function(MACHINE, arity) {
 	testArgument('pair',
@@ -517,13 +557,15 @@
 	var secondArg = MACHINE.env[MACHINE.env.length-2];
 	firstArg[1] = secondArg;
     };
-    Primitives['set-cdr!'].arity = 1;
+    Primitives['set-cdr!'].arity = 2;
+    Primitives['set-cdr!'].displayName = 'set-cdr!';
     
     Primitives['not'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	return (!firstArg);
     };
     Primitives['not'].arity = 1;
+    Primitives['not'].displayName = 'not';
 
     Primitives['null'] = NULL;
 
@@ -532,6 +574,7 @@
 	return firstArg === NULL;
     };
     Primitives['null?'].arity = 1;
+    Primitives['null?'].displayName = 'null?';
 
     Primitives['add1'] = function(MACHINE, arity) {
 	testArgument('number',
@@ -543,6 +586,7 @@
 	return firstArg + 1;
     };
     Primitives['add1'].arity = 1;
+    Primitives['add1'].displayName = 'add1';
 
     Primitives['sub1'] = function(MACHINE, arity) {
 	testArgument('number',
@@ -554,12 +598,14 @@
 	return firstArg - 1;
     };
     Primitives['sub1'].arity = 1;
+    Primitives['sub1'].displayName = 'sub1';
 
     Primitives['zero?'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	return firstArg === 0;
     };
     Primitives['zero?'].arity = 1;
+    Primitives['zero?'].displayName = 'zero?';
 
     Primitives['vector'] = function(MACHINE, arity) {
 	var i;
@@ -570,6 +616,7 @@
 	return result;
     };
     Primitives['vector'].arity = new ArityAtLeast(0);
+    Primitives['vector'].displayName = 'vector';
 
     Primitives['vector->list'] = function(MACHINE, arity) {
 	testArgument('vector',
@@ -586,6 +633,7 @@
 	return result;
     };
     Primitives['vector->list'].arity = 1;
+    Primitives['vector->list'].displayName = 'vector->list';
     
     Primitives['list->vector'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -597,6 +645,7 @@
 	return result;
     };
     Primitives['list->vector'].arity = 1;
+    Primitives['list->vector'].displayName = 'list->vector';
 
     Primitives['vector-ref'] = function(MACHINE, arity) {
 	testArgument('vector',
@@ -609,6 +658,7 @@
 	return firstArg[secondArg];
     };
     Primitives['vector-ref'].arity = 2;
+    Primitives['vector-ref'].displayName = 'vector-ref';
 
     Primitives['vector-set!'] = function(MACHINE, arity) {
 	testArgument('vector',
@@ -623,18 +673,21 @@
 	return null;
     };
     Primitives['vector-set!'].arity = 3;
+    Primitives['vector-set!'].displayName = 'vector-set!';
 
     Primitives['symbol?'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	return typeof(firstArg) === 'string';
     };
     Primitives['symbol?'].arity = 1;
+    Primitives['symbol?'].displayName = 'symbol?';
 
     Primitives['symbol->string'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	return firstArg;
     };
     Primitives['symbol->string'].arity = 1;
+    Primitives['symbol->string'].displayName = 'symbol->string';
 
     Primitives['string-append'] = function(MACHINE, arity) {
 	var buffer = [];
@@ -645,12 +698,14 @@
 	return buffer.join('');
     };
     Primitives['string-append'].arity = new ArityAtLeast(0);
+    Primitives['string-append'].displayName = 'string-append';
 
     Primitives['string-length'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	return firstArg.length;
     };
     Primitives['string-length'].arity = 1;
+    Primitives['string-length'].displayName = 'string-length';
     
     Primitives['box'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -658,12 +713,14 @@
 	return result;
     };
     Primitives['box'].arity = 1;
+    Primitives['box'].displayName = 'box';
 
     Primitives['unbox'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
 	return firstArg[0];
     };
     Primitives['unbox'].arity = 1;
+    Primitives['unbox'].displayName = 'unbox';
 
     Primitives['set-box!'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -672,11 +729,13 @@
 	return;
     };
     Primitives['set-box!'].arity = 2;
+    Primitives['set-box!'].displayName = 'set-box!';
 
     Primitives['void'] = function(MACHINE, arity) {
 	return;
     };
     Primitives['void'].arity = new ArityAtLeast(0);
+    Primitives['void'].displayName = 'void';
 
     Primitives['eq?'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -684,6 +743,7 @@
 	return firstArg === secondArg;
     };
     Primitives['eq?'].arity = 2;
+    Primitives['eq?'].displayName = 'eq?';
 
     Primitives['equal?'] = function(MACHINE, arity) {
 	var firstArg = MACHINE.env[MACHINE.env.length-1];
@@ -708,6 +768,7 @@
 	return true;
     };
     Primitives['equal?'].arity = 2;
+    Primitives['equal?'].displayName = 'equal?';
 
 
 
@@ -793,6 +854,9 @@
     exports['isOutputPort'] = isOutputPort;
     exports['isOutputStringPort'] = isOutputStringPort;
 
+    exports['ArityAtLeast'] = ArityAtLeast;
+    exports['isArityMatching'] = isArityMatching;
+
     exports['heir'] = heir;
     exports['makeClassPredicate'] = makeClassPredicate;
 

simulator-primitives.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
 (require "simulator-structs.rkt"
+         "il-structs.rkt"
          racket/math
          (for-syntax racket/base))
 

simulator-structs.rkt

@@ -39,6 +39,7 @@
 
 (define-struct: machine ([val : SlotValue]
                          [proc : SlotValue]
+                         [argcount : SlotValue]
                          [env : (Listof SlotValue)]
                          [control : (Listof frame)]
 

simulator.rkt

@@ -49,6 +49,7 @@
                                  [else
                                   program-text])])
             (let: ([m : machine (make-machine (make-undefined)
+                                              (make-undefined)
                                               (make-undefined)
                                               '() 
                                               '()
@@ -126,7 +127,9 @@
                             (cond [(eq? reg 'val)
                                    (jump! m (ensure-symbol (machine-val m)))]
                                   [(eq? reg 'proc)
-                                   (jump! m (ensure-symbol (machine-proc m)))])]))])))
+                                   (jump! m (ensure-symbol (machine-proc m)))]
+                                  [(eq? reg 'argcount)
+                                   (error 'goto "argcount misused as jump source")])]))])))
 
 (: step-assign-immediate! (machine AssignImmediateStatement -> 'ok))
 (define (step-assign-immediate! m stmt)
@@ -194,7 +197,9 @@
   (cond [(eq? reg 'val)
          (machine-val m)]
         [(eq? reg 'proc)
-         (machine-proc m)]))
+         (machine-proc m)]
+        [(eq? reg 'argcount)
+         (machine-argcount m)]))
 
 
 (: lookup-env-reference/closure-capture (machine EnvReference -> SlotValue))
@@ -339,6 +344,8 @@
      proc-update!]
     [(eq? t 'val)
      val-update!]
+    [(eq? t 'argcount)
+     argcount-update!]
     [(EnvLexicalReference? t)
      (lambda: ([m : machine] [v : SlotValue])
               (if (EnvLexicalReference-unbox? t)
@@ -562,7 +569,9 @@
              [(eq? n 'proc)
               (machine-proc m)]
              [(eq? n 'val)
-              (machine-val m)]))]
+              (machine-val m)]
+             [(eq? n 'argcount)
+              (machine-argcount m)]))]
     
     [(EnvLexicalReference? an-oparg)
      (let*: ([v : SlotValue
@@ -704,7 +713,7 @@
 (: current-instruction (machine -> Statement))
 (define (current-instruction m)
   (match m
-    [(struct machine (val proc env control pc text
+    [(struct machine (val proc argcount env control pc text
                           stack-size jump-table))
      (vector-ref text pc)]))
 
@@ -715,6 +724,10 @@
   (set-machine-val! m v)
   'ok)
 
+(: argcount-update! (machine SlotValue -> 'ok))
+(define (argcount-update! m v)
+  (set-machine-argcount! m v)
+  'ok)
 
 (: proc-update! (machine SlotValue -> 'ok))
 (define (proc-update! m v)
@@ -725,7 +738,7 @@
 (: env-push! (machine SlotValue -> 'ok))
 (define (env-push! m v)
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (set-machine-env! m (cons v env))
      (set-machine-stack-size! m (add1 stack-size))
      'ok]))
@@ -733,7 +746,7 @@
 (: env-push-many! (machine (Listof SlotValue) -> 'ok))
 (define (env-push-many! m vs)
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (set-machine-env! m (append vs env))
      (set-machine-stack-size! m (+ stack-size (length vs)))
      'ok]))
@@ -742,13 +755,13 @@
 (: env-ref (machine Natural -> SlotValue))
 (define (env-ref m i)  
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (list-ref env i)]))
 
 (: env-mutate! (machine Natural SlotValue -> 'ok))
 (define (env-mutate! m i v)
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (set-machine-env! m (list-replace env i v))
      'ok]))
 
@@ -766,7 +779,7 @@
 (: env-pop! (machine Natural Natural -> 'ok))
 (define (env-pop! m n skip)     
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (set-machine-env! m (append (take env skip)
                                  (drop env (+ skip n))))
      (set-machine-stack-size! m (ensure-natural (- stack-size n)))
@@ -776,7 +789,7 @@
 (: control-push! (machine frame -> 'ok))
 (define (control-push! m a-frame)
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (set-machine-control! m (cons a-frame control))
      'ok]))
 
@@ -784,14 +797,14 @@
 (: control-pop! (machine -> 'ok))
 (define (control-pop! m)
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (set-machine-control! m (rest control))
      'ok]))
 
 (: control-top (machine -> frame))
 (define (control-top m)
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (first control)]))
 
 
@@ -807,7 +820,7 @@
 ;; Jumps directly to the instruction at the given label.
 (define (jump! m l)
   (match m
-    [(struct machine (val proc env control pc text stack-size jump-table))
+    [(struct machine (val proc argcount env control pc text stack-size jump-table))
      (set-machine-pc! m (hash-ref jump-table l))
      'ok]))
 

test-assemble.rkt

@@ -250,7 +250,7 @@
                                                                                   (list 0 1)
                                                                                   'closureStart))
                     (make-PopEnvironment 2 0)
-                    (make-PerformStatement (make-CheckClosureArity! 5)))))
+                    (make-PerformStatement (make-CheckClosureArity! (make-Const 5))))))
 
 ;; this should fail, since the check is for 1, but the closure expects 5.
 (let/ec return
@@ -272,7 +272,7 @@
                                                                                 (list 0 1)
                                                                                 'closureStart))
                   (make-PopEnvironment 2 0)
-                  (make-PerformStatement (make-CheckClosureArity! 1)))))
+                  (make-PerformStatement (make-CheckClosureArity! (make-Const 1))))))
   (error 'expected-failure))
 
 

test-simulator.rkt

@@ -323,10 +323,12 @@
 
 ;; install-closure-values
 (let ([m  
-       (make-machine (make-undefined) (make-closure 'procedure-entry
+       (make-machine (make-undefined) 
-                                                    0
+                     (make-closure 'procedure-entry
-                                                    (list 1 2 3)
+                                   0
-                                                    'procedure-entry)
+                                   (list 1 2 3)
+                                   'procedure-entry)
+                     (make-undefined)
                      (list true false) ;; existing environment holds true, false
                      '() 
                      0 
@@ -343,6 +345,7 @@
 (let ([m 
        (make-machine (make-undefined) 
                      (make-closure 'procedure-entry 0 (list 1 2 3) 'procedure-entry)
+                     (make-undefined)
                      (list true false) ;; existing environment holds true, false
                      '() 
                      0