summaryrefslogtreecommitdiff
path: root/scheme/guile
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-21 02:45:30 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-21 02:45:30 +0100
commita585a046ddc523cb69977c856f3386d8bb65c325 (patch)
tree9f95a52558ac94cae0d4fadb0c8dbef75f61a805 /scheme/guile
parentb85a85fb3c6445f7b1d9291b019acd03ad4dabd4 (diff)
downloadgeiser-chez-a585a046ddc523cb69977c856f3386d8bb65c325.tar.gz
geiser-chez-a585a046ddc523cb69977c856f3386d8bb65c325.tar.bz2
Capture backtrace. Fix load/compile from Emacs.
Diffstat (limited to 'scheme/guile')
-rw-r--r--scheme/guile/geiser/emacs.scm21
1 files changed, 16 insertions, 5 deletions
diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm
index 382958d..d5e245b 100644
--- a/scheme/guile/geiser/emacs.scm
+++ b/scheme/guile/geiser/emacs.scm
@@ -37,16 +37,25 @@
ge:module-children
ge:module-location)
#:use-module (srfi srfi-1)
+ #:use-module (system base compile)
#:use-module ((geiser introspection) :renamer (symbol-prefix-proc 'ge:)))
(define (write-result result output)
(write (list (cons 'result result) (cons 'output output)))
(newline))
-(define (write-error key . args)
- (write (list (cons 'error (apply parse-error (cons key args)))))
+(define (write-error key args stack)
+ (write (list (cons 'error (apply parse-error (cons key args)))
+ (cons 'stack (parse-stack stack))))
(newline))
+(define (parse-stack stack)
+ (if stack
+ (list
+ (with-output-to-string
+ (lambda () (display-backtrace stack (current-output-port)))))
+ '()))
+
(define (parse-error key . args)
(let* ((len (length args))
(subr (and (> len 0) (first args)))
@@ -58,10 +67,11 @@
(cons 'msg (if msg (apply format (cons #f (cons msg margs))) '()))
(cons 'rest (or rest '())))))
-(define (evaluate form module evaluator)
+(define (evaluate form module-name evaluator)
(let ((module (or (and (list? module-name)
(resolve-module module-name))
- (current-module))))
+ (current-module)))
+ (captured-stack #f))
(catch #t
(lambda ()
(let ((result #f))
@@ -69,7 +79,8 @@
(lambda ()
(set! result (evaluator form module))))))
(write-result result output))))
- write-error)))
+ (lambda (key . args) (write-error key args captured-stack))
+ (lambda (key . args) (set! captured-stack (make-stack #t))))))
(define (eval-compile form module)
(save-module-excursion