in the middle of re-enabling primitive application. I need to now statically determine whether an application is primitive or not.

compiler/compiler.rkt

@@ -960,12 +960,7 @@
               (default)]))]
         [(ModuleVariable? op-knowledge)
          (cond
-           [(or (symbol=? (ModuleLocator-name
+           [(kernel-module-locator? (ModuleVariable-module-name op-knowledge))
-                           (ModuleVariable-module-name op-knowledge))
-                          '#%kernel)
-                (symbol=? (ModuleLocator-name
-                           (ModuleVariable-module-name op-knowledge))
-                          'whalesong/lang/kernel.rkt))
             (let ([op (ModuleVariable-name op-knowledge)])
               (cond [(KernelPrimitiveName/Inline? op)
                      (compile-open-codeable-application op exp cenv target linkage)]
@@ -984,6 +979,21 @@
            (make-RaiseOperatorApplicationError! (make-Reg 'proc))))]))))
 
 
+
+(: kernel-module-locator? (ModuleLocator -> Boolean))
+;; Produces true if the ModuleLocator is pointing to a module that's marked
+;; as kernel.
+(define (kernel-module-locator? a-module-locator)
+  (or (symbol=? (ModuleLocator-name
+                 a-module-locator)
+                '#%kernel)
+      (symbol=? (ModuleLocator-name
+                 a-module-locator)
+                'whalesong/lang/kernel.rkt)))
+
+  
+  
+
 (: compile-general-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence))
 (define (compile-general-application exp cenv target linkage)
   (let* ([extended-cenv
@@ -1423,38 +1433,37 @@
        linkage
        cenv
        (append-instruction-sequences
-        ;; (make-TestAndJumpStatement (make-TestPrimitiveProcedure
-        ;;                             (make-Reg 'proc))
-        ;;                            primitive-branch)
-        
-        
-        ;; Compiled branch
         (make-PerformStatement (make-CheckClosureAndArity!))
         (compile-compiled-procedure-application cenv
                                                 number-of-arguments
                                                 'dynamic
                                                 target
                                                 compiled-linkage)
-        
-        ;; Primitive branch
-        ;; primitive-branch
-        ;; (make-PerformStatement (make-CheckPrimitiveArity! (make-Reg 'argcount)))
-        ;; (compile-primitive-application cenv target primitive-linkage)
         after-call)))))
 
 
+;; If we know the procedure is implemented as a primitive (as opposed to a general closure),
+;; we can do a little less work.
+;; Assumes 1. the procedure value is loaded into proc,
+;;         2. number-of-arguments has been written into the argcount register,
+; ;        3. the number-of-arguments values are on the stack.
+(: compile-primitive-procedure-call (CompileTimeEnvironment OpArg Target Linkage 
+                                                            -> InstructionSequence))
+(define (compile-primitive-procedure-call cenv number-of-arguments target linkage)
+  (end-with-linkage
+   linkage
+   cenv
+   (append-instruction-sequences
+    (make-PerformStatement (make-CheckPrimitiveArity!))
+    (make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure))
+    (make-PopEnvironment number-of-arguments (make-Const 0))
+    (if (eq? target 'val)
+        empty-instruction-sequence
+        (make-AssignImmediateStatement target (make-Reg 'val)))
+    (emit-singular-context linkage))))
+    
+
 
-;; (: compile-primitive-application (CompileTimeEnvironment Target Linkage -> InstructionSequence))
-;; (define (compile-primitive-application cenv target linkage)
-;;   (let ([singular-context-check (emit-singular-context linkage)])
-;;     (append-instruction-sequences
-;;      (make-AssignPrimOpStatement 'val (make-ApplyPrimitiveProcedure))
-;;      (make-PopEnvironment (make-Reg 'argcount)
-;;                           (make-Const 0))
-;;      (if (eq? target 'val)
-;;          empty-instruction-sequence
-;;          (make-AssignImmediateStatement target (make-Reg 'val)))
-;;      singular-context-check)))
 
 
 

compiler/il-structs.rkt

@@ -287,7 +287,9 @@
                                   CaptureEnvironment
                                   CaptureControl
                                   
-                                  CallKernelPrimitiveProcedure))
+                                  CallKernelPrimitiveProcedure
+                                  ApplyPrimitiveProcedure
+                                  ))
 
 ;; Gets the label from the closure stored in the 'proc register and returns it.
 (define-struct: GetCompiledProcedureEntry ()
@@ -323,6 +325,9 @@
   #:transparent)
 
 
+(define-struct: ApplyPrimitiveProcedure () #:transparent)
+
+
 
 
 (define-struct: MakeBoxedEnvironmentValue ([depth : Natural])
@@ -368,6 +373,10 @@
 (define-struct: CheckClosureAndArity! ()
   #:transparent)
 
+;; Check the primitive can accept the right arguments 
+;; (stored as a number in the argcount register.).
+(define-struct: CheckPrimitiveArity! () #:transparent)
+
 
 ;; Extends the environment with a prefix that holds
 ;; lookups to the namespace.
@@ -467,6 +476,7 @@
 (define-type PrimitiveCommand (U                                
                                CheckToplevelBound!
                                CheckClosureAndArity!
+                               CheckPrimitiveArity!
 
                                ExtendEnvironment/Prefix!
                                InstallClosureValues!

compiler/optimize-il.rkt

@@ -139,6 +139,9 @@
         op]
        
        [(CallKernelPrimitiveProcedure? op)
+        op]
+       
+       [(ApplyPrimitiveProcedure? op)
         op]))
 
 

js-assembler/assemble-expression.rkt

@@ -58,4 +58,6 @@
              (add1 (MakeBoxedEnvironmentValue-depth op)))]
 
     [(CallKernelPrimitiveProcedure? op)
-     (open-code-kernel-primitive-procedure op blockht)]))
+     (open-code-kernel-primitive-procedure op blockht)]
+    [(ApplyPrimitiveProcedure? op)
+     "M.p.rawImpl(M)"]))

js-assembler/assemble-perform-statement.rkt

@@ -24,6 +24,9 @@
 
     [(CheckClosureAndArity!? op)
      "RT.checkClosureAndArity(M);"]
+    
+    [(CheckPrimitiveArity!? op)
+     "RT.checkPrimitiveArity(M);"]
 
     [(ExtendEnvironment/Prefix!? op)
      (let: ([names : (Listof (U Symbol False GlobalBucket ModuleVariable)) (ExtendEnvironment/Prefix!-names op)])

js-assembler/collect-jump-targets.rkt

@@ -112,8 +112,8 @@
        (list (MakeCompiledProcedure-label op))]
       [(MakeCompiledProcedureShell? op)
        (list (MakeCompiledProcedureShell-label op))]
-      ;; [(ApplyPrimitiveProcedure? op)
+      [(ApplyPrimitiveProcedure? op)
-      ;;  empty]
+        empty]
       [(CaptureEnvironment? op)
        empty]
       [(CaptureControl? op)
@@ -122,6 +122,7 @@
        empty]
       [(CallKernelPrimitiveProcedure? op)
        empty]))
+
   
   (: collect-primitive-command (PrimitiveCommand -> (Listof Symbol)))
   (define (collect-primitive-command op)
@@ -258,8 +259,8 @@
        (list (MakeCompiledProcedure-label op))]
       [(MakeCompiledProcedureShell? op)
        (list (MakeCompiledProcedureShell-label op))]
-      ;; [(ApplyPrimitiveProcedure? op)
+      [(ApplyPrimitiveProcedure? op)
-      ;;  empty]
+        empty]
       [(CaptureEnvironment? op)
        empty]
       [(CaptureControl? op)

js-assembler/runtime-src/runtime.js

@@ -691,6 +691,11 @@
         }
     };
 
+    var checkPrimitiveArity = function(M) {
+        if(!isArityMatching(M.p.racketArity,M.a)) {
+            raiseArityMismatchError(M,M.p,M.a);
+        }
+    };
 
 
     //////////////////////////////////////////////////////////////////////
@@ -842,6 +847,6 @@
     exports['si_context_expected'] = si_context_expected;
     exports['si_context_expected_1'] = si_context_expected_1;
     exports['checkClosureAndArity'] = checkClosureAndArity;
-
+    exports['checkPrimitiveArity'] = checkPrimitiveArity;
 
 }(this.plt, this.plt.baselib));

simulator/simulator-helpers.rkt

@@ -1,117 +0,0 @@
-#lang racket/base
-
-(require "simulator-structs.rkt")
-(provide ensure-primitive-value-box
-         ensure-primitive-value
-         ensure-list
-         PrimitiveValue->racket
-         racket->PrimitiveValue)
-(define (ensure-primitive-value-box x)
-  (if (and (box? x)
-           (PrimitiveValue? (unbox x)))
-      x
-      (error 'ensure-primitive-value-box "~s" x)))
-
-
-
-;; Make sure the value is primitive.
-(define (ensure-primitive-value val)
-  (let loop ([v val])
-    (cond
-      [(string? v)
-       v]
-      [(symbol? v)
-       v]
-      [(number? v)
-       v]
-      [(boolean? v)
-       v]
-      [(null? v)
-       v]
-      [(VoidValue? v)
-       v]
-      [(MutablePair? v)
-       v]
-      [(primitive-proc? v)
-       v]
-      [(closure? v)
-       v]
-      [(undefined? v)
-       v]
-      [(vector? v)
-       v]
-      [(ContinuationMarkSet? v)
-       v]
-      [else
-       (error 'ensure-primitive-value "~s" v)])))
-
-
-(define (ensure-list v)
-  (cond
-    [(null? v)
-     v]
-    [(and (MutablePair? v)
-          (PrimitiveValue? (MutablePair-h v))
-          (PrimitiveValue? (MutablePair-t v)))
-     v]
-    [else
-     (error 'ensure-list)]))
-
-
-(define (PrimitiveValue->racket v)
-  (cond
-    [(string? v)
-     v]
-    [(number? v)
-     v]
-    [(symbol? v)
-     v]
-    [(boolean? v)
-     v]
-    [(null? v)
-     v]
-    [(VoidValue? v)
-     (void)]
-    [(undefined? v)
-     (letrec ([x x]) x)]
-    [(primitive-proc? v)
-     v]
-    [(closure? v)
-     v]
-    [(vector? v)
-     (apply vector (map PrimitiveValue->racket (vector->list v)))]
-    [(MutablePair? v)
-     (cons (PrimitiveValue->racket (MutablePair-h v))
-           (PrimitiveValue->racket (MutablePair-t v)))]
-   [(ContinuationMarkSet? v)
-    v]))
-
-
-(define (racket->PrimitiveValue v)
-  (cond
-    [(string? v)
-     v]
-    [(number? v)
-     v]
-    [(symbol? v)
-     v]
-    [(boolean? v)
-     v]
-    [(null? v)
-     v]
-    [(void? v)
-     the-void-value]
-    [(eq? v (letrec ([x x]) x))
-     (make-undefined)]
-    [(procedure? v)
-     (error 'racket->PrimitiveValue "Can't coerse procedure")]
-    [(primitive-proc? v)
-     v]
-    [(closure? v)
-     v]
-    [(vector? v)
-     (apply vector (map racket->PrimitiveValue (vector->list v)))]
-    [(pair? v)
-     (make-MutablePair (racket->PrimitiveValue (car v))
-                       (racket->PrimitiveValue (cdr v)))]))
-

simulator/simulator-primitives.rkt

@@ -1,278 +0,0 @@
-#lang racket/base
-(require "simulator-structs.rkt"
-         "simulator-helpers.rkt"
-         "../compiler/il-structs.rkt"
-         "../compiler/arity-structs.rkt"
-         racket/math
-         racket/list
-         (for-syntax racket/base))
-
-(provide lookup-primitive set-primitive!)
-
-(define mutated-primitives (make-hasheq))
-(define (set-primitive! n p)
-  (hash-set! mutated-primitives n p))
-
-
-(define (extract-arity proc)
-  (let loop ([racket-arity (procedure-arity proc)])
-    (cond
-      [(number? racket-arity)
-       racket-arity]
-      [(arity-at-least? racket-arity)
-       (make-ArityAtLeast (arity-at-least-value racket-arity))]
-      [(list? racket-arity)
-       (map loop racket-arity)])))
-                
-
-
-
-(define-syntax (make-lookup stx)
-  (syntax-case stx ()
-    [(_ #:functions (name ...)
-        #:constants (cname ...))
-     (with-syntax ([(prim-name ...) (generate-temporaries #'(name ...))]
-                   [((name exported-name) ...)
-                    (map (lambda (name)
-                           (syntax-case name ()
-                             [(real-name exported-name)
-                              (list #'real-name #'exported-name)]
-                             [_ 
-                              (identifier? name)
-                              (list name name)]))
-                         (syntax->list #'(name ...)))])
-       (syntax/loc stx
-         (let ([prim-name (make-primitive-proc 
-                           (lambda (machine . args)
-                             (apply name args))
-                           (extract-arity name)
-                           'exported-name)]
-               ...)
-           (lambda (n)
-             (cond
-               [(hash-has-key? mutated-primitives n)
-                (hash-ref mutated-primitives n)]
-               [(eq? n 'exported-name)
-                prim-name]
-               ...
-               [(eq? n 'cname)
-                cname]
-               ...
-               [else
-                (make-undefined)]
-               )))))]))
-
-(define e (exp 1))
-
-(define my-cons (lambda (x y)
-                  (make-MutablePair x y)))
-
-(define my-list (lambda args
-                   (let loop ([args args])
-                     (cond
-                       [(null? args)
-                        null]
-                       [else
-                        (make-MutablePair (car args)
-                                          (loop (cdr args)))]))))
-(define my-car (lambda (x)
-                  (MutablePair-h x)))
-
-(define my-cdr (lambda (x)
-                  (MutablePair-t x)))
-
-
-(define my-cadr (lambda (x)
-                  (MutablePair-h (MutablePair-t x))))
-
-(define my-caddr (lambda (x)
-                  (MutablePair-h (MutablePair-t (MutablePair-t x)))))
-
-
-(define my-pair? (lambda (x)
-                   (MutablePair? x)))
-
-(define my-box (lambda (x)
-                 (vector x)))
-
-(define my-unbox (lambda (x)
-                   (vector-ref x 0)))
-
-(define my-set-box! (lambda (x v)
-                      (vector-set! x 0 v)
-                      the-void-value))
-
-(define my-vector->list (lambda (v)
-                          (apply my-list (vector->list v))))
-
-(define my-list->vector (lambda (l)
-                          (apply vector
-                          (let loop ([l l])
-                            (cond
-                              [(null? l)
-                               null]
-                              [else
-                               (cons (MutablePair-h l)
-                                     (loop (MutablePair-t l)))])))))
-                                
-
-(define my-set-car! (lambda (p v)
-                      (set-MutablePair-h! p v)
-                      the-void-value))
-
-(define my-set-cdr! (lambda (p v)
-                      (set-MutablePair-t! p v)
-                      the-void-value))
-
-(define my-void (lambda args
-                  the-void-value))
-
-(define my-display (lambda args
-                     (apply display args)
-                     the-void-value))
-
-(define my-displayln (lambda args
-                       (apply displayln args)
-                       the-void-value))
-
-(define my-newline (lambda args
-                     (apply newline args)
-                     the-void-value))
-
-(define my-vector-set! (lambda args
-                         (apply vector-set! args)
-                         the-void-value))
-
-
-
-(define my-member (lambda (x l)
-                    (let loop ([l l])
-                      (cond
-                        [(null? l)
-                         #f]
-                        [(MutablePair? l)
-                         (cond
-                           [(equal? x (MutablePair-h l))
-                            l]
-                           [else
-                            (loop (MutablePair-t l))])]
-                        [else
-                         (error 'member "not a list: ~s" l)]))))
-
-(define my-reverse (lambda (l)
-                    (let loop ([l l]
-                               [acc null])
-                      (cond
-                        [(null? l)
-                         acc]
-                        [(MutablePair? l)
-                         (loop (MutablePair-t l)
-                               (make-MutablePair (MutablePair-h l) acc))]
-                        [else
-                         (error 'member "not a list: ~s" l)]))))
-
-
-(define my-printf (lambda (fmt args)
-                     (apply printf fmt (map (lambda (x)
-                                              (PrimitiveValue->racket x))
-                                            args))))
-
-
-
-(define current-continuation-marks   
-  (letrec ([f (case-lambda [(a-machine)
-                            (f a-machine default-continuation-prompt-tag-value)]
-                           [(a-machine tag)
-                            (make-ContinuationMarkSet
-                             (let loop ([frames (machine-control a-machine)])
-                               (cond
-                                 [(empty? frames)
-                                  empty]
-                                 [else
-                                  (append (hash-map (frame-marks (first frames))
-                                                    cons)
-                                          (if (eq? tag (frame-tag (first frames)))
-                                              empty
-                                              (loop (rest frames))))])))])])
-    (make-primitive-proc (lambda (machine . args) (apply f machine args))
-                         '(0 1)
-                         'current-continuation-marks)))
-                        
-
-(define continuation-mark-set->list
-  ;; not quite correct: ContinuationMarkSets need to preserve frame structure a bit more. 
-  ;; At the very least, we need to keep track of prompt tags somewhere.
-  (let ([f (lambda (a-machine mark-set key)
-             (let ([marks (ContinuationMarkSet-marks mark-set)])
-               (foldr make-MutablePair
-                      null
-                      (map cdr (filter (lambda (k+v)
-                                         (eq? (car k+v) key))
-                                       marks)))))])
-    (make-primitive-proc (lambda (machine . args) (apply f machine args))
-                         '2 ;; fixme: should deal with prompt tags too
-                         'current-continuation-marks)))
-
-
-
-
-
-(define lookup-primitive (make-lookup #:functions (+ - * / = < <= > >= 
-                                                     sub1
-                                                     not
-                                                     null?
-                                                     eq?
-                                                     add1
-                                                     sub1
-                                                     zero?
-                                                     abs
-                                                     (my-void void)
-                                                     quotient
-                                                     remainder
- 
-                                                     (my-display display)
-                                                     (my-displayln displayln)
-                                                     (my-newline newline)
-                                                    
-                                                     symbol->string
-                                                     string-append
-                                                     string-length
-
-                                                     (my-cons cons)
-                                                     (my-list list)
-                                                     (my-car car)
-                                                     (my-cdr cdr)
-						     (my-cadr cadr)
-						     (my-caddr caddr)
-                                                     (my-pair? pair?)
-                                                     null?
-                                                     (my-set-car! set-car!)
-                                                     (my-set-cdr! set-cdr!)
-                                                     (my-member member)
-                                                     (my-reverse reverse)
-                                                     
-                                                     
-                                                     (my-box box)
-                                                     (my-unbox unbox)
-                                                     (my-set-box! set-box!)
-                                                     
-                                                     vector
-                                                     (my-vector-set! vector-set!)
-                                                     vector-ref
-                                                     (my-vector->list vector->list)
-                                                     (my-list->vector list->vector)
-                                                     vector-length
-                                                     make-vector
-                                                     
-                                                     
-                                                     equal?
-                                                     symbol?
-                                                     
-                                                     
-                                                     (my-printf printf)
-                                                     )
-                                      #:constants (null pi e
-                                                        current-continuation-marks
-                                                        continuation-mark-set->list)))
-
-

simulator/simulator-structs.rkt

@@ -1,203 +0,0 @@
-#lang typed/racket/base
-
-(provide (all-defined-out))
-
-(require "../compiler/arity-structs.rkt"
-         "../compiler/il-structs.rkt"
-         "../compiler/expression-structs.rkt"
-         "../compiler/lexical-structs.rkt")
-
-
-
-
-;; A special "label" in the system that causes evaluation to stop.
-(define-struct: halt ())
-(define HALT (make-halt))
-
-
-
-(define-type PrimitiveValue (Rec PrimitiveValue (U String Number Symbol Boolean
-                                                   Null VoidValue
-                                                   undefined
-                                                   
-                                                   primitive-proc 
-                                                   closure
-                                                   
-                                                   (Vectorof PrimitiveValue)
-                                                   MutablePair
-
-                                                   ContinuationMarkSet
-
-                                                   ToplevelReference
-                                                   )))
-(define-type SlotValue (U PrimitiveValue 
-                          (Boxof PrimitiveValue)
-                          toplevel
-                          CapturedControl
-                          CapturedEnvironment))
-
-
-(define-struct: VoidValue () #:transparent)
-(define the-void-value (make-VoidValue))
-
-
-(define-struct: MutablePair ([h : PrimitiveValue]
-                             [t : PrimitiveValue])
-  #:mutable #:transparent)
-
-;; For continuation capture:
-(define-struct: CapturedControl ([frames : (Listof frame)]))
-(define-struct: CapturedEnvironment ([vals : (Listof SlotValue)]))
-
-
-(define-struct: machine ([val : SlotValue]
-                         [proc : SlotValue]
-                         [argcount : SlotValue]
-                         [env : (Listof SlotValue)]
-                         [control : (Listof frame)]
-
-                         [pc : Natural]                  ;; program counter
-                         [text : (Vectorof Statement)]   ;; text of the program
-
-                         [modules : (HashTable Symbol module-record)]
-                         
-                         ;; other metrics for debugging
-                         [stack-size : Natural]
-                         
-                         ;; compute position from label
-                         [jump-table : (HashTable Symbol Natural)]
-                         )
-  #:transparent
-  #:mutable)
-
-
-(define-struct: module-record ([name : Symbol]
-                               [self-path : Symbol]
-                               [label : Symbol]
-                               [invoked? : Boolean]
-                               [namespace : (HashTable Symbol PrimitiveValue)]
-                               [toplevel : (U False toplevel)])
-  #:transparent
-  #:mutable)
-
-
-(define-type frame (U GenericFrame CallFrame PromptFrame))
-
-
-(define-struct: GenericFrame ([temps : (HashTable Symbol PrimitiveValue)]
-                              [marks : (HashTable PrimitiveValue PrimitiveValue)])
-  #:transparent)
-
-
-(define-struct: CallFrame ([return : (U LinkedLabel halt)]
-                           ;; The procedure being called.  Used to optimize self-application
-                           [proc : (U closure #f)]
-                           ;; TODO: add continuation marks
-                           [temps : (HashTable Symbol PrimitiveValue)]
-                           [marks : (HashTable PrimitiveValue PrimitiveValue)])
-  #:transparent
-  #:mutable)  ;; mutable because we want to allow mutation of proc.
-
-(define-struct: PromptFrame ([tag : ContinuationPromptTagValue]
-                             [return : (U LinkedLabel halt)]
-                             [env-depth : Natural]
-                             [temps : (HashTable Symbol PrimitiveValue)]
-                             [marks : (HashTable PrimitiveValue PrimitiveValue)])
-  #:transparent)
-
-
-(: frame-temps (frame -> (HashTable Symbol PrimitiveValue)))
-(define (frame-temps a-frame)
-  (cond
-    [(GenericFrame? a-frame)
-     (GenericFrame-temps a-frame)]
-    [(CallFrame? a-frame)
-     (CallFrame-temps a-frame)]
-    [(PromptFrame? a-frame)
-     (PromptFrame-temps a-frame)]))
-
-
-(: frame-marks (frame -> (HashTable PrimitiveValue PrimitiveValue)))
-(define (frame-marks a-frame)
-  (cond
-    [(GenericFrame? a-frame)
-     (GenericFrame-marks a-frame)]
-    [(CallFrame? a-frame)
-     (CallFrame-marks a-frame)]
-    [(PromptFrame? a-frame)
-     (PromptFrame-marks a-frame)]))
-
-
-(: frame-tag (frame -> (U ContinuationPromptTagValue #f)))
-(define (frame-tag a-frame)
-  (cond
-    [(GenericFrame? a-frame)
-     #f]
-    [(CallFrame? a-frame)
-     #f]
-    [(PromptFrame? a-frame)
-     (PromptFrame-tag a-frame)]))
-
-
-
-(define-struct: ContinuationPromptTagValue ([name : Symbol])
-  #:transparent)
-
-(define default-continuation-prompt-tag-value 
-  (make-ContinuationPromptTagValue 'default-continuation-prompt))
-
-
-
-(define-struct: ContinuationMarkSet ([marks : (Listof (Pairof PrimitiveValue PrimitiveValue))])
-  #:transparent)
-
-
-
-
-
-
-
-(define-struct: toplevel ([names : (Listof (U #f Symbol GlobalBucket ModuleVariable))]
-                          [vals : (Listof PrimitiveValue)])
-  #:transparent
-  #:mutable)
-
-
-
-
-
-;; Primitive procedure wrapper
-(define-struct: primitive-proc ([f : (machine PrimitiveValue * -> PrimitiveValue)]
-                                [arity : Arity]
-                                [display-name : (U Symbol LamPositionalName)])
-  #:transparent)
-
-
-
-
-;; Compiled procedure closures
-(define-struct: closure ([label : Symbol]
-                         [arity : Arity]
-                         [vals : (Listof SlotValue)]
-                         [display-name : (U Symbol LamPositionalName)])
-  #:transparent
-  #:mutable)
-
-
-
-
-(define-struct: ToplevelReference ([toplevel : toplevel]
-                                   [pos : Natural])
-  #:transparent)
-                
-
-;; undefined value
-(define-struct: undefined ()
-  #:transparent)
-
-
-
-(define-predicate PrimitiveValue? PrimitiveValue)
-(define-predicate frame? frame)
-
-