changed layout of lambdas so they come at the top of the instruction sequence.
This commit is contained in:
parent
74422b3171
commit
3a13d5262e
111
compile.rkt
111
compile.rkt
|
@ -25,11 +25,64 @@
|
||||||
|
|
||||||
(: -compile (ExpressionCore Target Linkage -> (Listof Statement)))
|
(: -compile (ExpressionCore Target Linkage -> (Listof Statement)))
|
||||||
(define (-compile exp target linkage)
|
(define (-compile exp target linkage)
|
||||||
|
(let ([after-lam-bodies (make-label 'afterLamBodies)])
|
||||||
(statements
|
(statements
|
||||||
(compile exp
|
(append-instruction-sequences (make-instruction-sequence
|
||||||
'()
|
`(,(make-GotoStatement (make-Label after-lam-bodies))))
|
||||||
target
|
(compile-lambda-bodies (collect-all-lams exp))
|
||||||
linkage)))
|
after-lam-bodies
|
||||||
|
(compile exp
|
||||||
|
'()
|
||||||
|
target
|
||||||
|
linkage)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(: collect-all-lams (ExpressionCore -> (Listof Lam)))
|
||||||
|
;; Finds all the lambdas in the expression.
|
||||||
|
(define (collect-all-lams exp)
|
||||||
|
(let: loop : (Listof Lam) ([exp : ExpressionCore exp])
|
||||||
|
(cond
|
||||||
|
[(Top? exp)
|
||||||
|
(loop (Top-code exp))]
|
||||||
|
[(Constant? exp)
|
||||||
|
'()]
|
||||||
|
[(LocalRef? exp)
|
||||||
|
'()]
|
||||||
|
[(ToplevelRef? exp)
|
||||||
|
'()]
|
||||||
|
[(ToplevelSet? exp)
|
||||||
|
(loop (ToplevelSet-value exp))]
|
||||||
|
[(Branch? exp)
|
||||||
|
(append (loop (Branch-predicate exp))
|
||||||
|
(loop (Branch-consequent exp))
|
||||||
|
(loop (Branch-alternative exp)))]
|
||||||
|
[(Lam? exp)
|
||||||
|
(cons exp (loop (Lam-body exp)))]
|
||||||
|
[(Seq? exp)
|
||||||
|
(apply append (map loop (Seq-actions exp)))]
|
||||||
|
[(App? exp)
|
||||||
|
(append (loop (App-operator exp))
|
||||||
|
(apply append (map loop (App-operands exp))))]
|
||||||
|
[(Let1? exp)
|
||||||
|
(append (loop (Let1-rhs exp))
|
||||||
|
(loop (Let1-body exp)))]
|
||||||
|
[(LetVoid? exp)
|
||||||
|
(loop (LetVoid-body exp))]
|
||||||
|
[(InstallValue? exp)
|
||||||
|
(loop (InstallValue-body exp))]
|
||||||
|
[(BoxEnv? exp)
|
||||||
|
'()])))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -215,34 +268,25 @@
|
||||||
(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||||
;; Write out code for lambda expressions.
|
;; Write out code for lambda expressions.
|
||||||
;; The lambda will close over the free variables.
|
;; The lambda will close over the free variables.
|
||||||
|
;; Assumption: all of the lambda bodies have already been written out at the top, in -compile.
|
||||||
(define (compile-lambda exp cenv target linkage)
|
(define (compile-lambda exp cenv target linkage)
|
||||||
(let*: ([proc-entry : Symbol (Lam-entry-label exp) #;(make-label 'entry)]
|
(end-with-linkage
|
||||||
[after-lambda : Symbol (make-label 'afterLambda)]
|
linkage
|
||||||
[lambda-linkage : Linkage
|
cenv
|
||||||
(if (eq? linkage 'next)
|
(make-instruction-sequence
|
||||||
after-lambda
|
`(,(make-AssignPrimOpStatement
|
||||||
linkage)])
|
target
|
||||||
(append-instruction-sequences
|
(make-MakeCompiledProcedure (Lam-entry-label exp)
|
||||||
(end-with-linkage
|
(Lam-num-parameters exp)
|
||||||
lambda-linkage
|
(Lam-closure-map exp)
|
||||||
cenv
|
(Lam-name exp)))))))
|
||||||
(make-instruction-sequence
|
|
||||||
`(,(make-AssignPrimOpStatement
|
|
||||||
target
|
|
||||||
(make-MakeCompiledProcedure proc-entry
|
|
||||||
(Lam-num-parameters exp)
|
|
||||||
(Lam-closure-map exp)
|
|
||||||
(Lam-name exp))))))
|
|
||||||
(compile-lambda-body exp proc-entry)
|
|
||||||
after-lambda)))
|
|
||||||
|
|
||||||
|
(: compile-lambda-body (Lam -> InstructionSequence))
|
||||||
(: compile-lambda-body (Lam Linkage -> InstructionSequence))
|
|
||||||
;; Compiles the body of the lambda in the appropriate environment.
|
;; Compiles the body of the lambda in the appropriate environment.
|
||||||
(define (compile-lambda-body exp proc-entry)
|
(define (compile-lambda-body exp)
|
||||||
(append-instruction-sequences
|
(append-instruction-sequences
|
||||||
(make-instruction-sequence
|
(make-instruction-sequence
|
||||||
`(,proc-entry
|
`(,(Lam-entry-label exp)
|
||||||
,(make-PerformStatement (make-InstallClosureValues!))))
|
,(make-PerformStatement (make-InstallClosureValues!))))
|
||||||
(compile (Lam-body exp)
|
(compile (Lam-body exp)
|
||||||
(build-list (+ (Lam-num-parameters exp)
|
(build-list (+ (Lam-num-parameters exp)
|
||||||
|
@ -251,6 +295,19 @@
|
||||||
'val
|
'val
|
||||||
'return)))
|
'return)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(: compile-lambda-bodies ((Listof Lam) -> InstructionSequence))
|
||||||
|
;; Compile several lambda bodies, back to back.
|
||||||
|
(define (compile-lambda-bodies exps)
|
||||||
|
(cond
|
||||||
|
[(empty? exps)
|
||||||
|
(make-instruction-sequence '())]
|
||||||
|
[else
|
||||||
|
(append-instruction-sequences (compile-lambda-body (first exps))
|
||||||
|
(compile-lambda-bodies (rest exps)))]))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user