cp0: repair move of non-tail into 'effect context
Kent noticed the bug, where `make-nontail` used `ignored` where it should have used `effect`. Also, Kent points out that `make-nontail` can skip the `$values` wrapped in `effect` contexts in unsafe mode. original commit: edd9ba3d656f3bd712e5e235b77225f756397077
This commit is contained in:
parent
c5ee80bf0d
commit
75f287befd
|
@ -3042,6 +3042,13 @@
|
||||||
(not (equivalent-expansion?
|
(not (equivalent-expansion?
|
||||||
(expand/optimize `(lambda (g) ,(mk `(g))))
|
(expand/optimize `(lambda (g) ,(mk `(g))))
|
||||||
'(lambda (g) (g))))
|
'(lambda (g) (g))))
|
||||||
|
;; When moving into an ignored position, ensure single valued
|
||||||
|
;; in safe mode:
|
||||||
|
(equivalent-expansion?
|
||||||
|
(expand/optimize `(lambda (g) ,(mk `(g)) 0))
|
||||||
|
(if (= 3 (optimize-level))
|
||||||
|
'(lambda (g) (g) 0)
|
||||||
|
'(lambda (g) (#3%$value (g)) 0)))
|
||||||
;; Ditto, but in a nested procedure:
|
;; Ditto, but in a nested procedure:
|
||||||
(not (equivalent-expansion?
|
(not (equivalent-expansion?
|
||||||
(expand/optimize `(lambda () (lambda (g) ,(mk `(g)))))
|
(expand/optimize `(lambda () (lambda (g) ,(mk `(g)))))
|
||||||
|
|
15
s/cp0.ss
15
s/cp0.ss
|
@ -853,12 +853,17 @@
|
||||||
|
|
||||||
(define make-nontail
|
(define make-nontail
|
||||||
(lambda (ctxt e)
|
(lambda (ctxt e)
|
||||||
(if (context-case ctxt
|
(context-case ctxt
|
||||||
[(tail) (single-valued-without-inspecting-continuation? e)]
|
[(tail)
|
||||||
[(ignored) (single-valued? e)]
|
(if (single-valued-without-inspecting-continuation? e)
|
||||||
[else #t])
|
|
||||||
e
|
e
|
||||||
(build-primcall 3 '$value (list e)))))
|
(build-primcall 3 '$value (list e)))]
|
||||||
|
;; An 'effect, 'ignored, 'value, or 'test position will not
|
||||||
|
;; have any attachment on the immediate continuation.
|
||||||
|
;; Also, an 'ignored, 'value, or 'test position will already
|
||||||
|
;; enforce a single result value
|
||||||
|
[(effect) (safe-single-value e)]
|
||||||
|
[else e])))
|
||||||
|
|
||||||
(define result-exp
|
(define result-exp
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user