diff options
| author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2010-06-05 23:55:14 +0200 |
|---|---|---|
| committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2010-06-05 23:55:14 +0200 |
| commit | 098070ce89f21d692261fe49d07319ee1d7fdd66 (patch) | |
| tree | 235387f6403c0374577723d8b7d20fc5bd7d2f50 | |
| parent | fe69f305ea550c9822f280e574ba3d80dd3e3d0a (diff) | |
| download | geiser-chez-098070ce89f21d692261fe49d07319ee1d7fdd66.tar.gz geiser-chez-098070ce89f21d692261fe49d07319ee1d7fdd66.tar.bz2 | |
Racket: providing error contexts
| -rw-r--r-- | elisp/geiser-debug.el | 2 | ||||
| -rw-r--r-- | scheme/racket/geiser/eval.rkt | 26 |
2 files changed, 24 insertions, 4 deletions
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index fa30506..ad55d0b 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -67,7 +67,7 @@ non-null value.") (erase-buffer) (insert what) (newline 2) - (when res + (when (and res (not err)) (insert res) (newline 2)) (unless (geiser-debug--display-error impl module key output) diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index e0bcffa..db50ded 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -30,9 +30,28 @@ (define (exn-key e) (vector-ref (struct->vector e) 0)) +(define current-marks (make-parameter (current-continuation-marks))) + +(define (get-real-context e) + (let ((ec (continuation-mark-set->context (exn-continuation-marks e))) + (cc (continuation-mark-set->context (current-marks)))) + (filter-not (lambda (c) (member c cc)) ec))) + +(define (display-exn-context c) + (define (maybe-display p x) (when x (display p) (display x)) x) + (when (and (pair? c) (cdr c)) + (let ((sloc (cdr c))) + (and (maybe-display "" (srcloc-source sloc)) + (maybe-display ":" (srcloc-line sloc)) + (maybe-display ":" (srcloc-column sloc))) + (maybe-display ": " (car c)) + (newline)))) + (define (set-last-error e) (set! last-result `((error (key . ,(exn-key e))))) - (display (exn-message e))) + (display (exn-message e)) + (newline) (newline) + (for-each display-exn-context (get-real-context e))) (define (write-value v) (with-output-to-string @@ -46,8 +65,9 @@ (let ((output (with-output-to-string (lambda () - (with-handlers ((exn? set-last-error)) - (call-with-values thunk set-last-result)))))) + (parameterize ((current-marks (current-continuation-marks))) + (with-handlers ((exn? set-last-error)) + (call-with-values thunk set-last-result))))))) (append last-result `((output . ,output))))) (define (eval-in form spec lang) |