From 75f287befd0b08991cbd0db827aa4a8ae44af332 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 23 May 2020 06:30:02 -0600 Subject: [PATCH] cp0: repair move of non-tail into 'effect context Kent noticed the bug, where `make-nontail` used `ignored` where it should have used `effect`. Also, Kent points out that `make-nontail` can skip the `$values` wrapped in `effect` contexts in unsafe mode. original commit: edd9ba3d656f3bd712e5e235b77225f756397077 --- mats/cp0.ms | 7 +++++++ s/cp0.ss | 17 +++++++++++------ 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/mats/cp0.ms b/mats/cp0.ms index 8fcd9d6e01..8baad8c097 100644 --- a/mats/cp0.ms +++ b/mats/cp0.ms @@ -3042,6 +3042,13 @@ (not (equivalent-expansion? (expand/optimize `(lambda (g) ,(mk `(g)))) '(lambda (g) (g)))) + ;; When moving into an ignored position, ensure single valued + ;; in safe mode: + (equivalent-expansion? + (expand/optimize `(lambda (g) ,(mk `(g)) 0)) + (if (= 3 (optimize-level)) + '(lambda (g) (g) 0) + '(lambda (g) (#3%$value (g)) 0))) ;; Ditto, but in a nested procedure: (not (equivalent-expansion? (expand/optimize `(lambda () (lambda (g) ,(mk `(g))))) diff --git a/s/cp0.ss b/s/cp0.ss index c872179ac5..fb607515b9 100644 --- a/s/cp0.ss +++ b/s/cp0.ss @@ -853,12 +853,17 @@ (define make-nontail (lambda (ctxt e) - (if (context-case ctxt - [(tail) (single-valued-without-inspecting-continuation? e)] - [(ignored) (single-valued? e)] - [else #t]) - e - (build-primcall 3 '$value (list e))))) + (context-case ctxt + [(tail) + (if (single-valued-without-inspecting-continuation? e) + e + (build-primcall 3 '$value (list e)))] + ;; An 'effect, 'ignored, 'value, or 'test position will not + ;; have any attachment on the immediate continuation. + ;; Also, an 'ignored, 'value, or 'test position will already + ;; enforce a single result value + [(effect) (safe-single-value e)] + [else e]))) (define result-exp (lambda (e)