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

cptypes: fix reduction of $value in ignored expressions

Browse Source 
original commit: 858cc5fe0f40e73a3473e3cc3f506c2c232c0a81
This commit is contained in:
Gustavo Massaccesi 2020-04-01 18:59:22 -03:00
parent f828cb1eaa
commit 5c91b7f9ac
2 changed files with 11 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
mats/cptypes.ms
View File

@ -1106,4 +1106,9 @@
(cptypes/once-equivalent-expansion? (cptypes/once-equivalent-expansion?
'(vector? (list 1 (vector 2 (display 3) 4))) '(vector? (list 1 (vector 2 (display 3) 4)))
'(begin (display 3) #f)) '(begin (display 3) #f))
; regression test: check that the compiler doesn't loop forever
; when the return arity is unknown
(cptypes-equivalent-expansion?
'(lambda (f) (box? (box (f))))
'(lambda (f) (#3%$value (f)) #t))
) )

6
s/cptypes.ss
View File

@ -173,6 +173,12 @@ Notes:
`(if ,e1 ,e2 ,e3)])] `(if ,e1 ,e2 ,e3)])]
[(case-lambda ,preinfo ,cl* ...) [(case-lambda ,preinfo ,cl* ...)
void-rec] void-rec]
[(call ,preinfo ,pr ,e)
(guard (eq? (primref-name pr) '$value))
(cond
[(single-valued? e)
(make-seq 'effect e void-rec)]
[else ir])]
[(call ,preinfo ,pr ,e* ...) [(call ,preinfo ,pr ,e* ...)
(let ([flags (primref-flags pr)]) (let ([flags (primref-flags pr)])
(cond (cond