diff options
Diffstat (limited to 'geiser')
| -rw-r--r-- | geiser/introspection.scm | 16 | 
1 files changed, 9 insertions, 7 deletions
| diff --git a/geiser/introspection.scm b/geiser/introspection.scm index 0a724f2..cab11fd 100644 --- a/geiser/introspection.scm +++ b/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))) | 
