trying to complete the bytecode parse

assemble-helpers.rkt

@@ -53,7 +53,11 @@
     [(CompiledProcedureClosureReference? v)
      (assemble-compiled-procedure-closure-reference v)]
     [(PrimitiveKernelValue? v)
-     (assemble-primitive-kernel-value v)]))
+     (assemble-primitive-kernel-value v)]
+    [(ModuleEntry? v)
+     (assemble-module-entry v)]
+    [(VariableReference? v)
+     (assemble-variable-reference v)]))
 
 
 
@@ -265,3 +269,19 @@
 (: assemble-primitive-kernel-value (PrimitiveKernelValue -> String))
 (define (assemble-primitive-kernel-value a-prim)
   (format "MACHINE.primitives[~s]" (symbol->string (PrimitiveKernelValue-id a-prim))))
+
+
+
+(: assemble-module-entry (ModuleEntry -> String))
+(define (assemble-module-entry entry)
+  (format "MACHINE.modules[~s].label"
+          (symbol->string (ModuleName-name (ModuleEntry-name entry)))))
+
+
+
+(: assemble-variable-reference (VariableReference -> String))
+(define (assemble-variable-reference varref)
+  (let ([t (VariableReference-toplevel varref)])
+    (format "(new RUNTIME.VariableReference(MACHINE.env[MACHINE.env.length - 1 - ~a], ~a))"
+            (ToplevelRef-depth t)
+            (ToplevelRef-pos t))))

collect-jump-targets.rkt

@@ -91,6 +91,10 @@
    [(CompiledProcedureClosureReference? an-input)
     (collect-input (CompiledProcedureClosureReference-proc an-input))]
    [(PrimitiveKernelValue? an-input)
+    empty]
+   [(ModuleEntry? an-input)
+    empty]
+   [(VariableReference? an-input)
     empty]))
 
 

compiler.rkt

@@ -145,7 +145,9 @@
           [(DefValues? exp)
            (append (loop (DefValues-rhs exp) cenv))]
           [(PrimitiveKernelValue? exp)
-           '()])))
+           '()]
+          [(VariableReference? exp)
+           (loop (VariableReference-toplevel exp) cenv)])))
 
 
 
@@ -222,7 +224,9 @@
     [(DefValues? exp)
      (compile-def-values exp cenv target linkage)]
     [(PrimitiveKernelValue? exp)
-     (compile-primitive-kernel-value exp cenv target linkage)]))
+     (compile-primitive-kernel-value exp cenv target linkage)]
+    [(VariableReference? exp)
+     (compile-variable-reference exp cenv target linkage)]))
 
 
 
@@ -363,6 +367,17 @@
                        singular-context-check))))
 
 
