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

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

Browse Source 
so the surrounding code can be reduced, for example

(+ 2 (if t <error> 3)) ==> (begin (if t <error> (void)) 5)

original commit: c1993e7c707b3528c6de5e1d4b36005655d22aff
This commit is contained in:
Gustavo Massaccesi 2019-03-28 22:36:01 -03:00 committed by Matthew Flatt
parent e5cd2ec27a
commit dd67d22b95
3 changed files with 12 additions and 6 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 (if (#2%vector? v) v (#2%error))])
(let ([v2 (begin (if (#2%vector? v) (#2%void) (#2%error)) v)])
(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 (if (#2%vector? v) v (#2%error)))]
(let ([q (#2%vector-sort (begin (if (#2%vector? v) (#2%void) (#2%error)) v))]
[n (if v v 72)])
(#2%display "1")
(#2%list q n))))

5
mats/record.ms
View File

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

9
s/cptypes.ss
View File

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