begin0 not quite done yet, but I need to get other things working first.
This commit is contained in:
Danny Yoo
parent
01f2bc7566
commit
cfa1874f0a
134
compiler.rkt
134
compiler.rkt
|
|
@ -480,7 +480,7 @@
|
|||
(: compile-splice ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; Compiles a sequence of expressions. A continuation prompt wraps around each of the expressions
|
||||
;; to delimit any continuation captures.
|
||||
(define (compile-splice seq cenv target linkage)
|
||||
(define (compile-splice seq cenv target linkage)
|
||||
(cond [(empty? seq)
|
||||
(end-with-linkage linkage cenv empty-instruction-sequence)]
|
||||
[(empty? (rest seq))
|
||||
|
|
@ -527,78 +527,74 @@
|
|||
(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)])
|
||||
(let ([evaluate-and-save-first-expression
|
||||
(let ([after-first-seq (make-label 'afterFirstSeqEvaluated)])
|
||||
(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-SubtractArg
|
||||
(make-Reg 'argcount)
|
||||
(make-Const context)))
|
||||
after-check)
|
||||
,(make-PerformStatement (make-RaiseContextExpectedValuesError! context))
|
||||
,after-check)))]))
|
||||
`(,(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))))))]
|
||||
|
||||
[reinstate-values-on-stack
|
||||
(let ([after-values-reinstated (make-label 'afterValuesReinstated)])
|
||||
(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)))])
|
||||
|
||||
(append-instruction-sequences
|
||||
evaluate-and-save-first-expression
|
||||
|
||||
(compile-sequence (rest seq) cenv target next-linkage/drop-multiple)
|
||||
|
||||
reinstate-values-on-stack
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignImmediateStatement target (make-Reg 'val))))
|
||||
)))]))
|
||||
|
||||
|
||||
|
||||
;; TODO: context needs check for arguments.
|
||||
(cond
|
||||
[(ReturnLinkage? linkage)
|
||||
(cond
|
||||
[(ReturnLinkage-tail? linkage)
|
||||
(make-instruction-sequence
|
||||
`(,(make-PopEnvironment (make-Const (length cenv))
|
||||
(make-SubtractArg (make-Reg 'argcount)
|
||||
(make-Const 1)))
|
||||
,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
|
||||
,(make-PopControlFrame)
|
||||
,(make-GotoStatement (make-Reg 'proc))))]
|
||||
[else
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
|
||||
,(make-PopControlFrame)
|
||||
,(make-GotoStatement (make-Reg 'proc))))])]
|
||||
|
||||
[(NextLinkage? linkage)
|
||||
empty-instruction-sequence]
|
||||
|
||||
[(LabelLinkage? linkage)
|
||||
(make-instruction-sequence
|
||||
`(,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))])))]))
|
||||
|
||||
|
||||
|
||||
|
||||
(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
|
|
|
|||
|
|
@ -1338,8 +1338,8 @@
|
|||
#:with-bootstrapping? #t)
|
||||
|
||||
(test '(let () (define (f x y z)
|
||||
(begin0 (values y x z)
|
||||
(display "")))
|
||||
(begin0 (values y x z)
|
||||
(display "")))
|
||||
(call-with-values (lambda () (f 3 1 4))
|
||||
(lambda args (list args))))
|
||||
'((1 3 4))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user