summaryrefslogtreecommitdiff
path: root/scheme/guile/geiser
diff options
context:
space:
mode:
Diffstat (limited to 'scheme/guile/geiser')
-rw-r--r--scheme/guile/geiser/introspection.scm16
1 files changed, 9 insertions, 7 deletions
diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm
index 0a724f2..cab11fd 100644
--- a/scheme/guile/geiser/introspection.scm
+++ b/scheme/guile/geiser/introspection.scm
@@ -41,11 +41,12 @@
(define (autodoc form)
(cond ((null? form) #f)
((symbol? form) (describe-application (list form)))
+ ((and (pair? form) (not (list? form))) (autodoc (pair->list form)))
((list? form)
(let ((lst (last form)))
(cond ((symbol? lst) (or (describe-application (list lst))
(describe-application form)))
- ((list? lst)
+ ((pair? lst)
(or (autodoc lst)
(autodoc (map (lambda (s) (if (list? s) (gensym) s)) form))))
(else (describe-application form)))))
@@ -59,6 +60,12 @@
(cons 'position (find-position args form))
(cons 'module (symbol-module fun))))))
+(define (pair->list pair)
+ (let loop ((d pair) (s '()))
+ (cond ((null? d) (reverse! s))
+ ((symbol? d) (reverse! (cons d s)))
+ (else (loop (cdr d) (cons (car d) s))))))
+
(define (arglst args kind)
(let ((args (assq-ref args kind)))
(cond ((or (not args) (null? args)) '())
@@ -159,18 +166,13 @@
(define (local-bindings form)
(define (body f) (if (> (length f) 2) (cddr f) '()))
- (define (decl-list d)
- (let loop ((d d) (s '()))
- (cond ((null? d) s)
- ((symbol? d) (cons d s))
- (else (loop (cdr d) (cons (car d) s))))))
(let loop ((form form) (bindings '()))
(cond ((not (pair? form)) bindings)
((list? (car form))
(loop (cdr form) (append (local-bindings (car form)) bindings)))
((and (list? form) (< (length form) 2)) bindings)
((memq (car form) '(define define* lambda))
- (loop (body form) (append (decl-list (cadr form)) bindings)))
+ (loop (body form) (append (pair->list (cadr form)) bindings)))
((and (memq (car form) '(let let* letrec letrec*))
(list? (cadr form)))
(loop (body form) (append (map car (cadr form)) bindings)))