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

Fix dynamic context of use of match failure continuations.

Browse Source 
svn: r12497
This commit is contained in:
Sam Tobin-Hochstadt 2008-11-18 21:17:36 +00:00
parent dce2d2529e
commit 4c0c3c0ff8
3 changed files with 24 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/scheme/match/compiler.ss
View File

@ -429,10 +429,12 @@
(quote-syntax #,esc))])
#,(Row-rhs (car blocks)))])
(if (Row-unmatch (car blocks))
#`(let/ec k
(let ([#,(Row-unmatch (car blocks))
(lambda () (call-with-values #,esc k))])
#`(call-with-continuation-prompt
(lambda () (let ([#,(Row-unmatch (car blocks))
(lambda () (abort-current-continuation match-prompt-tag))])
rhs))
match-prompt-tag
(lambda () (#,esc)))
#'rhs))])
;; then compile the rest, with our name as the esc
(loop (cdr blocks) #'f (cons #'[f (lambda () c)] acc)))))])

5
collects/scheme/match/runtime.ss
View File

@ -7,7 +7,10 @@
exn:misc:match?
match:error
fail
matchable?)
matchable?
match-prompt-tag)
(define match-prompt-tag (make-continuation-prompt-tag 'match))
(define match-equality-test (make-parameter equal?))

14
collects/tests/match/examples.ss
View File

@ -2,6 +2,7 @@
(require scheme/match
scheme/mpair
scheme/control
(for-syntax scheme/base)
(prefix-in m: mzlib/match)
(only-in srfi/13 string-contains))
@ -582,6 +583,19 @@
(lambda ()
(match 'foo [_ (=> skip) (skip)] [_ (values 1 2)]))
list))
(comp 0
(let ([z (make-parameter 0)])
(match 1
[(? number?) (=> f) (parameterize ([z 1]) (f))]
[(? number?) (z)])))
;; make sure the prompts don't interfere
(comp 12
(%
(let ([z (make-parameter 0)])
(match 1
[(? number?) (=> f) (parameterize ([z 1]) (fcontrol 5))]
[(? number?) (z)]))
(lambda _ 12)))
))