From d5ff699cf64305c6264941a9e8e6b89e39aac199 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Fri, 6 Mar 2009 02:34:36 +0100
Subject: Refactoring.

---
 geiser/doc.scm | 40 ++++++++++++++++++++--------------------
 1 file changed, 20 insertions(+), 20 deletions(-)

(limited to 'geiser/doc.scm')

diff --git a/geiser/doc.scm b/geiser/doc.scm
index ae24a87..35c5bfb 100644
--- a/geiser/doc.scm
+++ b/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)))
-- 
cgit v1.2.3