diff options
Diffstat (limited to 'scheme/guile/geiser/doc.scm')
| -rw-r--r-- | scheme/guile/geiser/doc.scm | 24 |
1 files changed, 11 insertions, 13 deletions
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index 982af95..85bf4d4 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/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)) |