Fix dynamic context of use of match failure continuations.

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

View File

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

View File

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

View File

@ -2,6 +2,7 @@
(require scheme/match (require scheme/match
scheme/mpair scheme/mpair
scheme/control
(for-syntax scheme/base) (for-syntax scheme/base)
(prefix-in m: mzlib/match) (prefix-in m: mzlib/match)
(only-in srfi/13 string-contains)) (only-in srfi/13 string-contains))
@ -582,6 +583,19 @@
(lambda () (lambda ()
(match 'foo [_ (=> skip) (skip)] [_ (values 1 2)])) (match 'foo [_ (=> skip) (skip)] [_ (values 1 2)]))
list)) 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)))
)) ))