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

Chez Scheme: repair cp0 record optimization

Browse Source
This commit is contained in:
Matthew Flatt 2020-12-09 06:31:32 -07:00
parent 535fa16813
commit 0de549800e
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
racket/src/ChezScheme/s/cp0.ss
View File

@ -4107,16 +4107,19 @@
[(record ,rtd1 ,rtd-expr1 ,e* ...) [(record ,rtd1 ,rtd-expr1 ,e* ...)
(guard (< d (length e*)) (guard (< d (length e*))
(rtd-immutable-field? rtd1 d)) (rtd-immutable-field? rtd1 d))
(let ([e (list-ref e* d)]) (let* ([e (list-ref e* d)]
(and [new-e (nanopass-case (Lsrc Expr) e
(nanopass-case (Lsrc Expr) e [(quote ,d) e]
[(quote ,d) #t] [(ref ,maybe-src ,x)
[(ref ,maybe-src ,x) (not (prelex-assigned x))] (and (not (prelex-assigned x))
[,pr (all-set? (prim-mask proc) (primref-flags pr))] (residualize-ref maybe-src x sc))]
[else #f]) [,pr (and (all-set? (prim-mask proc) (primref-flags pr))
e)]
[else #f])])
(and new-e
(begin (begin
(residualize-seq (list ?r ?i) '() ctxt) (residualize-seq (list ?r ?i) '() ctxt)
(non-result-exp i-expr (non-result-exp r-expr e)))))] (non-result-exp i-expr (non-result-exp r-expr new-e)))))]
[else #f])]))] [else #f])]))]
[else #f]))]) [else #f]))])