diff --git a/mats/4.ms b/mats/4.ms index 138cb9e419..c302bcb23e 100644 --- a/mats/4.ms +++ b/mats/4.ms @@ -3630,6 +3630,24 @@ (lambda () (k (lambda () #t)))))]) (proc)) + + (equal? + '(2 2) + (let ([f (parameterize ([run-cp0 + ;; Disable cp0 inlining of `for-each`: + (lambda (cp0 e) e)]) + (eval '(lambda (g l) + (let-values ([(x y) + (call-setting-continuation-attachment + 'hi + (lambda () + ;; Could be by `cpnanopoass`, but make + ;; sure it's constrained by the fact that + ;; `for-each` can tail-call `g`: + (#3%for-each g l)))]) + (list x y)))))]) + (f (lambda (x) (values x x)) (list 1 2)))) + ) ;;; section 4-7: diff --git a/s/cpnanopass.ss b/s/cpnanopass.ss index 4eab0c809d..e7fa1b6d66 100644 --- a/s/cpnanopass.ss +++ b/s/cpnanopass.ss @@ -2880,9 +2880,9 @@ (cond [(and (or (not (info-call-shift-attachment? info)) - ;; FIXME: need a less fragile way to avoid multiple results - ;; Exclude inlined primitives that return more than one value: - (not (memq (primref-name pr) '(values call/cc call-with-current-continuation call/1cc)))) + ;; Note: single-valued also implies that the primitive doesn't + ;; tail-call an arbitary function (which might inspect attachments): + (all-set? (prim-mask single-valued) (primref-flags pr))) (handle-prim (info-call-src info) (info-call-sexpr info) (primref-level pr) (primref-name pr) e*)) => (lambda (e) (let ([e (Expr e)])