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

cs: fix dynamic-wind on chaperoned procedure

Browse Source
This commit is contained in:
Matthew Flatt 2018-11-17 15:58:06 -07:00
parent 64069a5792
commit d47d036239
3 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
racket/src/cs/rumble/control.ss
View File

@ -1613,7 +1613,9 @@
(call-winder-thunk 'dw-pre pre)
(current-winders (cons winder winders))
(end-uninterrupted/call-hook 'dw-body)
(call-with-values thunk
(call-with-values (if (#%procedure? thunk)
thunk
(lambda () (|#%app| thunk)))
(lambda args
(start-uninterrupted 'dw-body)
(current-winders winders)
@ -1626,7 +1628,7 @@
break-enabled-key (make-thread-cell #f #t)
(begin
(end-uninterrupted who)
(thunk)
(|#%app| thunk)
(start-uninterrupted who))))
(define (wind-in winders k)

4
racket/src/cs/rumble/error.ss
View File

@ -480,7 +480,7 @@
(code-info? ci)
(or
;; when per-expression inspector info is available:
(find-rpi (#%$continuation-return-offset k) (code-info-rpis ci))
(find-rpi (#%$continuation-return-offset k) ci)
;; when only per-function source location is available:
(code-info-src ci)))])
(and (or name src)
@ -519,7 +519,7 @@
(code-info? ci)
(or
;; when per-expression inspector info is available:
(find-rpi (#%$continuation-return-offset k) (code-info-rpis ci))
(find-rpi (#%$continuation-return-offset k) ci)
;; when only per-function source location is available:
(code-info-src ci)))])
(and (or name src)

7
racket/src/cs/rumble/source.ss
View File

@ -13,7 +13,8 @@
(nongenerative #{rp-info gr886ae7iuw4wt9ft4vxym-1})
(sealed #t))
(define (find-rpi offset rpis)
(define (find-rpi offset ci)
(let ([rpis (code-info-rpis ci)])
(and
rpis
(let loop ([start 0] [end (fx1- (vector-length rpis))])
@ -25,6 +26,6 @@
[rpi (vector-ref rpis curr)]
[rpi-offset (rp-info-offset rpi)])
(cond
[(fx= offset rpi-offset) rpi]
[(fx= offset rpi-offset) (rp-info-src rpi)]
[(fx< offset rpi-offset) (loop start (fx1- curr))]
[else (loop (fx1+ curr) end)]))]))))
[else (loop (fx1+ curr) end)]))])))))