From 1bb0a878513ffeac666205b96b92174323322eae Mon Sep 17 00:00:00 2001 From: Chaos Eternal Date: Fri, 18 Aug 2017 16:27:30 +0800 Subject: Handle exceptions of ChezScheme and multi-value as well - Capture exceptions of ChezScheme - handles multi-value return --- scheme/chez/geiser/geiser.ss | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) (limited to 'scheme/chez/geiser') diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss index 2fa648c..6568120 100644 --- a/scheme/chez/geiser/geiser.ss +++ b/scheme/chez/geiser/geiser.ss @@ -30,11 +30,34 @@ (define (geiser:eval module form . rest) rest - (let ((result (if module - (eval form (environment module)) - (eval form)))) + (let* ((try-eval (lambda (x . y) + (call/cc + (lambda (k) + (with-exception-handler + (lambda (e) + (k e)) + (lambda () + (if (null? y) (eval x) + (eval x (car y))) + )))))) + (result-mid (call-with-values + (lambda () (if module + (try-eval form (environment module)) + (try-eval form))) + (lambda (x . y) + (if (null? y) + x + (cons x y))))) + (result result-mid) + (error (if (condition? result-mid) + (cons 'error (list + (cons 'key + (with-output-to-string + (lambda () (display-condition result-mid)))))) + '()))) (write `((result ,(write-to-string result)) - (output . ""))) + (output . "") + ,error)) (newline))) (define (geiser:module-completions prefix . rest) -- cgit v1.2.3