diff options
| author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-21 02:45:30 +0100 |
|---|---|---|
| committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-21 02:45:30 +0100 |
| commit | a585a046ddc523cb69977c856f3386d8bb65c325 (patch) | |
| tree | 9f95a52558ac94cae0d4fadb0c8dbef75f61a805 /scheme | |
| parent | b85a85fb3c6445f7b1d9291b019acd03ad4dabd4 (diff) | |
| download | geiser-chez-a585a046ddc523cb69977c856f3386d8bb65c325.tar.gz geiser-chez-a585a046ddc523cb69977c856f3386d8bb65c325.tar.bz2 | |
Capture backtrace. Fix load/compile from Emacs.
Diffstat (limited to 'scheme')
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 21 |
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 |