Racket: better stack traces using errortrace

3 files changed, 16 insertions, 21 deletions

diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index dcff4cc..d876714 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -158,6 +158,14 @@ This function uses `geiser-racket-init-file' if it exists."
     "path:\"?\\([^>\"\n]+\\)\"?>"
     "module: \"\\([^>\"\n]+\\)\""))
 
+(defconst geiser-racket--geiser-file-rx
+  "^/[^:\n\"]*/geiser/[^:\n\"]*:")
+
+(defun geiser-racket--purge-trace ()
+  (save-excursion
+    (while (re-search-forward geiser-racket--geiser-file-rx nil t)
+      (kill-whole-line))))
+
 (defun geiser-racket--find-files (rx)
   (save-excursion
     (while (re-search-forward rx nil t)
@@ -179,6 +187,7 @@ This function uses `geiser-racket-init-file' if it exists."
       (when key
         (let ((end (point)))
         (goto-char p)
+        (geiser-racket--purge-trace)
         (mapc 'geiser-racket--find-files geiser-racket--file-rxs)
         (goto-char end)
         (newline)))))
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)