From a820e425d60a225c7a79358a4b2303c3bcc1b5f8 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 18 May 2020 13:40:20 -0600
Subject: [PATCH] cp0: don't drop 'ignored `if` with multiple values

Closes racket/racket#3092

original commit: 9e928cf79caf536744491e6889e5c71bcd14c264
---
 mats/cp0.ms |  8 ++++++++
 s/cp0.ss    | 36 ++++++++++++++++++++----------------
 2 files changed, 28 insertions(+), 16 deletions(-)

diff --git a/mats/cp0.ms b/mats/cp0.ms
index bc038e72f2..8fcd9d6e01 100644
--- a/mats/cp0.ms
+++ b/mats/cp0.ms
@@ -369,6 +369,14 @@
             (y))))
   (error? (apply zero? 0))
   (error? (if (apply eof-object 1 2) 3 4))
+
+  (equivalent-expansion?
+   (expand/optimize '(lambda (t) (#3%$value (if t 1 (values 3 3 3))) #t))
+   (if (eqv? (optimize-level) 3)
+       '(lambda (x) #t)
+       '(lambda (x)
+          (#3%$value (if x 1 (#2%values 3 3 3)))
+          #t)))
 )
 
 (cp0-mat cp0-mrvs
diff --git a/s/cp0.ss b/s/cp0.ss
index 977d0cfdb9..c872179ac5 100644
--- a/s/cp0.ss
+++ b/s/cp0.ss
@@ -662,7 +662,7 @@
                     (let ((opnd (car unused)))
                       (let ((e (operand-value opnd)))
                         (if e
-                            (if (simple? e)
+                            (if (simple1? e)
                                 (if (operand-singly-referenced-score opnd)
                                     ; singly-referenced integration attempt in copy2 succeeded
                                     (f (cdr unused) (fx+ (operand-singly-referenced-score opnd) n) todo)
@@ -2007,21 +2007,25 @@
     (define record-equal?
       ; not very ambitious
       (lambda (e1 e2 ctxt)
-        (if (unused-value-context? ctxt)
-            (and (simple? e1) (simple? e2))
-            (nanopass-case (Lsrc Expr) e1
-              [(ref ,maybe-src1 ,x1)
-               (nanopass-case (Lsrc Expr) e2
-                 [(ref ,maybe-src2 ,x2) (eq? x1 x2)]
-                 [else #f])]
-              [(quote ,d1)
-               (nanopass-case (Lsrc Expr) e2
-                 [(quote ,d2)
-                  (if (eq? ctxt 'test)
-                      (if d1 d2 (not d2))
-                      (eq? d1 d2))]
-                 [else #f])]
-              [else #f]))))
+        (cond
+          [(eq? ctxt 'effect)
+           (and (simple? e1) (simple? e2))]
+          [(eq? ctxt 'ignored)
+           (and (simple1? e1) (simple1? e2))]
+          [else
+           (nanopass-case (Lsrc Expr) e1
+             [(ref ,maybe-src1 ,x1)
+              (nanopass-case (Lsrc Expr) e2
+                [(ref ,maybe-src2 ,x2) (eq? x1 x2)]
+                [else #f])]
+             [(quote ,d1)
+              (nanopass-case (Lsrc Expr) e2
+                [(quote ,d2)
+                 (if (eq? ctxt 'test)
+                     (if d1 d2 (not d2))
+                     (eq? d1 d2))]
+                [else #f])]
+             [else #f])])))
 
     (module ()
       (define-syntax define-inline