commit be139203c101b2d6f6a4d97df1aef47835022f97 parent bcf264af6e9789cc23ce31c1f21d42c195ef77d0 Author: Robby Findler <robby@racket-lang.org> Date: Sun, 27 Apr 2008 02:55:21 +0000 ported the documentation for the framework's test library -- also extended srcdoc.ss a little bit svn: r9499 original commit: 6a53f96e06fbf7a23d7eb40c35a711e9de103eaf Diffstat:
| M | collects/scribble/srcdoc.ss | | | 80 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------- |
1 file changed, 64 insertions(+), 16 deletions(-)
diff --git a/collects/scribble/srcdoc.ss b/collects/scribble/srcdoc.ss @@ -6,7 +6,9 @@ (provide require/doc provide/doc - proc-doc) + parameter-doc + proc-doc + proc-doc/names) (define-syntax-rule (require/doc spec ...) (void (quote-syntax (require/doc spec ...)))) @@ -53,31 +55,77 @@ (lambda (stx) (syntax-case stx () [(_ id contract desc) - (with-syntax ([(arg ...) - (syntax-case #'contract (->d) - [(->d (req ...) () result) - #'(req ...)] + (with-syntax ([((arg ...) result) + (syntax-case #'contract (->d -> values) + [(->d (req ...) () (values [name res] ...)) + #'((req ...) (values res ...))] + [(->d (req ...) () [name res]) + #'((req ...) res)] + [(-> result) + #'(() result)] [else (raise-syntax-error #f - "unsupported procedure contract form (arguments)" + "unsupported procedure contract form (no argument names)" stx - #'contract)])] - [result - (syntax-case #'contract (->d) - [(->d reqs opts (values [name res] ...)) - #'(values res ...)] - [(->d reqs opts [name res]) - #'res] + #'contract)])]) + (values + #'[id contract] + #'(defproc (id arg ...) result . desc) + #'(scribble/manual)))]))) + +(define-provide/doc-transformer proc-doc/names + (lambda (stx) + (syntax-case stx () + [(_ id contract names desc) + (with-syntax ([header + (syntax-case #'(contract names) (->d -> values) + [((-> ctcs ... result) (arg-names ...)) + (begin + (unless (= (length (syntax->list #'(ctcs ...))) + (length (syntax->list #'(arg-names ...)))) + (raise-syntax-error #f "mismatched argument list and domain contract count" stx)) + #'([(id (arg-names ctcs) ...) result]))] + + [((->* (mandatory ...) (optional ...) result) + ((mandatory-names ...) + ((optional-names optional-default) ...))) + (begin + (unless (= (length (syntax->list #'(mandatory-names ...))) + (length (syntax->list #'(mandatory ...)))) + (raise-syntax-error #f "mismatched mandatory argument list and domain contract count" stx)) + (unless (= (length (syntax->list #'(optional-names ...))) + (length (syntax->list #'(optional ...)))) + (raise-syntax-error #f "mismatched mandatory argument list and domain contract count" stx)) + #'([(id (mandatory-names mandatory) ... (optional-names optional optional-default) ...) + result]))] + [((case-> (-> doms ... rng) ...) + ((args ...) ...)) + (begin + (for-each + (λ (doms args) + (unless (= (length (syntax->list doms)) + (length (syntax->list args))) + (raise-syntax-error #f "mismatched case argument list and domain contract" stx))) + (syntax->list #'((doms ...) ...)) + (syntax->list #'((args ...) ...))) + #'([(id (args doms) ...) rng] ...))] [else (raise-syntax-error #f - "unsupported procedure contract form (arguments)" + "unsupported procedure contract form (no argument names)" stx #'contract)])]) (values #'[id contract] - #'(defproc (id arg ...) result . desc) + #'(defproc* header . desc) #'(scribble/manual)))]))) - +(define-provide/doc-transformer parameter-doc + (lambda (stx) + (syntax-case stx (parameter/c) + [(_ id (parameter/c contract) arg-id desc) + (values + #'[id (parameter/c contract)] + #'(defparam id arg-id contract . desc) + #'(scribble/manual))])))