commit a25a225d895b8f32ac835f276983f20cb8a95166
parent 1e9aa6860ad5014d01fd0005cf230528a77da413
Author: Jay McCarthy <jay@racket-lang.org>
Date: Tue, 11 Aug 2009 21:24:45 +0000
Adding doc based contracts
svn: r15707
original commit: 18093d26e1a6a449e112a53bd9e967da3558ef82
Diffstat:
13 files changed, 104 insertions(+), 51 deletions(-)
diff --git a/collects/scribble/base.ss b/collects/scribble/base.ss
@@ -146,10 +146,12 @@
;; ----------------------------------------
+; XXX unknown contracts
(provide intern-taglet
module-path-index->taglet
- module-path-prefix->string
doc-prefix)
+(provide/contract
+ [module-path-prefix->string (module-path? . -> . string?)])
(require syntax/modcollapse
;; Needed to normalize planet version numbers:
@@ -242,7 +244,8 @@
()
#:rest (listof pre-flow?)
item?)])
-(provide item?)
+(provide/contract
+ [item? (any/c . -> . boolean?)])
(define (itemlist #:style [style plain] . items)
(let ([flows (map an-item-flow items)])
@@ -557,8 +560,15 @@
;; ----------------------------------------
-(provide section-index index index* as-index index-section
- get-index-entries index-block)
+; XXX unknown contract
+(provide get-index-entries)
+(provide/contract
+ [index-block (-> delayed-block?)]
+ [index (((or/c string? (listof string?))) () #:rest (listof any/c) . ->* . index-element?)] ; XXX pre-content docs
+ [index* (((listof string?) (listof any/c)) () #:rest (listof any/c) . ->* . index-element?)] ; XXX pre-content docs and first any/c wrong in docs
+ [as-index (() () #:rest (listof any/c) . ->* . index-element?)] ; XXX pre-content docs
+ [section-index (() () #:rest (listof string?) . ->* . part-index-decl?)]
+ [index-section (() (#:tag (or/c false/c string?)) . ->* . part?)])
(define (section-index . elems)
(make-part-index-decl (map content->string elems) elems))
@@ -730,8 +740,10 @@
;; ----------------------------------------
-(provide table-of-contents
- local-table-of-contents)
+(provide/contract
+ [table-of-contents (-> delayed-block?)]
+ ; XXX Should have a style/c contract
+ [local-table-of-contents (() (#:style any/c) . ->* . delayed-block?)])
(define (table-of-contents)
(make-delayed-block
diff --git a/collects/scribble/private/manual-bib.ss b/collects/scribble/private/manual-bib.ss
@@ -1,14 +1,21 @@
#lang scheme/base
-(require "../decode.ss"
+(require scheme/contract
+ "../decode.ss"
"../struct.ss"
"../basic.ss"
"manual-utils.ss"
"manual-style.ss")
-(provide cite
- bib-entry
- (rename-out [a-bib-entry? bib-entry?])
- bibliography)
+(define-struct a-bib-entry (key val))
+
+(provide/contract
+ [cite ((string?) () #:rest (listof string?) . ->* . element?)] ; XXX docs wrong
+ [bib-entry ((#:key string? #:title any/c) ; XXX bad contracts
+ (#:is-book? any/c #:author any/c #:location any/c #:date any/c #:url any/c)
+ . ->* .
+ a-bib-entry?)]
+ [rename a-bib-entry? bib-entry? (any/c . -> . boolean?)]
+ [bibliography (() (#:tag string?) #:rest (listof a-bib-entry?) . ->* . part?)])
(define (cite key . keys)
(make-element
@@ -27,8 +34,6 @@
(loop (cdr keys))))))
"]")))
-(define-struct a-bib-entry (key val))
-
(define (bib-entry #:key key
#:title title
#:is-book? [is-book? #f]
diff --git a/collects/scribble/private/manual-bind.ss b/collects/scribble/private/manual-bind.ss
@@ -7,6 +7,7 @@
"../manual-struct.ss"
"manual-ex.ss"
scheme/string
+ scheme/contract
scheme/list
scheme/class
scheme/stxparam
@@ -25,12 +26,15 @@
with-exporting-libraries
id-to-target-maker
id-to-form-target-maker
- defidentifier
*sig-elem
(struct-out sig)
;; public:
+ ; XXX unknown contract
make-binding-redirect-elements
sigelem)
+(provide/contract
+ ; XXX any/c should be boolean?
+ [defidentifier ((identifier?) (#:form? any/c #:index? any/c #:show-libs? any/c) . ->* . element?)])
(define (gen-absolute-tag)
`(abs ,(make-generated-tag)))
diff --git a/collects/scribble/private/manual-ex.ss b/collects/scribble/private/manual-ex.ss
@@ -1,6 +1,7 @@
#lang scheme/base
(require "../struct.ss")
+; XXX unknown contracts
(provide (struct-out exporting-libraries)
current-signature)
diff --git a/collects/scribble/private/manual-form.ss b/collects/scribble/private/manual-form.ss
@@ -18,6 +18,7 @@
(for-syntax scheme/base)
(for-label scheme/base))
+
(provide defform defform* defform/subs defform*/subs defform/none
defidform
specform specform/subs
diff --git a/collects/scribble/private/manual-method.ss b/collects/scribble/private/manual-method.ss
@@ -6,11 +6,12 @@
"manual-scheme.ss"
(for-syntax scheme/base))
+(provide ;; public:
+ method xmethod)
+; XXX unknown contracts
(provide *method **method
method-tag
- name-this-object
- ;; public:
- method xmethod)
+ name-this-object)
(define-syntax-rule (method a b)
(*method 'b (quote-syntax a)))
diff --git a/collects/scribble/private/manual-proc.ss b/collects/scribble/private/manual-proc.ss
@@ -21,9 +21,10 @@
(provide defproc defproc* defstruct
defparam defparam* defboolparam
- defthing defthing* defthing/proc
+ defthing defthing*
+ defthing/proc ; XXX unknown contract
;; private:
- *defthing)
+ *defthing) ; XXX unknown contract
(define dots0
(make-element meta-color (list "...")))
diff --git a/collects/scribble/private/manual-scheme.ss b/collects/scribble/private/manual-scheme.ss
@@ -16,8 +16,9 @@
schemeinput
schememod
scheme SCHEME scheme/form schemeresult schemeid
- schememodname schememodlink
- indexed-scheme
+ schememodname
+ schememodlink indexed-scheme
+ ; XXX doc says this is function
schemelink)
(define-code schemeblock0 to-paragraph)
diff --git a/collects/scribble/private/manual-style.ss b/collects/scribble/private/manual-style.ss
@@ -7,35 +7,47 @@
(only-in "../core.ss" make-style plain)
"manual-utils.ss"
scheme/list
+ scheme/contract
scheme/string)
-(provide PLaneT etc
- litchar
- image (rename-out [image image/plain]) onscreen menuitem defterm
- schemefont schemevalfont schemeresultfont schemeidfont schemevarfont
- schemeparenfont schemekeywordfont schememetafont schememodfont
- schemeerror schemeoutput
- filepath exec envvar Flag DFlag PFlag DPFlag
- indexed-file indexed-envvar
- (rename-out [hyperlink link])
+(provide (rename-out [hyperlink link])
(rename-out [other-doc other-manual])
(rename-out [centered centerline])
+ image
+ (rename-out [image image/plain])
itemize
- procedure
- idefterm
- t inset-flow
- pidefterm
- hash-lang
- commandline
- void-const undefined-const
- aux-elem
- math)
+ aux-elem)
+
+; XXX pre-content
+(define styling-f/c
+ (() () #:rest (listof any/c) . ->* . element?))
+(define-syntax-rule (provide-styling id ...)
+ (provide/contract [id styling-f/c] ...))
+(provide-styling onscreen defterm
+ schememodfont schemeoutput ; XXX no docs
+ schemeerror schemefont schemevalfont schemeresultfont schemeidfont schemevarfont
+ schemeparenfont schemekeywordfont schememetafont
+ filepath exec envvar Flag DFlag PFlag DPFlag math
+ procedure
+ indexed-file indexed-envvar idefterm pidefterm)
+(provide/contract
+ [PLaneT element?]
+ [void-const element?]
+ [undefined-const element?]
+ [hash-lang (-> element?)]
+ [etc string?]
+ [inset-flow (() () #:rest (listof any/c) . ->* . any/c)] ; XXX no docs and bad return contract
+ [litchar (() () #:rest (listof string?) . ->* . element?)] ; XXX docs wrong
+ [t (() () #:rest (listof any/c) . ->* . paragraph?)] ; XXX pre-content
+ [commandline (() () #:rest (listof any/c) . ->* . paragraph?)] ; XXX pre-content
+ [menuitem (string? string? . -> . element?)])
(define PLaneT (make-element "planetName" '("PLaneT")))
(define etc "etc.") ; so we can fix the latex space, one day
(define (litchar . strs)
+ ; XXX Remove not-contract
(unless (andmap string? strs)
(raise-type-error 'litchar "strings" strs))
(let ([s (string-append* (map (lambda (s) (regexp-replace* "\n" s " "))
diff --git a/collects/scribble/private/manual-tech.ss b/collects/scribble/private/manual-tech.ss
@@ -1,11 +1,16 @@
#lang scheme/base
-(require "../decode.ss"
+(require scheme/contract
+ "../decode.ss"
"../struct.ss"
"../basic.ss"
"manual-utils.ss"
"manual-style.ss")
-(provide deftech tech techlink)
+(provide/contract
+ ; XXX boolean? and precontent?
+ [deftech (() (#:style? any/c) #:rest (listof any/c) . ->* . element?)]
+ [tech (() (#:doc (or/c module-path? false/c) #:tag-prefixes (or/c (listof string?) false/c)) #:rest (listof any/c) . ->* . element?)]
+ [techlink (() (#:doc (or/c module-path? false/c) #:tag-prefixes (or/c (listof string?) false/c)) #:rest (listof any/c) . ->* . element?)])
(define (*tech make-elem style doc prefix s)
(let* ([c (decode-content s)]
diff --git a/collects/scribble/private/manual-unit.ss b/collects/scribble/private/manual-unit.ss
@@ -11,12 +11,12 @@
"manual-bind.ss"
"manual-ex.ss"
"manual-proc.ss"
+ scheme/contract
(for-syntax scheme/base)
(for-label scheme/base))
(provide defsignature
defsignature/splice
- signature-desc
sigelem)
(define-syntax-rule (defsignature name (super ...) body ...)
@@ -41,6 +41,10 @@
(define (signature-desc . l)
(make-sig-desc l))
+(provide/contract
+ ; XXX preflow & docs
+ [signature-desc (() () #:rest (listof any/c) . ->* . sig-desc?)])
+
(define (*defsignature stx-id supers body-thunk indent?)
(*defthing
(list stx-id)
diff --git a/collects/scribble/private/manual-utils.ss b/collects/scribble/private/manual-utils.ss
@@ -2,13 +2,17 @@
(require "../struct.ss"
"../decode.ss"
"../base.ss"
+ scheme/contract
scheme/list)
-(provide spacer doc-prefix
- to-flow
- flow-spacer flow-empty-line
- make-table-if-necessary
- max-proto-width)
+(provide doc-prefix)
+(provide/contract
+ [spacer element?]
+ [to-flow (any/c . -> . flow?)] ; XXX element?
+ [flow-spacer flow?]
+ [flow-empty-line flow?]
+ [make-table-if-necessary (any/c list? . -> . (list/c (or/c omitable-paragraph? table?)))] ; XXX element?
+ [max-proto-width exact-nonnegative-integer?])
(define spacer (hspace 1))
diff --git a/collects/scribble/private/manual-vars.ss b/collects/scribble/private/manual-vars.ss
@@ -3,18 +3,20 @@
"../scheme.ss"
"../struct.ss"
(only-in "../core.ss" style-name)
+ scheme/contract
(for-syntax scheme/base
syntax/kerncase
syntax/boundmap)
(for-label scheme/base
scheme/class))
+(define-struct (box-splice splice) ())
+
+(provide/contract
+ [struct (box-splice splice) ([run list?])]) ; XXX ugly copying
(provide deftogether
with-scheme-variables
- with-togetherable-scheme-variables
- (struct-out box-splice))
-
-(define-struct (box-splice splice) ())
+ with-togetherable-scheme-variables)
(begin-for-syntax (define-struct deftogether-tag () #:omit-define-syntaxes))
