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

Updates context matching with missing % contexts

Browse Source
This commit is contained in:
Casey Klein 2010-11-15 14:30:37 -06:00
parent 1147318426
commit d0e03bf53a
2 changed files with 44 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -63,7 +63,9 @@
[(noPrompt v_1 (begin E_1 e_2)) (noPrompt v_1 E_1)]
[(noPrompt v_1 (set! x E_1)) (noPrompt v_1 E_1)]
[(noPrompt v_1 (wcm w E_1)) (noPrompt v_1 E_1)]
[(noPrompt v_1 (dw x e_0 E_1 e_1)) (noPrompt v_1 E_1)])
[(noPrompt v_1 (dw x e_0 E_1 e_1)) (noPrompt v_1 E_1)]
[(noPrompt v_1 (% v_2 e E_1)) (noPrompt v_1 E_1)]
[(noPrompt v_1 (% E_1 e_1 e_2)) (noPrompt v_1 E_1)])
(define-metafunction grammar
[(get-marks-core (in-hole hole hole) v e_2) e_2]
@ -72,6 +74,8 @@
[(get-marks-core (v ... E_1 e ...) v_1 e_2) (get-marks E_1 v_1 e_2)]
[(get-marks-core (begin E_1 e) 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 (% 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)])
(define-metafunction grammar

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

@ -324,7 +324,45 @@
'(<>
()
[1 2 1 2]
(λ (v) 10))))
(λ (v) 10)))
(test "prompt enclosing prompt-tag expression"
'(<> () []
(% 0
(% (abort 0 1) 2 3)
(λ (x) x)))
'(<> () [] 1))
(test "prompt enclosing prompt-handler expression"
'(<> () []
(% 0
(begin
(% 0 1 (abort 0 2))
(print 3))
(λ (x) x)))
'(<> () [] 2))
(test "prompt-tag position in continuation-marks context"
'(<> () []
(% 0
(call/cm
1 2
(λ ()
(% (abort 0 (current-marks 1 0))
3
4)))
(λ (x) x)))
'(<> () [] (list 2)))
(test "prompt-handler position in continuation-marks context"
'(<> () []
(% 0
(call/cm
1 2
(λ ()
(call/cm
1 3
(% 0
4
(abort 0 (current-marks 1 0))))))
(λ (x) x)))
'(<> () [] (list 2))))
;; R6RS dynamic-wind ----------------------------------------