Racket: better stack traces using errortrace

2 files changed, 7 insertions, 21 deletions

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)