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

cptypes: fix reduction of record?

Browse Source 
Check that the rtd argument is single valued. For example
(record? 5 (values 1 2))
was incorrectly reduced to
(begin 5 (values 1 2) #f)

original commit: 543ba171cee6c03b4207de5ea970573dd85dd3a0
This commit is contained in:
Gustavo Massaccesi 2020-03-10 10:14:34 -03:00
parent 840e5143e2
commit 16b9ffb57c
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
s/cptypes.ss
View File

@ -863,8 +863,11 @@ Notes:
[(predicate-implies-not? val-type (rtd->record-predicate rtd #t)) [(predicate-implies-not? val-type (rtd->record-predicate rtd #t))
(cond (cond
[(fx= level 3) [(fx= level 3)
(let ([rtd (if (get-type rtd) ; ensure that rtd is a single valued expression
rtd
`(call ,(make-preinfo-call) ,(lookup-primref 3 '$value) ,rtd))])
(values (make-seq ctxt (make-seq 'effect val rtd) false-rec) (values (make-seq ctxt (make-seq 'effect val rtd) false-rec)
false-rec ntypes #f #f)] false-rec ntypes #f #f))]
[else [else
(values (make-seq ctxt `(call ,preinfo ,pr ,val ,rtd) false-rec) (values (make-seq ctxt `(call ,preinfo ,pr ,val ,rtd) false-rec)
false-rec ntypes #f #f)])] false-rec ntypes #f #f)])]
@ -1301,7 +1304,7 @@ Notes:
[else [else
(values ir t types #f #f)])] (values ir t types #f #f)])]
[else [else
(values ir t types #f #f)]))])] (values ir (or t 'ptr) types #f #f)]))])] ; In case there is no saved type, use 'ptr to mark it as single valued
[(seq ,[e1 'effect types plxc -> e1 ret1 types t-types f-types] ,e2) [(seq ,[e1 'effect types plxc -> e1 ret1 types t-types f-types] ,e2)
(cond (cond
[(predicate-implies? ret1 'bottom) [(predicate-implies? ret1 'bottom)