From f581b027a2e3c2f8d0b7637b76bef5db9632bbb8 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Fri, 1 Apr 2011 13:37:07 -0400
Subject: [PATCH] weakening the optimization: it's not sound if there's
 mutation, and I don't currently analyze operands for mutation yet.

---
 compile.rkt       | 12 ++++++++----
 test-compiler.rkt | 28 ++++++++++++++++++++++++++++
 test-parse.rkt    | 24 ++++++++++++++++++++++++
 3 files changed, 60 insertions(+), 4 deletions(-)

diff --git a/compile.rkt b/compile.rkt
index 706b0de..18d03ed 100644
--- a/compile.rkt
+++ b/compile.rkt
@@ -533,7 +533,7 @@
                     (kernel-primitive-expected-operand-types kernel-op n)]
                    
                    [(constant-operands rest-operands)
-                    (split-operands-by-constant-or-stack-references 
+                    (split-operands-by-constants 
                      (App-operands exp))]
                    
                    ;; here, we rewrite the stack references so they assume no scratch space
@@ -668,13 +668,15 @@
             #f])]))
 
 
-(: split-operands-by-constant-or-stack-references 
+(: split-operands-by-constants 
    ((Listof Expression)  -> 
                          (values (Listof (U Constant LocalRef ToplevelRef))
                                  (Listof Expression))))
 ;; Splits off the list of operations into two: a prefix of constant
 ;; or simple expressions, and the remainder.
-(define (split-operands-by-constant-or-stack-references rands)
+;; TODO: if we can statically determine what arguments are immutable, regardless of
+;; side effects, we can do a much better job here...
+(define (split-operands-by-constants rands)
   (let: loop : (values (Listof (U Constant LocalRef ToplevelRef)) (Listof Expression))
         ([rands : (Listof Expression) rands]
          [constants : (Listof (U Constant LocalRef ToplevelRef))
@@ -683,7 +685,9 @@
                (values (reverse constants) empty)]
               [else (let ([e (first rands)])
                       (if (or (Constant? e)
-                              (and (LocalRef? e) (not (LocalRef-unbox? e))) 
+                              
+                              ;; These two are commented out because it's not sound otherwise.
+                              #;(and (LocalRef? e) (not (LocalRef-unbox? e))) 
                               #;(and (ToplevelRef? e)
                                      (let ([prefix (ensure-prefix 
                                                     (list-ref cenv (ToplevelRef-depth e)))])
diff --git a/test-compiler.rkt b/test-compiler.rkt
index f376a54..9cab466 100644
--- a/test-compiler.rkt
+++ b/test-compiler.rkt
@@ -811,6 +811,34 @@
 
 
 
+
+
+(test '(begin (define (f)
+                  (define cont #f)
+                  (define n 0)
+                  (call/cc (lambda (x) (set! cont x)))
+                  (set! n (add1 n))
+                  (if (< n 10)
+                    (cont 'dontcare))
+                  n)
+                (f))
+        10)
+
+
+;; This should produce 0 because there needs to be a continuation prompt around each evaluation.
+#;(test '(begin 
+           (define cont #f)
+           (define n 0)
+           (call/cc (lambda (x) (set! cont x)))
+           (set! n (add1 n))
+           (if (< n 10)
+             (cont 'dontcare))
+           n)
+        0)
+
+
+
+
 ;; FIXME: this test is failing.  I think we need prompts to delimit
 ;; the continuation capture.
 #;(test '(begin
diff --git a/test-parse.rkt b/test-parse.rkt
index 2b6b83c..226e9d2 100644
--- a/test-parse.rkt
+++ b/test-parse.rkt
@@ -325,6 +325,30 @@
                               #t)))
 
 
+
+
+;; This hsould only show 0, because there should be a prompt that controls continuation capture
+#;(test '(begin (define cont #f)
+                (define n 0)
+                (call/cc (lambda (x) (set! cont x)))
+                (displayln n) 
+                (set! n (add1 n))
+                (when (< n 10)
+                  (cont))))
+
+
+;; This should show the numbers 0 through 10
+#;(test '(begin (define (f)
+                  (define cont #f)
+                  (define n 0)
+                  (call/cc (lambda (x) (set! cont x)))
+                  (displayln n) 
+                  (set! n (add1 n))
+                  (when (< n 10)
+                    (cont)))
+                (f)))
+
+
 #;(test (parse '(letrec ([x (lambda (x) (y x))]
                        [y (lambda (x) (x y))])
                   (x y)))