From 506336b9eef139a74c5cbdc88e1f4ef0686512a1 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 2 Jun 2009 14:19:58 +0000 Subject: [PATCH] make call-with-stack-checkpoint grab the context at the right place svn: r15046 --- collects/drscheme/private/rep.ss | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index 1e9fe99f6f..e24b289b19 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -45,13 +45,16 @@ TODO (define stack-checkpoint (make-parameter #f)) (define checkpoints (make-weak-hasheq)) (define (call-with-stack-checkpoint thunk) - (define checkpoint (current-continuation-marks)) + (define checkpoint #f) (call-with-exception-handler (λ (exn) - (unless (hash-has-key? checkpoints exn) + (when (and checkpoint ; just in case there's an exception before it's set + (not (hash-has-key? checkpoints exn))) (hash-set! checkpoints exn checkpoint)) exn) - thunk)) + (lambda () + (set! checkpoint (current-continuation-marks)) + (thunk)))) ;; returns the stack of the input exception, cutting off any tail that was ;; registered as a checkpoint (define (cut-stack-at-checkpoint exn)