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

Revert "cptypes: reduce (if t <error> x) ==> (begin (if t <error> (void)) x)"

Browse Source 
This reverts commit 79f23f2ddb858aa6c69bd1e9314e745145ad2b15.

original commit: 83377ac5f916dc4848536f204f49645829007f4a
This commit is contained in:
Matthew Flatt 2019-03-31 11:13:19 -06:00
parent f2c8436347
commit e5cd2ec27a
3 changed files with 6 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
mats/cp0.ms
View File

@ -2873,7 +2873,7 @@
(display "1")
(list q n))))))
'(lambda (v)
(let ([v2 (begin (if (#2%vector? v) (#2%void) (#2%error)) v)])
(let ([v2 (if (#2%vector? v) v (#2%error))])
(let ([q (#2%vector-sort v2)] [n (#3%vector-length v)])
(#2%display "1")
(#2%list q n)))))
@ -2886,7 +2886,7 @@
(display "1")
(list q n))))))
'(lambda (v)
(let ([q (#2%vector-sort (begin (if (#2%vector? v) (#2%void) (#2%error)) v))]
(let ([q (#2%vector-sort (if (#2%vector? v) v (#2%error)))]
[n (if v v 72)])
(#2%display "1")
(#2%list q n))))

5
mats/record.ms
View File

@ -8586,9 +8586,8 @@
(if b (frob-x x) 72)))))
`(lambda (b)
(if b
(#3%$record-oops 'frob-x 'x ',record-type-descriptor?)
(#2%void))
72))
(#3%$record-oops 'frob-x 'x ',record-type-descriptor?)
72)))
(equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize

9
s/cptypes.ss
View File

@ -688,15 +688,10 @@ Notes:
[(f-types3) (or f-types3 types3)])
(let ([ir `(if ,e1 ,e2 ,e3)])
(cond
[(and (predicate-implies? ret2 'bottom) ;check bottom first
(predicate-implies? ret3 'bottom)) ;check bottom first
(values ir ret3 types3 t-types3 f-types3)]
[(predicate-implies? ret2 'bottom) ;check bottom first
(values (make-seq ctxt `(if ,e1 ,e2 ,void-rec) e3)
ret3 types3 t-types3 f-types3)]
(values ir ret3 types3 t-types3 f-types3)]
[(predicate-implies? ret3 'bottom) ;check bottom first
(values (make-seq ctxt `(if ,e1 ,void-rec ,e3) e2)
ret2 types2 t-types2 f-types2)]
(values ir ret2 types2 t-types2 f-types2)]
[else
(let ([new-types (pred-env-union/super-base types2 t-types1
types3 f-types1