From 0543ec96b22001d884fa444f55807825c70fa719 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 13 Mar 2017 22:16:56 +0100 Subject: [PATCH] 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 f1833bbb5..4eff0d261 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 4ca8ed8cd..213917fc1 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"