From d1f2f6b277236fc110ff11146c65ee2f073b62cb Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Tue, 10 May 2011 15:59:44 -0400
Subject: [PATCH] working on begin0 implementation; not tested yet

---
 compiler.rkt   | 83 +++++++++++++++++++++++++++++++++++++++++++++++---
 il-structs.rkt |  3 +-
 runtime.js     |  3 +-
 3 files changed, 82 insertions(+), 7 deletions(-)

diff --git a/compiler.rkt b/compiler.rkt
index d3917bc..66910ad 100644
--- a/compiler.rkt
+++ b/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))
diff --git a/il-structs.rkt b/il-structs.rkt
index 3a90d5b..cafdd72 100644
--- a/il-structs.rkt
+++ b/il-structs.rkt
@@ -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)
 
diff --git a/runtime.js b/runtime.js
index 4495d51..af0aef2 100644
--- a/runtime.js
+++ b/runtime.js
@@ -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;
     };