summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-10-16 04:17:04 +0100
committerjao <jao@gnu.org>2022-10-16 04:17:04 +0100
commite7b2c6635f9511c8294af862daf874bc519f56bf (patch)
tree267df3daf4185e0bfd42c4773c6ba2b61d97ed43
parentf00dcb93477ef97c215debf6267192cd0dd94e22 (diff)
downloadgeiser-chez-e7b2c6635f9511c8294af862daf874bc519f56bf.tar.gz
geiser-chez-e7b2c6635f9511c8294af862daf874bc519f56bf.tar.bz2
wee (and, let's hope, harmless) clean ups
-rw-r--r--src/geiser/geiser.ss54
1 files changed, 27 insertions, 27 deletions
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index 8434d19..ed305f9 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -23,8 +23,8 @@
geiser:module-location
geiser:add-to-load-path)
- (import (chezscheme))
- (import (geiser-data))
+ (import (chezscheme))
+ (import (geiser-data))
(define-syntax as-string
(syntax-rules () ((_ b ...) (with-output-to-string (lambda () b ...)))))
@@ -106,27 +106,23 @@
(let ((lib (if (null? lib) (current-library) (car lib))))
(and lib (apply environment lib (library-requirements lib)))))
+ (define (current-libraries)
+ (and (current-library)
+ (cons (current-library) (library-requirements (current-library)))))
+
(define (known-symbols)
- (let ((lib (current-library)))
- (if lib
- (apply append (map library-exports
- (cons lib (library-requirements lib))))
- (environment-symbols (interaction-environment)))))
+ (if (current-library)
+ (apply append (map library-exports (current-libraries)))
+ (environment-symbols (interaction-environment))))
(define symbol-lib
- (rec symbol-lib
- (case-lambda
- ((s)
- (let ((libs (if (current-library)
- (cons (current-library)
- (library-requirements (current-library)))
- (interaction-environment))))
- (symbol-lib s libs)))
- ((s l)
- (cond ((null? l) #f)
- ((and (environment? l) (memq s (environment-symbols l))) "*top*")
- ((memq s (library-exports (car l))) (car l))
- (else (symbol-lib s (cdr l))))))))
+ (case-lambda
+ ((s) (cond ((current-libraries) => (lambda (ls) (symbol-lib s ls)))
+ ((memq s (known-symbols)) (symbol-lib s (library-list)))
+ (else #f)))
+ ((s l) (cond ((null? l) #f)
+ ((memq s (library-exports (car l))) (car l))
+ (else (symbol-lib s (cdr l)))))))
(define not-found (gensym))
@@ -223,16 +219,20 @@
(else `(("required" . ,(reverse req))
("optional" ,args)))))
(define (autodoc-arglist arglist) (autodoc-arglist* arglist '()))
- (define lib (symbol-lib id))
- (define (signature as)
+ (define (signature as lib)
`(,id ("args" ,@(map autodoc-arglist as))
- ,@(if (list? lib) (list (cons "module" (write-to-string lib))) '())))
- (let ((binding (and lib (try-eval id))))
+ ,@(if (and (not (null? lib)) (not (equal? '(chezscheme) lib)))
+ (list (cons "module" (write-to-string lib)))
+ '())))
+ (let* ((lib (symbol-lib id))
+ (binding (and lib (try-eval id))))
(cond ((and binding (not (eq? binding not-found)))
(let ([as (procedure-parameter-list id binding)])
- (if as (signature as) `(,id ("value" . ,(value->string binding))))))
- ((and lib (symbol-signatures id)) => signature)
- (else '()))))
+ (if as
+ (signature as lib)
+ `(,id ("value" . ,(value->string binding))))))
+ ((and lib (symbol-signatures id)) => (lambda (a) (signature a '())))
+ (else (list id)))))
(define (geiser:autodoc ids)
(cond ((null? ids) '())