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

Fixes another bug in continuation mark collection

Browse Source
This commit is contained in:
Casey Klein 2010-11-17 21:03:30 -06:00
parent 8e69aa6ac2
commit 6bfbdfd582
2 changed files with 13 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/redex/examples/delim-cont/meta.rkt
View File

@ -77,7 +77,7 @@
[(get-marks-core (% v_2 E_1 v_3) v_1 e_2) (get-marks E_1 v_1 e_2)] [(get-marks-core (% v_2 E_1 v_3) v_1 e_2) (get-marks E_1 v_1 e_2)]
[(get-marks-core (% v_2 e_1 E_1) v_1 e_2) (get-marks E_1 v_1 e_2)] [(get-marks-core (% v_2 e_1 E_1) v_1 e_2) (get-marks E_1 v_1 e_2)]
[(get-marks-core (% E_1 e_1 e_3) v_1 e_2) (get-marks E_1 v_1 e_2)] [(get-marks-core (% E_1 e_1 e_3) v_1 e_2) (get-marks E_1 v_1 e_2)]
[(get-marks-core (dw x e E_1 e) v_1 e_2) (get-marks E_1 v_1 e_2)]) [(get-marks-core (dw x e_1 E_1 e_3) v_1 e_2) (get-marks E_1 v_1 e_2)])
(define-metafunction grammar (define-metafunction grammar
[(get-marks (if E_1 e e) v_1 e_2) (get-marks E_1 v_1 e_2)] [(get-marks (if E_1 e e) v_1 e_2) (get-marks E_1 v_1 e_2)]

12
collects/redex/examples/delim-cont/test.rkt
View File

@ -371,6 +371,18 @@
1 2 1 2
(λ () (if (abort 0 (current-marks 1 0)) 3 4))) (λ () (if (abort 0 (current-marks 1 0)) 3 4)))
(λ (x) x))) (λ (x) x)))
'(<> () [] (list 2)))
(test "dw in continuation-marks context"
'(<> ()
[]
(% 0
(call/cm 1 2
(λ ()
(dynamic-wind
(λ () #f)
(λ () (current-marks 1 0))
(λ () #t))))
(λ (x) x)))
'(<> () [] (list 2)))) '(<> () [] (list 2))))
;; R6RS dynamic-wind ---------------------------------------- ;; R6RS dynamic-wind ----------------------------------------