From d56dfe6f1505b99f90a4978dffd0b592fef72a68 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 15 Oct 2009 02:29:58 +0200
Subject: PLT: autodoc: parsing of definitions with more than one form fixed.
---
scheme/plt/geiser/autodoc.ss | 36 ++++++++++++++++++++++--------------
1 file changed, 22 insertions(+), 14 deletions(-)
(limited to 'scheme')
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))
--
cgit v1.2.3