suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cp0: don't drop 'ignored if with multiple values

Browse Source 
Closes racket/racket#3092

original commit: 9e928cf79caf536744491e6889e5c71bcd14c264
This commit is contained in:
Matthew Flatt 2020-05-18 13:40:20 -06:00
parent a8b3c8b608
commit a820e425d6
2 changed files with 28 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
mats/cp0.ms
View File

@ -369,6 +369,14 @@
(y)))) (y))))
(error? (apply zero? 0)) (error? (apply zero? 0))
(error? (if (apply eof-object 1 2) 3 4)) (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 (cp0-mat cp0-mrvs

36
s/cp0.ss
View File

@ -662,7 +662,7 @@
(let ((opnd (car unused))) (let ((opnd (car unused)))
(let ((e (operand-value opnd))) (let ((e (operand-value opnd)))
(if e (if e
(if (simple? e) (if (simple1? e)
(if (operand-singly-referenced-score opnd) (if (operand-singly-referenced-score opnd)
; singly-referenced integration attempt in copy2 succeeded ; singly-referenced integration attempt in copy2 succeeded
(f (cdr unused) (fx+ (operand-singly-referenced-score opnd) n) todo) (f (cdr unused) (fx+ (operand-singly-referenced-score opnd) n) todo)
@ -2007,21 +2007,25 @@
(define record-equal? (define record-equal?
; not very ambitious ; not very ambitious
(lambda (e1 e2 ctxt) (lambda (e1 e2 ctxt)
(if (unused-value-context? ctxt) (cond
(and (simple? e1) (simple? e2)) [(eq? ctxt 'effect)
(nanopass-case (Lsrc Expr) e1 (and (simple? e1) (simple? e2))]
[(ref ,maybe-src1 ,x1) [(eq? ctxt 'ignored)
(nanopass-case (Lsrc Expr) e2 (and (simple1? e1) (simple1? e2))]
[(ref ,maybe-src2 ,x2) (eq? x1 x2)] [else
[else #f])] (nanopass-case (Lsrc Expr) e1
[(quote ,d1) [(ref ,maybe-src1 ,x1)
(nanopass-case (Lsrc Expr) e2 (nanopass-case (Lsrc Expr) e2
[(quote ,d2) [(ref ,maybe-src2 ,x2) (eq? x1 x2)]
(if (eq? ctxt 'test) [else #f])]
(if d1 d2 (not d2)) [(quote ,d1)
(eq? d1 d2))] (nanopass-case (Lsrc Expr) e2
[else #f])] [(quote ,d2)
[else #f])))) (if (eq? ctxt 'test)
(if d1 d2 (not d2))
(eq? d1 d2))]
[else #f])]
[else #f])])))
(module () (module ()
(define-syntax define-inline (define-syntax define-inline