diff options
author | jao <jao@gnu.org> | 2022-10-10 02:26:57 +0100 |
---|---|---|
committer | jao <jao@gnu.org> | 2022-10-10 02:26:57 +0100 |
commit | 7f12bcfe8b62a06cd9bce15b48d76ec2ebf66de4 (patch) | |
tree | efe2af552844c1d442f6f45b3900af3de5d26562 | |
parent | 00ab1e6c7aafa273494a5fe48d0dae980afc8f30 (diff) | |
download | geiser-chez-7f12bcfe8b62a06cd9bce15b48d76ec2ebf66de4.tar.gz geiser-chez-7f12bcfe8b62a06cd9bce15b48d76ec2ebf66de4.tar.bz2 |
initial implementation of symbol-location and module-location
-rw-r--r-- | src/geiser/geiser.ss | 37 |
1 files changed, 33 insertions, 4 deletions
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss index 04fbca8..c39926e 100644 --- a/src/geiser/geiser.ss +++ b/src/geiser/geiser.ss @@ -6,7 +6,9 @@ geiser:no-values geiser:load-file geiser:newline - geiser:macroexpand) + geiser:macroexpand + geiser:symbol-location + geiser:module-location) (import (chezscheme)) (define-syntax as-string @@ -44,11 +46,13 @@ (last-index-of (cdr str-list) char (+ 1 idx) (if (char=? char (car str-list)) idx last-idx)))) - (define (obj-file-name name) + (define (with-extension name ext) (let ((idx (last-index-of (string->list name) #\. 0 -1))) (if (= idx -1) - (string-append name ".so") - (string-append (substring name 0 idx) ".so")))) + (string-append name ext) + (string-append (substring name 0 idx) ext)))) + + (define (obj-file-name name) (with-extension name ".so")) (define (geiser:load-file filename) (let ((output-filename (obj-file-name filename))) @@ -171,6 +175,31 @@ ((not (symbol? (car ids))) (geiser:autodoc (cdr ids))) (else (map operator-arglist ids)))) + (define (geiser:symbol-location id) + (let* ([b (try-eval id)] + [c (and (not (eq? not-found b)) + ((inspect/object b) 'code))]) + (if c + (call-with-values (lambda () (c 'source-path)) + (lambda (path line . col) + (let ((line (if (null? col) '() line)) + (char (if (null? col) line '())) + (col (if (null? col) '() (car col)))) + `(("name" . ,(c 'name)) + ("file" . ,path) + ("line" . ,line) + ("column" . ,col) + ("char" . ,char))))) + '()))) + + (define (geiser:module-location id) + (let ((obj (library-object-filename id))) + (let loop ((exts (if obj (map car (library-extensions)) '()))) + (cond ((null? exts) '()) + ((file-exists? (with-extension obj (car exts))) + `(("file" . ,(with-extension obj (car exts))))) + (else (loop (cdr exts))))))) + (define (geiser:no-values) #f) (define (geiser:newline) #f) |