diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-10-15 02:29:58 +0200 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-10-15 02:31:01 +0200 |
commit | d56dfe6f1505b99f90a4978dffd0b592fef72a68 (patch) | |
tree | cdc73c8ddf5d83507b253e2a84363844b7498127 /scheme/plt/geiser | |
parent | edbb67e675163d7a3cfbeaf9fcbcef3f44146d36 (diff) | |
download | geiser-chez-d56dfe6f1505b99f90a4978dffd0b592fef72a68.tar.gz geiser-chez-d56dfe6f1505b99f90a4978dffd0b592fef72a68.tar.bz2 |
PLT: autodoc: parsing of definitions with more than one form fixed.
Diffstat (limited to 'scheme/plt/geiser')
-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)) |