trying to complete the bytecode parse

This commit is contained in:
Danny Yoo 2011-05-11 18:03:46 -04:00
parent e8e28afa19
commit 89321ba9b2
11 changed files with 142 additions and 21 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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)
(define-predicate frame? frame)
(define-struct: ToplevelReference ([toplevel : toplevel]
[pos : Natural])
#:transparent)

View File

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

View File

@ -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.