From 2e880649e4d59346585a5739041822b0c17802d0 Mon Sep 17 00:00:00 2001 From: Chaos Eternal Date: Thu, 24 Aug 2017 01:16:19 +0800 Subject: rewritten geiser:eval to fix the following bug: when eval (make-violation) it shall return: \# but previous impletement will treat it as an ERROR. --- scheme/chez/geiser/geiser.ss | 53 ++++++++++++++++++++++++-------------------- 1 file changed, 29 insertions(+), 24 deletions(-) diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss index e833e47..ca50295 100644 --- a/scheme/chez/geiser/geiser.ss +++ b/scheme/chez/geiser/geiser.ss @@ -30,35 +30,40 @@ (define (geiser:eval module form . rest) rest - (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))) - )))))) + (let* ((body (lambda () + (if module + (eval form (environment module)) + (eval form)))) (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) + (lambda () + (call/cc + (lambda (k) + (with-exception-handler + (lambda (e) + (k 'error e)) + (lambda () + (call-with-values + (lambda () + (body)) + (lambda (x . y) + (if (null? y) + (k 'single x) + (k 'multi (cons x y)))))))))) + (lambda (t v) + (cons t v)))) + (result (if (eq? (car result-mid) 'error) + "" + (with-output-to-string + (lambda () + (pretty-print (cdr result-mid)))))) + (error (if (eq? (car result-mid) 'error) (cons 'error (list (cons 'key (with-output-to-string - (lambda () (display-condition result-mid)))))) + (lambda () (display-condition (cdr result-mid))))))) '()))) - (write `((result ,(with-output-to-string - (lambda () - (pretty-print result)))) - (output . "") + (write `((result ,result) + (output . "") ,error)) (newline))) -- cgit v1.2.3