diff options
Diffstat (limited to 'scheme/guile')
| -rw-r--r-- | scheme/guile/geiser/doc.scm | 40 |
1 files changed, 20 insertions, 20 deletions
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index ae24a87..35c5bfb 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -37,29 +37,29 @@ #:use-module (oop goops) #:use-module (srfi srfi-1)) +(define placeholder (gensym)) + (define (autodoc form) - (cond ((null? form) #f) + (cond ((or (eq? form placeholder) (null? form)) #f) ((symbol? form) (describe-application (list form))) - ((and (pair? form) (not (list? form))) (autodoc (pair->list form))) - ((and (list? form) - (= 2 (length form)) - (memq (car form) - '(define define* define-macro define-macro* define-method))) - (autodoc (cons (car form) - (cond ((or (symbol? (cadr form)) - (null? (cadr form)) - (not (list? (cadr form)))) '()) - (else (cdadr form)))))) - ((list? form) + ((not (pair? form)) #f) + ((not (list? form)) (autodoc (pair->list form))) + ((define-head? form) => autodoc) + (else (let ((lst (last form))) - (cond ((symbol? lst) (or (describe-application (list lst)) - (describe-application form))) - ((pair? lst) - (or (and (not (memq (car lst) '(quote))) - (autodoc (pair->list lst))) - (autodoc (map (lambda (s) (if (pair? s) (gensym) s)) form)))) - (else (describe-application form))))) - (else #f))) + (cond ((and (symbol? lst) (describe-application (list lst)))) + ((and (pair? lst) (not (memq (car lst) '(quote)))) (autodoc lst)) + ((pair? lst) (autodoc (flatten-last form))) + (else (describe-application form))))))) + +(define (flatten-last form) + (reverse! (cons placeholder (cdr (reverse! form))))) + +(define (define-head? form) + (define def-heads '(define define* define-macro define-macro* define-method)) + (and (= 2 (length form)) + (memq (car form) def-heads) + (car form))) (define (object-signature name obj) (let ((args (obj-args obj))) |