diff --git a/assemble-helpers.rkt b/assemble-helpers.rkt index 73f9924..d197d53 100644 --- a/assemble-helpers.rkt +++ b/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)])) @@ -264,4 +268,20 @@ (: assemble-primitive-kernel-value (PrimitiveKernelValue -> String)) (define (assemble-primitive-kernel-value a-prim) - (format "MACHINE.primitives[~s]" (symbol->string (PrimitiveKernelValue-id a-prim)))) \ No newline at end of file + (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)))) \ No newline at end of file diff --git a/collect-jump-targets.rkt b/collect-jump-targets.rkt index ba52058..07a1b14 100644 --- a/collect-jump-targets.rkt +++ b/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])) diff --git a/compiler.rkt b/compiler.rkt index 01c01f1..ab774e5 100644 --- a/compiler.rkt +++ b/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])) \ No newline at end of file + exp] + + [(VariableReference? exp) + (make-VariableReference + (ensure-toplevelref + (adjust-expression-depth (VariableReference-toplevel exp) n skip)))])) \ No newline at end of file diff --git a/expression-structs.rkt b/expression-structs.rkt index d330b10..9a09a7c 100644 --- a/expression-structs.rkt +++ b/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)) diff --git a/il-structs.rkt b/il-structs.rkt index eca1a50..f82653a 100644 --- a/il-structs.rkt +++ b/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 diff --git a/optimize-il.rkt b/optimize-il.rkt index 3b5da13..d2f2329 100644 --- a/optimize-il.rkt +++ b/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) diff --git a/parse-bytecode-5.1.1.rkt b/parse-bytecode-5.1.1.rkt index f99271f..b1114dc 100644 --- a/parse-bytecode-5.1.1.rkt +++ b/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 diff --git a/runtime.js b/runtime.js index 82af631..ab5257d 100644 --- a/runtime.js +++ b/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; diff --git a/simulator-structs.rkt b/simulator-structs.rkt index 7a31c95..b66bf15 100644 --- a/simulator-structs.rkt +++ b/simulator-structs.rkt @@ -18,6 +18,8 @@ MutablePair ContinuationMarkSet + + ToplevelReference ))) (define-type SlotValue (U PrimitiveValue (Boxof PrimitiveValue) @@ -180,4 +182,10 @@ (define-predicate PrimitiveValue? PrimitiveValue) -(define-predicate frame? frame) \ No newline at end of file +(define-predicate frame? frame) + + +(define-struct: ToplevelReference ([toplevel : toplevel] + [pos : Natural]) + #:transparent) + \ No newline at end of file diff --git a/simulator.rkt b/simulator.rkt index 901ec34..69fcdeb 100644 --- a/simulator.rkt +++ b/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)))])) + diff --git a/test-parse-bytecode-5.1.1.rkt b/test-parse-bytecode-5.1.1.rkt index 04f9f20..0de4d08 100644 --- a/test-parse-bytecode-5.1.1.rkt +++ b/test-parse-bytecode-5.1.1.rkt @@ -327,16 +327,55 @@ ;; Compiling modules -(run-my-parse #'(module foo racket/base - 42)) +(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))]) - (g)))) +(run-my-parse #'(letrec ([g (lambda () (g))]) + (g))) ;; todo: add tests to make sure we're parsing this as expected. We expect to see an EmptyClosureReference here.