summaryrefslogtreecommitdiff
path: root/geiser/doc.scm
diff options
context:
space:
mode:
Diffstat (limited to 'geiser/doc.scm')
-rw-r--r--geiser/doc.scm24
1 files changed, 11 insertions, 13 deletions
diff --git a/geiser/doc.scm b/geiser/doc.scm
index 982af95..85bf4d4 100644
--- a/geiser/doc.scm
+++ b/geiser/doc.scm
@@ -38,11 +38,14 @@
(and args (signature name args))))
(define (signature id args-list)
+ (define (rem-gensyms args)
+ (map (lambda (s) (if (gensym? s) '_
+ (if (list? s) (rem-gensyms s) s))) args))
(define (arglst args kind)
(let ((args (assq-ref args kind)))
- (cond ((or (not args) (null? args)) '())
- ((list? args) args)
- (else (list args)))))
+ (rem-gensyms (cond ((or (not args) (null? args)) '())
+ ((list? args) args)
+ (else (list args))))))
(define (mkargs as)
`((required ,@(arglst as 'required))
(optional ,@(arglst as 'optional)
@@ -80,24 +83,19 @@
(else #f))))
(define (arity->args art)
+ (define (gen-arg-names count)
+ (map (lambda (x) '_) (iota (max count 0))))
(let ((req (car art))
(opt (cadr art))
(rest (caddr art)))
`(,@(if (> req 0)
- (list (cons 'required (gen-arg-names 1 req)))
+ (list (cons 'required (gen-arg-names req)))
'())
,@(if (> opt 0)
- (list (cons 'optional (gen-arg-names (+ 1 req) opt)))
+ (list (cons 'optional (gen-arg-names opt)))
'())
,@(if rest (list (cons 'rest 'rest)) '()))))
-(define (gen-arg-names fst count)
- (let* ((letts (list->vector '(#\x #\y #\z #\u #\v #\w #\t)))
- (len (vector-length letts))
- (lett (lambda (n) (vector-ref letts (modulo n len)))))
- (map (lambda (n) (string->symbol (format "~A" (lett (- n 1)))))
- (iota (max count 1) fst))))
-
(define (arglist->args arglist)
`((required . ,(car arglist))
(optional . ,(cadr arglist))
@@ -173,7 +171,7 @@
(with-output-to-string
(lambda ()
(let* ((type (cond ((macro? obj) "A macro")
- ((procedure? obj) "A procedure")
+ ((procedure? obj) "A procedure")
((program? obj) "A compiled program")
(else "An object")))
(modname (symbol-module sym))