working on begin0 implementation; not tested yet
This commit is contained in:
parent
6ceb708917
commit
d1f2f6b277
83
compiler.rkt
83
compiler.rkt
|
@ -469,12 +469,85 @@
|
|||
|
||||
(: compile-begin0 ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(define (compile-begin0 seq cenv target linkage)
|
||||
(let ([context (linkage-context linkage)])
|
||||
empty-instruction-sequence))
|
||||
;(cond
|
||||
;[(empty? seq)
|
||||
; (end-with-linkage empty-instruction-sequence
|
||||
(cond
|
||||
[(empty? seq)
|
||||
(end-with-linkage linkage cenv empty-instruction-sequence)]
|
||||
[(empty? (rest seq))
|
||||
(compile (first seq) cenv target linkage)]
|
||||
[else
|
||||
|
||||
(let ([after-first-seq (make-label 'afterFirstSeqEvaluated)]
|
||||
[after-values-reinstated (make-label 'afterValuesReinstated)])
|
||||
|
||||
(end-with-linkage
|
||||
linkage
|
||||
cenv
|
||||
(append-instruction-sequences
|
||||
|
||||
;; Evaluate the first expression in a multiple-value context, and get the values on the stack.
|
||||
(compile (first seq)
|
||||
cenv
|
||||
'val
|
||||
next-linkage/keep-multiple-on-stack)
|
||||
(make-instruction-sequence
|
||||
`(,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-first-seq)
|
||||
,(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)))
|
||||
after-first-seq
|
||||
|
||||
;; At this time, the argcount values are on the stack.
|
||||
;; Next, we save those values temporarily in a throwaway control frame.
|
||||
(make-instruction-sequence
|
||||
`(,(make-PushControlFrame/Generic)
|
||||
,(make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingBegin0Count)
|
||||
(make-Reg 'argcount))
|
||||
,(make-PerformStatement (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount)))
|
||||
,(make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingBegin0Values)
|
||||
(make-EnvLexicalReference 0 #f))
|
||||
,(make-PopEnvironment (make-Const 1) (make-Const 0))))
|
||||
|
||||
;; Evaluate the rest of the sequence, dropping their values.
|
||||
(compile-sequence (rest seq) cenv target next-linkage/drop-multiple)
|
||||
|
||||
(make-instruction-sequence
|
||||
`(;; Reinstate the values of the first expression, and drop the throwaway control frame.
|
||||
,(make-PushImmediateOntoEnvironment (make-ControlFrameTemporary 'pendingBegin0Values) #f)
|
||||
,(make-PerformStatement (make-SpliceListIntoStack! (make-Const 0)))
|
||||
,(make-AssignImmediateStatement 'argcount (make-ControlFrameTemporary 'pendingBegin0Count))
|
||||
,(make-PopControlFrame)
|
||||
,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-values-reinstated)
|
||||
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
|
||||
,(make-PopEnvironment (make-Const 1) (make-Const 0))
|
||||
after-values-reinstated))
|
||||
|
||||
(let ([context (linkage-context linkage)])
|
||||
(cond
|
||||
[(eq? context 'tail)
|
||||
empty-instruction-sequence]
|
||||
|
||||
[(eq? context 'drop-multiple)
|
||||
(make-instruction-sequence
|
||||
`(,(make-PopEnvironment (make-SubtractArg (make-Reg 'argcount) (make-Const 1))
|
||||
(make-Const 0))))]
|
||||
|
||||
[(eq? context 'keep-multiple)
|
||||
empty-instruction-sequence]
|
||||
|
||||
[(natural? context)
|
||||
;; Check that the context can accept the argcount values.
|
||||
(let ([after-check (make-label 'afterCheck)])
|
||||
(make-instruction-sequence
|
||||
`(,(make-TestAndBranchStatement (make-TestZero (make-SubtractArg
|
||||
(make-Reg 'argcount)
|
||||
(make-Const context)))
|
||||
after-check)
|
||||
,(make-PerformStatement (make-RaiseContextExpectedValuesError! context))
|
||||
after-check)))]))
|
||||
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignImmediateStatement target (make-Reg 'val))))
|
||||
)))]))
|
||||
|
||||
|
||||
|
||||
|
||||
(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
|
|
|
@ -47,7 +47,8 @@
|
|||
;; When we need to store a value temporarily in the top control frame, we can use this as a target.
|
||||
(define-struct: ControlFrameTemporary ([name : (U 'pendingContinuationMarkKey ;; for continuation marks
|
||||
'pendingApplyValuesProc ;; for apply-values
|
||||
'pendingBegin0Value
|
||||
'pendingBegin0Count
|
||||
'pendingBegin0Values
|
||||
)])
|
||||
#:transparent)
|
||||
|
||||
|
|
|
@ -104,7 +104,8 @@
|
|||
// stash the key in here temporarily.
|
||||
this.pendingContinuationMarkKey = undefined;
|
||||
this.pendingApplyValuesProc = undefined;
|
||||
this.pendingBegin0Value = undefined;
|
||||
this.pendingBegin0Count = undefined;
|
||||
this.pendingBegin0Values = undefined;
|
||||
};
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user