summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJay Xu <jay.xu.krfantasy@gmail.com>2020-07-22 22:04:41 +0800
committerJay Xu <jay.xu.krfantasy@gmail.com>2020-07-22 22:04:41 +0800
commita2d5fff7fb7bd6fced44d613be48df6a81570534 (patch)
tree2e876e8ccd37b40ea7572def27c9567c2590714f /src
parent98999d71b156451d16021002a7aa812948a5f16b (diff)
downloadgeiser-chez-a2d5fff7fb7bd6fced44d613be48df6a81570534.tar.gz
geiser-chez-a2d5fff7fb7bd6fced44d613be48df6a81570534.tar.bz2
make autodoc support the procedure defined by case-lambda.
Diffstat (limited to 'src')
-rw-r--r--src/geiser/geiser.ss57
1 files changed, 31 insertions, 26 deletions
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index 33d1b39..478b9af 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -98,39 +98,44 @@
(if s
(let ((form (s 'value)))
(if (and (list? form)
- (> (length form) 2)
- (eq? (car form) 'lambda))
- (cadr form)
+ (> (length form) 2))
+ (case (car form)
+ [(lambda) (list (cadr form))]
+ [(case-lambda) (map car (cdr form))]
+ [else #f])
#f))
#f)))
(define (operator-arglist operator)
- (let ((binding (eval operator)))
+ (define (make-autodoc-arglist arglist)
+ (let loop ([arglist arglist]
+ [optionals? #f]
+ [required '()]
+ [optional '()])
+ (cond ((null? arglist)
+ `(("required" ,@(reverse required))
+ ("optional" ,@(reverse optional))
+ ("key")
+ ;; ("module" ,module)
+ ))
+ ((symbol? arglist)
+ (loop '()
+ #t
+ required
+ (cons "..." (cons arglist optional))))
+ (else
+ (loop
+ (cdr arglist)
+ optionals?
+ (if optionals? required (cons (car arglist) required))
+ (if optionals? (cons (car arglist) optional) optional))))))
+ (let ([binding (eval operator)])
(if binding
- (let ((arglist (procedure-parameter-list binding)))
- (let loop ((arglist arglist)
- (optionals? #f)
- (required '())
- (optional '()))
- (cond ((null? arglist)
- `(,operator ("args" (("required" ,@(reverse required))
- ("optional" ,@(reverse optional))
- ("key")
- ;; ("module" ,module)
- ))))
- ((symbol? arglist)
- (loop '()
- #t
- required
- (cons "..." (cons arglist optional))))
- (else
- (loop
- (cdr arglist)
- optionals?
- (if optionals? required (cons (car arglist) required))
- (if optionals? (cons (car arglist) optional) optional))))))
+ (let ([arglists (procedure-parameter-list binding)])
+ `(,operator ("args" ,@(map make-autodoc-arglist arglists))))
'())))
+
(define (geiser:autodoc ids . rest)
(cond ((null? ids) '())
((not (list? ids))