summaryrefslogtreecommitdiff
path: root/src/geiser/geiser.ss
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-10-10 02:26:57 +0100
committerjao <jao@gnu.org>2022-10-10 02:26:57 +0100
commit7f12bcfe8b62a06cd9bce15b48d76ec2ebf66de4 (patch)
treeefe2af552844c1d442f6f45b3900af3de5d26562 /src/geiser/geiser.ss
parent00ab1e6c7aafa273494a5fe48d0dae980afc8f30 (diff)
downloadgeiser-chez-7f12bcfe8b62a06cd9bce15b48d76ec2ebf66de4.tar.gz
geiser-chez-7f12bcfe8b62a06cd9bce15b48d76ec2ebf66de4.tar.bz2
initial implementation of symbol-location and module-location
Diffstat (limited to 'src/geiser/geiser.ss')
-rw-r--r--src/geiser/geiser.ss37
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)