summaryrefslogtreecommitdiff
path: root/scheme/guile
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-06 23:33:38 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-03-06 23:33:38 +0100
commit30ee9fdb4b15dc6a506b16cbc41ae55c7b9e8362 (patch)
tree359aa6afe0acb1b5e14159ae3ab0eb01f681fddb /scheme/guile
parenteda63df7eadd999a4e9234c4bcfcefe62a2bebe6 (diff)
downloadgeiser-chez-30ee9fdb4b15dc6a506b16cbc41ae55c7b9e8362.tar.gz
geiser-chez-30ee9fdb4b15dc6a506b16cbc41ae55c7b9e8362.tar.bz2
Some tidy up.
Diffstat (limited to 'scheme/guile')
-rw-r--r--scheme/guile/geiser/doc.scm41
1 files changed, 19 insertions, 22 deletions
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm
index a58f1d9..b128434 100644
--- a/scheme/guile/geiser/doc.scm
+++ b/scheme/guile/geiser/doc.scm
@@ -37,34 +37,27 @@
#:use-module (oop goops)
#:use-module (srfi srfi-1))
-(define placeholder (gensym))
-
(define (autodoc form)
- (cond ((or (eq? form placeholder) (null? form)) #f)
+ (cond ((null? form) #f)
((symbol? form) (describe-application (list form)))
((not (pair? form)) #f)
((not (list? form)) (autodoc (pair->list form)))
((define-head? form) => autodoc)
- (else
- (let ((lst (last form)))
- (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)))))))
+ (else (autodoc/list form))))
-(define (flatten-last form)
- (reverse! (cons placeholder (cdr (reverse! form)))))
+(define (autodoc/list form)
+ (let ((lst (last form)))
+ (cond ((and (symbol? lst) (describe-application (list lst))))
+ ((and (pair? lst) (not (memq (car lst) '(quote))) (autodoc lst)))
+ (else (describe-application form)))))
(define (define-head? form)
- (define def-heads '(define define* define-macro define-macro* define-method))
+ (define defforms '(define define* define-macro define-macro*
+ define-method define-class define-generic))
(and (= 2 (length form))
- (memq (car form) def-heads)
+ (memq (car form) defforms)
(car form)))
-(define (object-signature name obj)
- (let ((args (obj-args obj)))
- (and args (signature name args))))
-
(define (describe-application form)
(let* ((fun (car form))
(args (obj-args (symbol->object fun))))
@@ -73,11 +66,9 @@
(cons 'position (find-position args form))
(cons 'module (symbol-module fun))))))
-(define (arglst args kind)
- (let ((args (assq-ref args kind)))
- (cond ((or (not args) (null? args)) '())
- ((list? args) args)
- (else (list args)))))
+(define (object-signature name obj)
+ (let ((args (obj-args obj)))
+ (and args (signature name args))))
(define (signature fun args)
(let ((req (arglst args 'required))
@@ -111,6 +102,12 @@
(if (null? keys) 0 (+ 1 (length keys)))
(if rest 2 0))))))))
+(define (arglst args kind)
+ (let ((args (assq-ref args kind)))
+ (cond ((or (not args) (null? args)) '())
+ ((list? args) args)
+ (else (list args)))))
+
(define (obj-args obj)
(cond ((not obj) #f)
((or (procedure? obj) (program? obj)) (arguments obj))