+(: compile-variable-reference (VariableReference CompileTimeEnvironment Target Linkage -> InstructionSequence))
+(define (compile-variable-reference exp cenv target linkage)
+  (let ([singular-context-check (emit-singular-context linkage)])
+    ;; Compiles constant values.
+    (end-with-linkage linkage
+                      cenv
+                      (append-instruction-sequences
+                       (make-instruction-sequence
+                        `(,(make-AssignImmediateStatement target exp)))
+                       singular-context-check))))
+
 
 (: compile-local-reference (LocalRef CompileTimeEnvironment Target Linkage -> InstructionSequence))
 ;; Compiles local variable references.
@@ -2129,4 +2144,9 @@
                      (adjust-expression-depth (DefValues-rhs exp) n skip))]
     
     [(PrimitiveKernelValue? exp)
-     exp]))
+     exp]
+
+    [(VariableReference? exp)
+     (make-VariableReference 
+      (ensure-toplevelref
+       (adjust-expression-depth (VariableReference-toplevel exp) n skip)))]))

expression-structs.rkt

@@ -28,7 +28,8 @@
                          ApplyValues
                          DefValues
                          PrimitiveKernelValue
-                         Module))
+                         Module
+                         VariableReference))
 
 
 (define-struct: Provided ([name : Symbol]
@@ -138,6 +139,9 @@
 (define-struct: PrimitiveKernelValue ([id : Symbol]) #:transparent)
 
 
+(define-struct: VariableReference ([toplevel : ToplevelRef]) #:transparent)
+
+
 
 
 (: last-exp? ((Listof Expression) -> Boolean))

il-structs.rkt

@@ -33,7 +33,9 @@
                       ControlFrameTemporary
                       CompiledProcedureEntry
                       CompiledProcedureClosureReference
-                      PrimitiveKernelValue))
+                      ModuleEntry
+                      PrimitiveKernelValue
+                      VariableReference))
 
 
 ;; Targets: these are the allowable lhs's for a targetted assignment.
@@ -88,12 +90,14 @@
 
 
 
-
-
 (define-struct: PrimitivesReference ([name : Symbol])
   #:transparent)
 
 
+(define-struct: ModuleEntry ([name : ModuleName])
+  #:transparent)
+
+
 
 
 ;; instruction sequences

optimize-il.rkt

@@ -135,7 +135,14 @@
       (adjust-oparg-depth (CompiledProcedureClosureReference-proc oparg) n)
       (CompiledProcedureClosureReference-n oparg))]
     [(PrimitiveKernelValue? oparg)
-     oparg]))
+     oparg]
+    [(ModuleEntry? oparg)
+     oparg]
+    [(VariableReference? oparg)
+     (let ([t (VariableReference-toplevel oparg)])
+       (make-VariableReference 
+        (make-ToplevelRef (ensure-natural (+ n (ToplevelRef-depth t)))
+                          (ToplevelRef-pos t))))]))
 
 
 (define-predicate natural? Natural)

parse-bytecode-5.1.1.rkt

@@ -29,8 +29,6 @@
        [(self-module-path-index? mpi)
         'self]
        [else
-        (displayln (explode-module-path-index mpi))
-        (displayln relative-to)
         (resolve-module-path-index mpi relative-to)]))))
 
 
@@ -260,9 +258,7 @@
         [(= (car (first requires))
               0)
          (map (lambda (m) 
-                (printf "enclosing: ~s\n" (explode-module-path-index enclosing-module-path-index))
                 (let ([enclosing-path (resolver enclosing-module-path-index (current-module-path))])
-                  (printf "inner: ~s\n" (explode-module-path-index m))
                   (cond
                     [(symbol? enclosing-path)
                      (wrap-module-name (resolver m (current-module-path)))]
@@ -544,7 +540,9 @@
 
 
 (define (parse-varref expr)
-  (error 'fixmevarref))
+  (match expr
+    [(struct varref (toplevel))
+     (make-VariableReference (parse-toplevel toplevel))]))
 
 (define (parse-assign expr)
   (match expr

runtime.js

@@ -211,6 +211,11 @@
 
 
 
+    var VariableReference = function(prefix, pos) {
+        this.prefix = prefix;
+        this.pos = pos;
+    };
+
 
 
 
@@ -1136,6 +1141,7 @@
     exports['PromptFrame'] = PromptFrame;
     exports['Closure'] = Closure;
     exports['ModuleRecord'] = ModuleRecord;
+    exports['VariableReference'] = VariableReference;
     exports['ContinuationPromptTag'] = ContinuationPromptTag;
     exports['DEFAULT_CONTINUATION_PROMPT_TAG'] = 
 	DEFAULT_CONTINUATION_PROMPT_TAG;

simulator-structs.rkt

@@ -18,6 +18,8 @@
                                                    MutablePair
 
                                                    ContinuationMarkSet
+
+                                                   ToplevelReference
                                                    )))
 (define-type SlotValue (U PrimitiveValue 
                           (Boxof PrimitiveValue)
@@ -181,3 +183,9 @@
 
 (define-predicate PrimitiveValue? PrimitiveValue)
 (define-predicate frame? frame)
+
+
+(define-struct: ToplevelReference ([toplevel : toplevel]
+                                   [pos : Natural])
+  #:transparent)
+                

simulator.rkt

@@ -781,7 +781,18 @@
        (list-ref (closure-vals proc) (CompiledProcedureClosureReference-n an-oparg)))]
     
     [(PrimitiveKernelValue? an-oparg)
-     (lookup-primitive (PrimitiveKernelValue-id an-oparg))]))
+     (lookup-primitive (PrimitiveKernelValue-id an-oparg))]
+    
+    [(ModuleEntry? an-oparg)
+     (let ([a-module (hash-ref (machine-modules m) 
+                               (ModuleName-name (ModuleEntry-name an-oparg)))])
+       (module-record-label a-module))]
+
+    [(VariableReference? an-oparg)
+     (let ([t (VariableReference-toplevel an-oparg)])
+       (make-ToplevelReference (ensure-toplevel (env-ref m (ToplevelRef-depth t)))
+                               (ToplevelRef-pos t)))]))
+       
 
 
 

test-parse-bytecode-5.1.1.rkt

@@ -327,16 +327,55 @@
 
 
 ;; Compiling modules
-(run-my-parse #'(module foo racket/base
+(check-true
+ (match (run-my-parse #'(module foo racket/base
                           42))
+   [(struct Top ((struct Prefix (list))
+                 (struct Module ((? ModuleName?)
+                                 (? Prefix?) ;; the prefix will include a reference to print-values.
+                                 _  ;; requires
+                                 _  ;; provides
+                                 (struct Splice ((list (struct ApplyValues 
+                                                         ((struct ToplevelRef ('0 '0)) (struct Constant ('42)))))))))))
+    #t]))
+
+
+(check-true
+ (match (run-my-parse #'(module foo racket/base
+                          (provide x)
+                          (define x "x")))
+   [(struct Top ((struct Prefix ((? list?)))
+                 (struct Module ((? ModuleName?)
+                                 (? Prefix?) ;; the prefix will include a reference to print-values.
+                                 _  ;; requires
+                                 (list (struct Provided ('x 'x)))  ;; provides
+                                 (struct Splice ((list (struct DefValues 
+                                                         ((list (struct ToplevelRef ('0 '0)))
+                                                          (struct Constant ("x")))))))))))
+    #t]))
+
+
+
+
+;; Variable reference
+(check-equal? (run-my-parse #'(#%variable-reference x))
+              (make-Top (make-Prefix (list (make-GlobalBucket 'x)))
+                       (make-VariableReference (make-ToplevelRef 0 0))))
+
+;; todo: see what it would take to run a typed/racket/base language.
+(void 
+ (run-my-parse '(module foo typed/racket/base 
+                        (provide x) 
+                        (: x Number)
+                        (define x (add1 41)))))
 
 
 
 ;; make sure we don't see an infinite loop
 #;(run-zo-parse #'(letrec ([g (lambda () (g))])
                   (g)))
-(void (run-my-parse #'(letrec ([g (lambda () (g))])
+(run-my-parse #'(letrec ([g (lambda () (g))])
-                        (g))))
+                        (g)))
 ;; todo: add tests to make sure we're parsing this as expected.  We expect to see an EmptyClosureReference here.