summaryrefslogtreecommitdiff
path: root/scheme/racket
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-09-02 06:17:08 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-09-02 06:17:08 +0200
commit73c8e10e31336b2d1232d833a96b45d1e21c2324 (patch)
tree1ad362f22bbe7018cbdc477915f26b0a902cb31a /scheme/racket
parent4399176fae8187e5b896e0d28e4b888b8c39b5d1 (diff)
downloadgeiser-chez-73c8e10e31336b2d1232d833a96b45d1e21c2324.tar.gz
geiser-chez-73c8e10e31336b2d1232d833a96b45d1e21c2324.tar.bz2
Racket: better stack traces using errortrace
Diffstat (limited to 'scheme/racket')
-rw-r--r--scheme/racket/geiser.rkt2
-rw-r--r--scheme/racket/geiser/eval.rkt26
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)