working on compile
This commit is contained in:
Danny Yoo
parent
2d05a3b8ad
commit
15c6822816
290
compile.rkt
290
compile.rkt
|
|
@ -3,8 +3,6 @@
|
|||
(require "expression-structs.rkt"
|
||||
"lexical-structs.rkt"
|
||||
"il-structs.rkt"
|
||||
"lexical-env.rkt"
|
||||
"find-toplevel-variables.rkt"
|
||||
racket/list)
|
||||
|
||||
(provide (rename-out [-compile compile])
|
||||
|
|
@ -17,24 +15,17 @@
|
|||
(: current-defined-name (Parameterof (U Symbol False)))
|
||||
(define current-defined-name (make-parameter #f))
|
||||
|
||||
|
||||
;(provide compile-top)
|
||||
|
||||
(: -compile (ExpressionCore Target Linkage -> (Listof Statement)))
|
||||
(define (-compile exp target linkage)
|
||||
(statements
|
||||
(let ([end (make-label 'end)])
|
||||
(append-instruction-sequences
|
||||
(compile (make-Top (make-Prefix (find-toplevel-variables exp))
|
||||
exp)
|
||||
(list)
|
||||
target
|
||||
linkage)))))
|
||||
(compile exp
|
||||
0
|
||||
target
|
||||
linkage)))
|
||||
|
||||
|
||||
|
||||
|
||||
(: compile (ExpressionCore CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(: compile (ExpressionCore Natural Target Linkage -> InstructionSequence))
|
||||
;; Compiles an expression into an instruction sequence.
|
||||
(define (compile exp cenv target linkage)
|
||||
(cond
|
||||
|
|
@ -42,10 +33,12 @@
|
|||
(compile-top exp cenv target linkage)]
|
||||
[(Constant? exp)
|
||||
(compile-constant exp cenv target linkage)]
|
||||
[(Var? exp)
|
||||
(compile-variable exp cenv target linkage)]
|
||||
[(Def? exp)
|
||||
(compile-definition exp cenv target linkage)]
|
||||
[(LocalRef? exp)
|
||||
(compile-local-reference exp cenv target linkage)]
|
||||
[(ToplevelRef? exp)
|
||||
(compile-toplevel-reference exp cenv target linkage)]
|
||||
[(ToplevelSet? exp)
|
||||
(compile-toplevel-set exp cenv target linkage)]
|
||||
[(Branch? exp)
|
||||
(compile-branch exp cenv target linkage)]
|
||||
[(Lam? exp)
|
||||
|
|
@ -59,33 +52,32 @@
|
|||
(compile-application exp cenv target linkage)]
|
||||
[(Let1? exp)
|
||||
(compile-let1 exp cenv target linkage)]
|
||||
[(Let? exp)
|
||||
(compile-let exp cenv target linkage)]
|
||||
[(LetRec? exp)
|
||||
(compile-letrec exp cenv target linkage)]))
|
||||
[(LetVoid? exp)
|
||||
(compile-let-void exp cenv target linkage)]
|
||||
[(InstallValue? exp)
|
||||
(compile-install-value exp cenv target linkage)]))
|
||||
|
||||
|
||||
|
||||
(: compile-top (Top CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
|
||||
(: compile-top (Top Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-top top cenv target linkage)
|
||||
(let*: ([cenv : CompileTimeEnvironment (extend-lexical-environment cenv (Top-prefix top))]
|
||||
[names : (Listof (U Symbol False)) (Prefix-names (Top-prefix top))])
|
||||
(let*: ([names : (Listof (U Symbol False)) (Prefix-names (Top-prefix top))])
|
||||
(append-instruction-sequences
|
||||
(make-instruction-sequence
|
||||
`(,(make-PerformStatement (make-ExtendEnvironment/Prefix! names))))
|
||||
(compile (Top-code top) cenv target linkage))))
|
||||
(compile (Top-code top) (add1 cenv) target linkage))))
|
||||
|
||||
|
||||
|
||||
;; Add linkage for expressions.
|
||||
(: end-with-linkage (Linkage CompileTimeEnvironment InstructionSequence ->
|
||||
InstructionSequence))
|
||||
(: end-with-linkage (Linkage Natural InstructionSequence -> InstructionSequence))
|
||||
(define (end-with-linkage linkage cenv instruction-sequence)
|
||||
(append-instruction-sequences instruction-sequence
|
||||
(compile-linkage cenv linkage)))
|
||||
|
||||
|
||||
(: end-with-compiled-application-linkage (Linkage CompileTimeEnvironment InstructionSequence ->
|
||||
(: end-with-compiled-application-linkage (Linkage Natural InstructionSequence ->
|
||||
InstructionSequence))
|
||||
;; Add linkage for applications; we need to specialize this to preserve tail calls.
|
||||
(define (end-with-compiled-application-linkage linkage cenv instruction-sequence)
|
||||
|
|
@ -94,14 +86,14 @@
|
|||
|
||||
|
||||
|
||||
(: compile-linkage (CompileTimeEnvironment Linkage -> InstructionSequence))
|
||||
(: compile-linkage (Natural Linkage -> InstructionSequence))
|
||||
(define (compile-linkage cenv linkage)
|
||||
(cond
|
||||
[(eq? linkage 'return)
|
||||
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc
|
||||
(make-GetControlStackLabel))
|
||||
,(make-PopEnvironment
|
||||
(lexical-environment-pop-depth cenv linkage)
|
||||
cenv
|
||||
0)
|
||||
,(make-PopControlFrame)
|
||||
,(make-GotoStatement (make-Reg 'proc))))]
|
||||
|
|
@ -111,87 +103,76 @@
|
|||
(make-instruction-sequence `(,(make-GotoStatement (make-Label linkage))))]))
|
||||
|
||||
|
||||
(: compile-application-linkage (CompileTimeEnvironment Linkage -> InstructionSequence))
|
||||
(: compile-application-linkage (Natural Linkage -> InstructionSequence))
|
||||
;; Like compile-linkage, but the special case for 'return linkage already assumes
|
||||
;; the stack has been appropriately popped.
|
||||
(define (compile-application-linkage cenv linkage)
|
||||
(cond
|
||||
[(eq? linkage 'return)
|
||||
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc
|
||||
(make-GetControlStackLabel))
|
||||
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
|
||||
,(make-PopControlFrame)
|
||||
,(make-GotoStatement (make-Reg 'proc))))]
|
||||
[(eq? linkage 'next)
|
||||
(make-instruction-sequence `(,(make-PopEnvironment (lexical-environment-pop-depth cenv linkage)
|
||||
0)))]
|
||||
(make-instruction-sequence `(,(make-PopEnvironment cenv 0)))]
|
||||
[(symbol? linkage)
|
||||
(make-instruction-sequence `(,(make-PopEnvironment (lexical-environment-pop-depth cenv linkage)
|
||||
0)
|
||||
(make-instruction-sequence `(,(make-PopEnvironment cenv 0)
|
||||
,(make-GotoStatement (make-Label linkage))))]))
|
||||
|
||||
|
||||
|
||||
|
||||
(: lexical-environment-pop-depth (CompileTimeEnvironment Linkage -> Natural))
|
||||
;; Computes how much of the environment we need to pop.
|
||||
(define (lexical-environment-pop-depth cenv linkage)
|
||||
(length cenv))
|
||||
|
||||
|
||||
|
||||
|
||||
(: compile-constant (Constant CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(: compile-constant (Constant Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-constant exp cenv target linkage)
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignImmediateStatement target (make-Const (Constant-v exp)))))))
|
||||
|
||||
(: compile-variable (Var CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-variable exp cenv target linkage)
|
||||
(let ([lexical-pos (find-variable (Var-id exp) cenv)])
|
||||
(cond
|
||||
[(EnvLexicalReference? lexical-pos)
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignImmediateStatement
|
||||
target
|
||||
lexical-pos))))]
|
||||
[(EnvPrefixReference? lexical-pos)
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
`(,(make-PerformStatement (make-CheckToplevelBound!
|
||||
(EnvPrefixReference-depth lexical-pos)
|
||||
(EnvPrefixReference-pos lexical-pos)
|
||||
(EnvPrefixReference-name lexical-pos)))
|
||||
,(make-AssignImmediateStatement
|
||||
target
|
||||
lexical-pos))))])))
|
||||
|
||||
|
||||
(: compile-definition (Def CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-definition exp cenv target linkage)
|
||||
(let* ([var (Def-variable exp)]
|
||||
[lexical-pos (find-variable var cenv)])
|
||||
(cond
|
||||
[(EnvLexicalReference? lexical-pos)
|
||||
(error 'compile-definition "Defintion not at toplevel")]
|
||||
[(EnvPrefixReference? lexical-pos)
|
||||
(let ([get-value-code
|
||||
(parameterize ([current-defined-name var])
|
||||
(compile (Def-value exp) cenv lexical-pos
|
||||
'next))])
|
||||
(end-with-linkage
|
||||
linkage
|
||||
cenv
|
||||
(append-instruction-sequences
|
||||
get-value-code
|
||||
(make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Const 'ok)))))))])))
|
||||
(: compile-local-reference (LocalRef Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-local-reference exp cenv target linkage)
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignImmediateStatement
|
||||
target
|
||||
(make-EnvLexicalReference (LocalRef-depth exp)
|
||||
(LocalRef-unbox? exp)))))))
|
||||
|
||||
|
||||
(: compile-branch (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(: compile-toplevel-reference (ToplevelRef Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-toplevel-reference exp cenv target linkage)
|
||||
(end-with-linkage linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
`(,(make-PerformStatement (make-CheckToplevelBound!
|
||||
(ToplevelRef-depth exp)
|
||||
(ToplevelRef-pos exp)))
|
||||
,(make-AssignImmediateStatement
|
||||
target
|
||||
(make-EnvPrefixReference (ToplevelRef-depth exp)
|
||||
(ToplevelRef-pos exp)))))))
|
||||
|
||||
|
||||
(: compile-toplevel-set (ToplevelSet Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-toplevel-set exp cenv target linkage)
|
||||
(let* ([var (ToplevelSet-name exp)]
|
||||
[lexical-pos (make-EnvPrefixReference (ToplevelSet-depth exp)
|
||||
(ToplevelSet-pos exp)
|
||||
(ToplevelSet-name exp))])
|
||||
(let ([get-value-code
|
||||
(parameterize ([current-defined-name var])
|
||||
(compile (Def-value exp) cenv lexical-pos
|
||||
'next))])
|
||||
(end-with-linkage
|
||||
linkage
|
||||
cenv
|
||||
(append-instruction-sequences
|
||||
get-value-code
|
||||
(make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Const 'ok)))))))))
|
||||
|
||||
|
||||
(: compile-branch (Branch Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-branch exp cenv target linkage)
|
||||
(let ([t-branch (make-label 'trueBranch)]
|
||||
[f-branch (make-label 'falseBranch)]
|
||||
|
|
@ -216,7 +197,7 @@
|
|||
after-if))))))
|
||||
|
||||
|
||||
(: compile-sequence ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(: compile-sequence ((Listof Expression) Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-sequence seq cenv target linkage)
|
||||
;; All but the last will use 'next linkage.
|
||||
(if (last-exp? seq)
|
||||
|
|
@ -225,7 +206,7 @@
|
|||
(compile-sequence (rest-exps seq) cenv target linkage))))
|
||||
|
||||
|
||||
(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(: compile-lambda (Lam Natural Target Linkage -> InstructionSequence))
|
||||
;; Write out code for lambda expressions.
|
||||
;; The lambda will close over the free variables.
|
||||
(define (compile-lambda exp cenv target linkage)
|
||||
|
|
@ -234,94 +215,34 @@
|
|||
[lambda-linkage : Linkage
|
||||
(if (eq? linkage 'next)
|
||||
after-lambda
|
||||
linkage)]
|
||||
[free-vars : (Listof Symbol) (find-toplevel-variables exp)]
|
||||
[lexical-addresses : (Listof LexicalAddress)
|
||||
(map (lambda: ([var : Symbol])
|
||||
(find-variable var cenv))
|
||||
free-vars)]
|
||||
[lexical-references : (Listof EnvReference)
|
||||
(collect-lexical-references lexical-addresses)])
|
||||
linkage)])
|
||||
(append-instruction-sequences
|
||||
(end-with-linkage
|
||||
lambda-linkage
|
||||
cenv
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignPrimOpStatement target
|
||||
(make-MakeCompiledProcedure proc-entry
|
||||
(length (Lam-parameters exp))
|
||||
lexical-references
|
||||
(current-defined-name))))))
|
||||
(compile-lambda-body exp cenv
|
||||
lexical-references
|
||||
free-vars
|
||||
proc-entry)
|
||||
`(,(make-AssignPrimOpStatement
|
||||
target
|
||||
(make-MakeCompiledProcedure proc-entry
|
||||
(Lam-num-parameters exp)
|
||||
(map make-Const (Lam-closure-map exp))
|
||||
(current-defined-name))))))
|
||||
(compile-lambda-body exp proc-entry)
|
||||
after-lambda)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(: compile-lambda-body (Lam CompileTimeEnvironment
|
||||
(Listof EnvReference)
|
||||
(Listof Symbol)
|
||||
Linkage
|
||||
->
|
||||
InstructionSequence))
|
||||
(: compile-lambda-body (Lam Linkage -> InstructionSequence))
|
||||
;; Compiles the body of the lambda in the appropriate environment.
|
||||
(define (compile-lambda-body exp cenv lexical-references free-variables proc-entry)
|
||||
(let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
|
||||
[extended-cenv : CompileTimeEnvironment
|
||||
(extend-lexical-environment/names
|
||||
'()
|
||||
formals)]
|
||||
[extended-cenv : CompileTimeEnvironment
|
||||
(lexical-references->compile-time-environment
|
||||
lexical-references cenv extended-cenv
|
||||
free-variables)])
|
||||
(append-instruction-sequences
|
||||
(make-instruction-sequence
|
||||
`(,proc-entry
|
||||
,(make-PerformStatement (make-InstallClosureValues!))))
|
||||
(compile (Lam-body exp) extended-cenv 'val 'return))))
|
||||
|
||||
|
||||
|
||||
#;(: compile-letrec (Letrec CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
#;(define (compile-letrec exp cenv target linkage)
|
||||
(let* ([after-let (make-label 'afterLet)]
|
||||
[let-linkage (if (eq? linkage 'next)
|
||||
after-let
|
||||
linkage)]
|
||||
[extended-cenv : CompileTimeEnvironment
|
||||
(extend-lexical-environment/names
|
||||
'()
|
||||
(reverse (Letrec-names exp)))]
|
||||
[lam-codes : (Listof InstructionSequence)
|
||||
(let: ([n : Natural (length (Letrec-procs exp))])
|
||||
(map (lambda: ([lam : Lam]
|
||||
[target : Target])
|
||||
(compile-lambda lam extended-cenv target 'next))
|
||||
(Letrec-procs exp)
|
||||
(build-list (length (Letrec-procs exp))
|
||||
(lambda: ([i : Natural])
|
||||
(make-EnvLexicalReference (- n 1 i))))))]
|
||||
[body-code : InstructionSequence
|
||||
(compile (Letrec-body exp) extended-cenv target let-linkage)]
|
||||
(append-instruction-sequences
|
||||
(end-with-linkage let-linkage cenv
|
||||
(make-instruction-sequence `(;; create space for the lambdas
|
||||
,(make-PushEnvironment n)
|
||||
;; install each one of them in place
|
||||
(apply append-instruction-sequences lam-codes)
|
||||
;; mutate each of the lambda's shells so they're correct
|
||||
|
||||
;; evaluate the body
|
||||
body-code
|
||||
;; pop the temporary space
|
||||
)))
|
||||
after-let))))
|
||||
(define (compile-lambda-body exp proc-entry)
|
||||
(append-instruction-sequences
|
||||
(make-instruction-sequence
|
||||
`(,proc-entry
|
||||
,(make-PerformStatement (make-InstallClosureValues!))))
|
||||
(compile (Lam-body exp)
|
||||
(+ (Lam-num-parameters exp)
|
||||
(length (Lam-closure-map exp)))
|
||||
'val
|
||||
'return)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -329,9 +250,9 @@
|
|||
;; FIXME: I need to implement important special cases.
|
||||
;; 1. We may be able to open-code if the operator is primitive
|
||||
;; 2. We may have a static location to jump to if the operator is lexically scoped.
|
||||
(: compile-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(: compile-application (App Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-application exp cenv target linkage)
|
||||
(let* ([extended-cenv (extend-lexical-environment/placeholders cenv (length (App-operands exp)))]
|
||||
(let* ([extended-cenv (+ cenv (length (App-operands exp)))]
|
||||
[proc-code (compile (App-operator exp)
|
||||
extended-cenv
|
||||
(if (empty? (App-operands exp))
|
||||
|
|
@ -354,7 +275,8 @@
|
|||
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
|
||||
proc-code
|
||||
(juggle-operands operand-codes)
|
||||
(compile-procedure-call cenv extended-cenv
|
||||
(compile-procedure-call cenv
|
||||
extended-cenv
|
||||
(length (App-operands exp))
|
||||
target linkage))))
|
||||
|
||||
|
|
@ -388,10 +310,10 @@
|
|||
|
||||
|
||||
|
||||
(: compile-procedure-call (CompileTimeEnvironment CompileTimeEnvironment
|
||||
Natural Target Linkage
|
||||
->
|
||||
InstructionSequence))
|
||||
(: compile-procedure-call (Natural Natural
|
||||
Natural Target Linkage
|
||||
->
|
||||
InstructionSequence))
|
||||
;; Assumes the procedure value has been loaded into the proc register.
|
||||
;; n is the number of arguments passed in.
|
||||
;; cenv is the compile-time enviroment before arguments have been shifted in.
|
||||
|
|
@ -518,8 +440,8 @@
|
|||
|
||||
|
||||
|
||||
(: compile-let (Let CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-let exp cenv target linkage)
|
||||
(: compile-let-void (LetVoid CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-let-void exp cenv target linkage)
|
||||
(let*: ([n : Natural (length (Let-rhss exp))]
|
||||
[rhs-codes : (Listof InstructionSequence)
|
||||
(map (lambda: ([rhs : ExpressionCore]
|
||||
|
|
@ -603,6 +525,14 @@
|
|||
|
||||
|
||||
|
||||
(: compile-install-value (InstallValue Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-install-value exp cenv target linkage)
|
||||
(compile (InstallValue-body exp)
|
||||
cenv
|
||||
(make-EnvLexicalReference (InstallValue-depth exp) (InstallValue-box? exp))
|
||||
linkage))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -622,6 +552,7 @@
|
|||
(append-2-sequences (car seqs)
|
||||
(append-seq-list (cdr seqs)))))
|
||||
|
||||
|
||||
(: ensure-natural (Integer -> Natural))
|
||||
(define (ensure-natural n)
|
||||
(if (>= n 0)
|
||||
|
|
@ -630,7 +561,6 @@
|
|||
|
||||
|
||||
|
||||
|
||||
(: adjust-target-depth (Target Natural -> Target))
|
||||
(define (adjust-target-depth target n)
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@
|
|||
|
||||
(define-struct: InstallValue ([depth : Natural]
|
||||
[body : ExpressionCore]
|
||||
[boxes? : Boolean])
|
||||
[box? : Boolean])
|
||||
#:transparent)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -36,8 +36,7 @@
|
|||
[(Prefix? elt)
|
||||
(cond [(member name (Prefix-names elt))
|
||||
(make-EnvPrefixReference depth
|
||||
(find-pos name (Prefix-names elt))
|
||||
name)]
|
||||
(find-pos name (Prefix-names elt)))]
|
||||
[else
|
||||
(loop (rest cenv) (add1 depth))])]
|
||||
|
||||
|
|
@ -183,8 +182,7 @@
|
|||
(EnvLexicalReference-unbox? target))]
|
||||
[(EnvPrefixReference? target)
|
||||
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
|
||||
(EnvPrefixReference-pos target)
|
||||
(EnvPrefixReference-name target))]
|
||||
(EnvPrefixReference-pos target))]
|
||||
[(EnvWholePrefixReference? target)
|
||||
(make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))]))
|
||||
|
||||
|
|
|
|||
|
|
@ -37,8 +37,7 @@
|
|||
#:transparent)
|
||||
|
||||
(define-struct: EnvPrefixReference ([depth : Natural]
|
||||
[pos : Natural]
|
||||
[name : Symbol])
|
||||
[pos : Natural])
|
||||
#:transparent)
|
||||
|
||||
(define-struct: EnvWholePrefixReference ([depth : Natural])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user