diff options
| author | Lockywolf <lockywolf@gmail.com> | 2019-10-23 12:03:52 +0800 |
|---|---|---|
| committer | Lockywolf <lockywolf@gmail.com> | 2019-10-23 12:03:52 +0800 |
| commit | 7ba2cb0ccb64a6e8cba37eb94e7c61a5f1118ca8 (patch) | |
| tree | a7ac0be9a9cc90a11a1b879e3e34cc455f263c7e /scheme | |
| parent | 3daddfdbd66b86a76e77139c79fa91d9b825990c (diff) | |
| download | geiser-guile-7ba2cb0ccb64a6e8cba37eb94e7c61a5f1118ca8.tar.gz geiser-guile-7ba2cb0ccb64a6e8cba37eb94e7c61a5f1118ca8.tar.bz2 | |
Add printing a stack trace to the user code exceptions.
Diffstat (limited to 'scheme')
| -rw-r--r-- | scheme/chibi/geiser/geiser.scm | 41 |
1 files changed, 30 insertions, 11 deletions
diff --git a/scheme/chibi/geiser/geiser.scm b/scheme/chibi/geiser/geiser.scm index 376e8bf..571f125 100644 --- a/scheme/chibi/geiser/geiser.scm +++ b/scheme/chibi/geiser/geiser.scm @@ -34,26 +34,45 @@ ;;> \scheme{(chibi show)} and written to both variables in addition ;;> to whatever was already there. +(define (get-stack-trace) + (let ((err-output (open-output-string))) + (parameterize ((current-error-port err-output)) + (print-stack-trace) + (get-output-string err-output)))) + (define (geiser:eval module form . rest) rest (guard (err (else - (write ; to standard output (to comint) - "Geiser-chibi falure in scheme code.") - (show #t err))) + (show #t ; to standard output (to comint) + "Geiser-chibi falure in scheme code\n") + (show #t "Error: \n" err "\n") + (print-stack-trace))) (let* ((output (open-output-string)) (form-analyzed (analyze form)) (result (parameterize ((current-output-port output)) - (guard (err - (else (show #t err) - (write-to-string (show #f err)))) - (if module - (let ((mod (module-env (find-module module)))) - (eval form-analyzed mod)) - (eval form-analyzed)))))) + (call/cc (lambda (continuation) + (with-exception-handler + (lambda (err) + (let ((stack-trace (get-stack-trace))) + (show #t + "Output (exception): " + err + " \nStack trace:\n" + stack-trace) + (continuation (write-to-string + (show #f + "Result (exception): " + err + "\nStack trace:\n" + stack-trace))))) + (lambda () (if module + (let ((mod (module-env (find-module module)))) + (eval form-analyzed mod)) + (eval form-analyzed))))))))) (write ; to standard output (to comint) `((result ,(write-to-string result)) - (output . ,(get-output-string output)))))) + (output . ,(get-output-string output)))))) (values)) |