begin0 not quite done yet, but I need to get other things working first.

compiler.rkt

@@ -527,76 +527,72 @@
      (compile (first seq) cenv target linkage)]
     [else
      
-     (let ([after-first-seq (make-label 'afterFirstSeqEvaluated)]
+     (let ([evaluate-and-save-first-expression
-           [after-values-reinstated (make-label 'afterValuesReinstated)])
+            (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-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)))])
        
-       (end-with-linkage 
-        linkage 
-        cenv
        (append-instruction-sequences
+        evaluate-and-save-first-expression        
         
-        ;; 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-values-on-stack        
-         `(;; 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))))
-        )))]))
+        
+        ;; 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)))))])))]))
               
        
 

test-compiler.rkt

@@ -1338,8 +1338,8 @@
         #:with-bootstrapping? #t)
 
 (test '(let () (define (f x y z)
-                   (begin0 (values y x z)
+                 (begin0 (values y x z)
-                           (display "")))
+                         (display "")))
            (call-with-values (lambda () (f 3 1 4))
                              (lambda args (list args))))
         '((1 3 4))