diff options
Diffstat (limited to 'scheme')
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 40 | ||||
| -rw-r--r-- | scheme/guile/geiser/introspection.scm | 15 |
2 files changed, 44 insertions, 11 deletions
diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index b9e2d67..90e03dd 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -38,6 +38,8 @@ ge:module-location) #:use-module (srfi srfi-1) #:use-module (system base compile) + #:use-module (system vm program) + #:use-module (ice-9 debugger utils) #:use-module ((geiser introspection) :renamer (symbol-prefix-proc 'ge:))) (define (make-result result output) @@ -49,11 +51,41 @@ (define (parse-stack stack) (if stack - (list - (with-output-to-string - (lambda () (display-backtrace stack (current-output-port))))) + (map (lambda (n) (parse-frame (stack-ref stack n))) + (iota (stack-length stack))) '())) +(define (parse-frame frame) + (list (cons 'frame (frame-number frame)) + (cons 'procedure (or (and (frame-procedure? frame) + (procedure-name (frame-procedure frame))) + '())) + (cons 'source (or (frame->source-position frame) '())) + (cons 'description (with-output-to-string + (lambda () + (if (frame-procedure? frame) + (write-frame-short/application frame) + (write-frame-short/expression frame))))))) + +(define (frame->source-position frame) + (let ((source (if (frame-procedure? frame) + (or (frame-source frame) + (let ((proc (frame-procedure frame))) + (and proc + (procedure? proc) + (procedure-source proc)))) + (frame-source frame)))) + (and source + (cond ((string? (source-property source 'filename)) + (list (source-property source 'filename) + (+ 1 (source-property source 'line)) + (source-property source 'column))) + ((and (pair? source) (list? (cadr source))) + (list (caadr source) + (+ 1 (caddr source)) + (cdddr source))) + (else #f))))) + (define (parse-error key . args) (let* ((len (length args)) (subr (and (> len 0) (first args))) @@ -119,6 +151,6 @@ SUBR, MSG and REST." (define (ge:load-file path) "Load file, given its full @var{path}." - (evaluate `(compile-and-load ,path) '(geiser emacs) eval)) + (evaluate `(load ,path) '(geiser emacs) eval)) ;;; emacs.scm ends here diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm index 29d059b..ca6afae 100644 --- a/scheme/guile/geiser/introspection.scm +++ b/scheme/guile/geiser/introspection.scm @@ -64,13 +64,14 @@ (else #f))) (define (symbol-module sym) - (call/cc - (lambda (k) - (apropos-fold (lambda (module name var init) - (if (eq? name sym) (k (module-name module)) init)) - #f - (symbol->string sym) - (apropos-fold-accessible (current-module)))))) + (and sym + (call/cc + (lambda (k) + (apropos-fold (lambda (module name var init) + (if (eq? name sym) (k (module-name module)) init)) + #f + (symbol->string sym) + (apropos-fold-accessible (current-module))))))) (define (program-args program) (let* ((arity (program-arity program)) |