diff options
Diffstat (limited to 'scheme')
| -rw-r--r-- | scheme/racket/geiser/eval.rkt | 26 |
1 files changed, 23 insertions, 3 deletions
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) |