adding more of the singular checks

This commit is contained in:
Danny Yoo 2011-04-17 14:31:42 -04:00
parent 97ace1e517
commit 832df0a2be

View File

@ -303,14 +303,16 @@
(ToplevelSet-pos exp))]) (ToplevelSet-pos exp))])
(let ([get-value-code (let ([get-value-code
(compile (ToplevelSet-value exp) cenv lexical-pos (compile (ToplevelSet-value exp) cenv lexical-pos
next-linkage-expects-single)]) next-linkage-expects-single)]
[singular-context-check (compile-singular-context-check linkage)])
(end-with-linkage (end-with-linkage
linkage linkage
cenv cenv
(append-instruction-sequences (append-instruction-sequences
get-value-code get-value-code
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Const (void)))))))))) `(,(make-AssignImmediateStatement target (make-Const (void)))))
singular-context-check)))))
(: compile-branch (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile-branch (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence))
@ -399,35 +401,41 @@
;; 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. ;; 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)
(end-with-linkage (let ([singular-context-check (compile-singular-context-check linkage)])
linkage (end-with-linkage
cenv linkage
(make-instruction-sequence cenv
`(,(make-AssignPrimOpStatement (append-instruction-sequences
target (make-instruction-sequence
(make-MakeCompiledProcedure (Lam-entry-label exp) `(,(make-AssignPrimOpStatement
(if (Lam-rest? exp) target
(make-ArityAtLeast (Lam-num-parameters exp)) (make-MakeCompiledProcedure (Lam-entry-label exp)
(Lam-num-parameters exp)) (if (Lam-rest? exp)
(Lam-closure-map exp) (make-ArityAtLeast (Lam-num-parameters exp))
(Lam-name exp))))))) (Lam-num-parameters exp))
(Lam-closure-map exp)
(Lam-name exp)))))
singular-context-check))))
(: compile-lambda-shell (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile-lambda-shell (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
;; Write out code for lambda expressions, minus the closure map. ;; Write out code for lambda expressions, minus the closure map.
;; Assumption: all of the lambda bodies have already been written out at the top, in -compile. ;; Assumption: all of the lambda bodies have already been written out at the top, in -compile.
(define (compile-lambda-shell exp cenv target linkage) (define (compile-lambda-shell exp cenv target linkage)
(end-with-linkage (let ([singular-context-check (compile-singular-context-check linkage)])
linkage (end-with-linkage
cenv linkage
(make-instruction-sequence cenv
`(,(make-AssignPrimOpStatement (append-instruction-sequences
target (make-instruction-sequence
(make-MakeCompiledProcedureShell (Lam-entry-label exp) `(,(make-AssignPrimOpStatement
(if (Lam-rest? exp) target
(make-ArityAtLeast (Lam-num-parameters exp)) (make-MakeCompiledProcedureShell (Lam-entry-label exp)
(Lam-num-parameters exp)) (if (Lam-rest? exp)
(Lam-name exp))))))) (make-ArityAtLeast (Lam-num-parameters exp))
(Lam-num-parameters exp))
(Lam-name exp)))))
singular-context-check))))
(: compile-lambda-body (Lam CompileTimeEnvironment -> InstructionSequence)) (: compile-lambda-body (Lam CompileTimeEnvironment -> InstructionSequence))