guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 01/01: Nonlocal prompt returns cause all effects


From: Andy Wingo
Subject: [Guile-commits] 01/01: Nonlocal prompt returns cause all effects
Date: Mon, 13 Mar 2017 17:20:35 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit 0543ec96b22001d884fa444f55807825c70fa719
Author: Andy Wingo <address@hidden>
Date:   Mon Mar 13 22:16:56 2017 +0100

    Nonlocal prompt returns cause all effects
    
    * module/language/cps/effects-analysis.scm (expression-effects): Prompts
      cause &all-effects.  I tried to limit this change to CSE but it was
      actually LICM that was borked, so better to be conservative
    * test-suite/tests/control.test ("escape-only continuations"): Add
      test.
---
 module/language/cps/effects-analysis.scm |  5 ++++-
 test-suite/tests/control.test            | 12 +++++++++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index f1833bb..4eff0d2 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -517,7 +517,10 @@ is or might be a read or a write to the same location as 
A."
     ((or ($ $fun) ($ $rec) ($ $closure))
      (&allocate &unknown-memory-kinds))
     (($ $prompt)
-     (&write-object &prompt))
+     ;; Although the "main" path just writes &prompt, we don't know what
+     ;; nonlocal predecessors of the handler do, so we conservatively
+     ;; assume &all-effects.
+     &all-effects)
     ((or ($ $call) ($ $callk))
      &all-effects)
     (($ $branch k exp)
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
index 4ca8ed8..213917f 100644
--- a/test-suite/tests/control.test
+++ b/test-suite/tests/control.test
@@ -103,7 +103,17 @@
                            (cons element prefix)))
                      '()
                      lst)))))
-      (prefix 'a '(0 1 2 a 3 4 5)))))
+      (prefix 'a '(0 1 2 a 3 4 5))))
+
+  (pass-if "loop only in handler"
+    (let ((n #f))
+      (let lp ()
+        (or n
+            (call-with-prompt 'foo
+              (lambda ()
+                (set! n #t)
+                (abort-to-prompt 'foo))
+              (lambda (k) (lp))))))))
 
 ;;; And the case in which the compiler has to reify the continuation.
 (with-test-prefix/c&e "reified continuations"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]