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