From 8fd768e4ef8ed1ddf9bd865ecd9fe314504b6928 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@hashcollision.org>
Date: Wed, 17 Apr 2013 16:12:33 -0600
Subject: [PATCH] correcting the return from prompt linkage in the repl
 compiled output.

---
 whalesong/compiler/compiler.rkt   | 55 ++++++++++---------------------
 whalesong/compiler/il-structs.rkt | 17 +++++++---
 2 files changed, 30 insertions(+), 42 deletions(-)

diff --git a/whalesong/compiler/compiler.rkt b/whalesong/compiler/compiler.rkt
index 68faee3..5356546 100644
--- a/whalesong/compiler/compiler.rkt
+++ b/whalesong/compiler/compiler.rkt
@@ -77,10 +77,10 @@
 (define (compile-for-repl exp)
   (define lambda-bodies (collect-all-lambdas-with-bodies exp))
   (define after-lam-bodies: (make-label 'afterLamBodies))
-  (define after-first-seq: (make-label 'afterFirstSeq))
+  (define bundle-values-into-list: (make-label 'bundleValuesIntoList))
   (define abort-with-multiple-values: (make-label 'abortWithMultipleValues))
   (define last: (make-label 'last))
-  (define-values (after-pop-prompt-multiple: after-pop-prompt:)
+  (define-values (handle-multiple-return: handle-return:)
     (new-linked-labels 'afterPopPrompt))
   
   (optimize-il
@@ -94,46 +94,27 @@
      
      ;; Begin a prompted evaluation:
      (make-PushControlFrame/Prompt default-continuation-prompt-tag
-                                   after-pop-prompt: ;; <--- FIXME: this argument isn't used right now!
-                                   after-pop-prompt:)
-     (compile exp '() 'val next-linkage/keep-multiple-on-stack)
-        
-     ;; After coming back from the evaluation, rearrange the return values
-     ;; as a list.
-     (make-PopControlFrame)             ; pop off the synthetic prompt frame
-     (make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-first-seq:)
+                                   handle-return:
+                                   #f)
+     (compile exp '() 'val return-linkage/nontail)
+      
+     handle-multiple-return:
+     ;; After coming back from the evaluation, rearrange the return
+     ;; values as a list.
+     (make-TestAndJump (make-TestZero (make-Reg 'argcount)) 
+                       bundle-values-into-list:)
+     handle-return:
      (make-PushImmediateOntoEnvironment (make-Reg 'val) #f)     
-     after-first-seq:
-     (make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount)))
+     bundle-values-into-list:
+     (make-Perform (make-UnspliceRestFromStack! 
+                    (make-Const 0) (make-Reg 'argcount)))
      (make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
      (make-PopEnvironment (make-Const 1) (make-Const 0))
      (make-Goto (make-Label last:))
      
-
-     ;; If we abort, the abort handler code should call the expected thunk
-     ;; with a return going to this code:
-     ;; FIXME
-
-
-     after-pop-prompt-multiple:
-     (make-DebugPrint (make-Const "abort multiple"))
-     (make-TestAndJump (make-TestZero (make-Reg 'argcount)) abort-with-multiple-values:)
-     (make-PushImmediateOntoEnvironment (make-Reg 'val) #f)     
-     abort-with-multiple-values:
-     (make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount)))
-     (make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
-     (make-PopEnvironment (make-Const 1) (make-Const 0))
-     (make-Goto (make-Label last:))
-
-     after-pop-prompt:
-     (make-DebugPrint (make-Const "abort single"))
-      
-     ;; If we escaped with a single value, return that single value in a singleton list
-     (make-PushImmediateOntoEnvironment (make-Reg 'val) #f)     
-     (make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Const 1)))
-     (make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
-     (make-PopEnvironment (make-Const 1) (make-Const 0))
-     (make-Goto (make-Label last:))
+     ;; FIXME: missing the abort handler.  if we abort, we want the
+     ;; handler to call the thunk in the context that packages the
+     ;; results into a list.
 
      last:
      ;; Finally, return to the success continuation on the stack.
diff --git a/whalesong/compiler/il-structs.rkt b/whalesong/compiler/il-structs.rkt
index 1b11691..7b3785f 100644
--- a/whalesong/compiler/il-structs.rkt
+++ b/whalesong/compiler/il-structs.rkt
@@ -265,13 +265,20 @@
 (define-struct: PushControlFrame/Call ([label : LinkedLabel]) 
   #:transparent)
 
-(define-struct: PushControlFrame/Prompt ([tag : (U OpArg DefaultContinuationPromptTag)]
-                                         [label : LinkedLabel]
-                                         [handler : (U LinkedLabel #f)]
-                                         ;; TODO: add arguments to the handler?
-                                         )
+(define-struct: PushControlFrame/Prompt
+  ([tag : (U OpArg DefaultContinuationPromptTag)]
+   [label : LinkedLabel]
+   [handler : (U #f 
+                 ;; #f stands for using the default abort handler.
+                 ;;
+                 ;; The only other case the compiler needs to deal
+                 ;; with is capturing a closure, when we need to abort
+                 ;; with a special handler (currently for repl).
+                 ;; Maybe just use the 'proc register for simplicity?
+                 #;OpArg)])
   #:transparent)
 
+
 (define-struct: DefaultContinuationPromptTag ()
   #:transparent)
 (define default-continuation-prompt-tag