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

359.2, collects changes

Browse Source 
svn: r5143

original commit: cf0b303497763314db7f530a6e2d2010ffe44eac
This commit is contained in:
Matthew Flatt 2006-12-20 00:57:12 +00:00
parent c2750517a4
commit 9b81acb247
5 changed files with 32 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/framework/test.ss
View File

@ -156,11 +156,11 @@
(install-timer (run-interval) return)
(unless (is-exn?)
(begin-action)
(parameterize ([current-exception-handler
(λ (exn)
(end-action-with-error exn)
((error-escape-handler)))])
(thunk))
(call-with-exception-handler
(λ (exn)
(end-action-with-error exn)
((error-escape-handler)))
thunk)
(end-action)))]
[return (λ () (semaphore-post sem))])

20
collects/mred/private/lock.ss
View File

@ -50,16 +50,16 @@
(lambda ()
(set! old-paramz (current-parameterization))
(set! old-break-paramz (current-break-parameterization))
(parameterize ([error-value->string-handler entered-err-string-handler]
[current-exception-handler
(lambda (exn)
;; Get out of atomic region before letting
;; an exception handler work
(k (lambda () (raise exn))))])
(parameterize-break #f
(call-with-values
f
(lambda args (lambda () (apply values args)))))))
(parameterize ([error-value->string-handler entered-err-string-handler])
(with-handlers ([void (lambda (exn)
;; Get out of atomic region before letting
;; an exception handler work
(k (lambda () (raise exn))))])
(parameterize-break
#f
(call-with-values
f
(lambda args (lambda () (apply values args))))))))
(lambda ()
(set! monitor-owner #f)
(semaphore-post monitor-sema)

5
collects/mred/private/repl.ss
View File

@ -120,7 +120,10 @@
void
(lambda ()
(call-with-values
(lambda () (eval (read (open-input-string expr-str))))
(lambda () (call-with-continuation-prompt
(lambda () (eval (cons
'#%top-interaction
(read (open-input-string expr-str)))))))
(lambda results
(for-each
(lambda (v)

7
collects/mred/private/snipfile.ss
View File

@ -208,7 +208,12 @@
(let ([exp (read-syntax src in-port)])
(if (eof-object? exp)
(apply values last-time-values)
(call-with-values (lambda () (eval exp))
(call-with-values (lambda () (call-with-continuation-prompt
(lambda () (eval
(datum->syntax-object
#f
(cons '#%top-interaction exp)
exp)))))
(lambda x (loop x)))))))))
(lambda ()
(close-input-port in-port)))))

10
collects/tests/framework/framework-test-engine.ss
View File

@ -63,13 +63,17 @@
[port (current-output-port)])
(event-dispatch-handler
(lambda (evt)
(parameterize ([current-exception-handler
(let ([oe (current-exception-handler)])
(parameterize ([uncaught-exception-handler
(let ([oe (uncaught-exception-handler)])
(lambda (exn)
(protect
(lambda ()
(set! errs (cons exn errs))))
(oe exn)))])
(od evt)))))
(call-with-exception-handler
(lambda (exn)
((uncaught-exception-handler) exn))
(lambda ()
(od evt)))))))
(yield (make-semaphore 0)))