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

Chez Scheme: unbreak app rendering for expand/optimize

Browse Source 
Also, fix some cp0 tests for interpret mode.
This commit is contained in:
Matthew Flatt 2020-12-13 10:22:27 -07:00
parent 1e19e660c9
commit b4a3c7d3da
2 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/src/ChezScheme/mats/cp0.ms
View File

@ -3141,10 +3141,12 @@
'(#t #f)))
(or (not (enable-cp0))
(eq? (current-eval) interpret)
(procedure-known-single-valued? (lambda (f) (#3%$app/value f))))
(or (not (enable-cp0))
(not (procedure-known-single-valued? (lambda (f) (#2%$app/value f)))))
(or (not (enable-cp0))
(eq? (current-eval) interpret)
(procedure-known-single-valued? (case-lambda
[(f) (#3%$app/value f)]
[(f g) (if (g)
@ -3152,12 +3154,15 @@
(#3%$app/value f))])))
(or (not (enable-cp0))
(eq? (current-eval) interpret)
(procedure-known-single-valued? (lambda () (abort 'x))))
(or (not (enable-cp0))
(eq? (current-eval) interpret)
(procedure-known-single-valued? (lambda (f) (#3%$app/no-return f))))
(or (not (enable-cp0))
(not (procedure-known-single-valued? (lambda (f) (#2%$app/no-return f)))))
(or (not (enable-cp0))
(eq? (current-eval) interpret)
(procedure-known-single-valued? (case-lambda
[(f) (#3%$app/no-return f)]
[(f g) (if (g)

12
racket/src/ChezScheme/s/cprep.ss
View File

@ -168,17 +168,17 @@
;; Note that we're losing explicit `#2%$app`s.
(>= (optimize-level) 3)
(enable-unsafe-application))
(lambda (s) s)
(lambda (s) `($primitive 3 ,s)))])
(lambda (s a) (if s (cons s a) a))
(lambda (s arg) (cons `($primitive 3 ,(or s '$app)) a)))])
(cond
[(preinfo-call-no-return? preinfo)
(cons (prim '$app/no-return) a)]
(prim '$app/no-return a)]
[(preinfo-call-single-valued? preinfo)
(cons (prim '$app/value) a)]
(prim '$app/value a)]
[(preinfo-call-can-inline? preinfo)
(prim a)]
(prim #f a)]
[else
(cons (prim '$app/no-inline) a)])))])))]
(prim '$app/no-inline)])))])))]
[,pr (let ([sym (primref-name pr)])
(if sexpr?
($sgetprop sym '*unprefixed* sym)