From 73c8e10e31336b2d1232d833a96b45d1e21c2324 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 2 Sep 2010 06:17:08 +0200 Subject: Racket: better stack traces using errortrace --- scheme/racket/geiser.rkt | 2 ++ scheme/racket/geiser/eval.rkt | 26 +++++--------------------- 2 files changed, 7 insertions(+), 21 deletions(-) (limited to 'scheme/racket') diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser.rkt index 45d1289..1ab7983 100644 --- a/scheme/racket/geiser.rkt +++ b/scheme/racket/geiser.rkt @@ -17,6 +17,8 @@ "Racket version 5.0 or better required (found ~a)" (version))) +(require errortrace) + (require geiser/user) ;;; geiser.rkt ends here diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index de53728..f2cf39f 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -19,6 +19,7 @@ make-repl-reader) (require geiser/enter geiser/modules geiser/autodoc) +(require errortrace/errortrace-lib) (define last-result (void)) @@ -30,28 +31,12 @@ (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)) (newline) (newline) - (for-each display-exn-context (get-real-context e))) + (parameterize ([error-context-display-depth 10]) + (print-error-trace (current-output-port) e))) (define (write-value v) (with-output-to-string @@ -65,9 +50,8 @@ (let ([output (with-output-to-string (lambda () - (parameterize ([current-marks (current-continuation-marks)]) - (with-handlers ([exn? set-last-error]) - (call-with-values thunk set-last-result)))))]) + (with-handlers ([exn? set-last-error]) + (call-with-values thunk set-last-result))))]) (append last-result `((output . ,output))))) (define (eval-in form spec lang) -- cgit v1.2.3