diff options
Diffstat (limited to 'scheme')
| -rw-r--r-- | scheme/plt/geiser/autodoc.ss | 36 |
1 files changed, 22 insertions, 14 deletions
diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss index 34dd997..b0e77c5 100644 --- a/scheme/plt/geiser/autodoc.ss +++ b/scheme/plt/geiser/autodoc.ss @@ -78,24 +78,27 @@ (match datum (`(module ,name ,lang . ,forms) (for-each (lambda (f) (parse-datum! f store)) forms)) - (`(define ((,name . ,formals) ,_) ,_) + (`(define ((,name . ,formals) . ,_) . ,_) (add-signature! name formals store)) - (`(define (,name . ,formals) ,_) + (`(define (,name . ,formals) . ,_) (add-signature! name formals store)) - (`(define ,name (lambda ,formals ,_)) + (`(define ,name (lambda ,formals . ,_)) (add-signature! name formals store)) (`(define ,name (case-lambda ,clauses ...)) - (for-each (lambda (c) (add-signature! name (car c) store)) (reverse clauses))) - (`(define-for-syntax (,name . ,formals) ,_) + (for-each (lambda (c) (add-signature! name (car c) store)) + (reverse clauses))) + (`(define-for-syntax (,name . ,formals) . ,_) (add-signature! name formals store)) - (`(define-for-syntax ,name (lambda ,formals ,_)) + (`(define-for-syntax ,name (lambda ,formals . ,_)) (add-signature! name formals store)) - (`(define-syntax-rule (,name . ,formals) ,_) + (`(define-syntax-rule (,name . ,formals) . ,_) (add-signature! name formals store)) (`(define-syntax ,name (syntax-rules ,specials . ,clauses)) - (for-each (lambda (c) (add-signature! name (cdar c) store)) (reverse clauses))) + (for-each (lambda (c) (add-signature! name (cdar c) store)) + (reverse clauses))) (`(define-syntax ,name (lambda ,_ (syntax-case ,_ . ,clauses))) - (for-each (lambda (c) (add-signature! name (cdar c) store)) (reverse clauses))) + (for-each (lambda (c) (add-signature! name (cdar c) store)) + (reverse clauses))) (_ void)))) (define (add-signature! name formals store) @@ -110,15 +113,18 @@ (cond ((null? formals) (make-signature (reverse req) (reverse opt) (reverse keys) #f)) ((symbol? formals) - (make-signature (reverse req) (reverse opt) (reverse keys) formals)) + (make-signature (reverse req) (reverse opt) + (reverse keys) formals)) ((pair? (car formals)) (loop (cdr formals) req (cons (car formals) opt) keys)) - ((keyword? (car formals)) (let* ((kname (keyword->symbol (car formals))) + ((keyword? (car formals)) (let* ((kname + (keyword->symbol (car formals))) (arg-id (cadr formals)) (name (if (pair? arg-id) - (list kname (cadr arg-id)) + (list kname + (cadr arg-id)) kname))) (loop (cddr formals) req @@ -131,7 +137,8 @@ (define error-tag (cons 1 1)) (define generic-signature (make-signature '(...) '() '() #f)) (let ((value (with-handlers ((exn:fail:syntax? (lambda (_) syntax-tag)) - (exn:fail:contract:variable? (lambda (_) error-tag))) + (exn:fail:contract:variable? (lambda (_) + error-tag))) (namespace-variable-value name)))) (cond ((procedure? value) (arity->signatures (procedure-arity value))) ((eq? value syntax-tag) (list generic-signature)) @@ -149,7 +156,8 @@ (cond ((number? arity) (make-signature (args 0 arity) '() '() #f)) ((arity-at-least? arity) - (make-signature (args 0 (arity-at-least-value arity)) '() '() 'rest)))) + (make-signature (args 0 (arity-at-least-value arity)) + '() '() 'rest)))) (define (conseq? lst) (cond ((< (length lst) 2) (number? (car lst))) ((and (number? (car lst)) |