summaryrefslogtreecommitdiff
path: root/scheme/guile
diff options
context:
space:
mode:
Diffstat (limited to 'scheme/guile')
-rw-r--r--scheme/guile/geiser/doc.scm40
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)))