From 1fdfd8406df526cacf803e037c1f69b29d916828 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 25 Apr 2011 11:33:38 -0500 Subject: [PATCH] made sure that all of the mzlib/contract exports are documented (some by using racket/contract exports and some by adding more docs) --- collects/mzlib/contract.rkt | 42 +++++++++++++--- collects/mzlib/private/contract-arrow.rkt | 41 +--------------- collects/mzlib/private/contract-object.rkt | 49 +------------------ collects/mzlib/scribblings/contract.scrbl | 35 ++++++++++++- .../scribblings/reference/contracts.scrbl | 4 ++ doc/release-notes/racket/HISTORY.txt | 16 +++++- 6 files changed, 88 insertions(+), 99 deletions(-) diff --git a/collects/mzlib/contract.rkt b/collects/mzlib/contract.rkt index b5152e0f1f..c8f9724d14 100644 --- a/collects/mzlib/contract.rkt +++ b/collects/mzlib/contract.rkt @@ -2,11 +2,13 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;; provide arrow contracts from our local copy +;; provide arrow contracts from our local copy (mostly) ;; (require "private/contract-arrow.rkt") (provide (all-from-out "private/contract-arrow.rkt")) +(require (only-in racket/contract unconstrained-domain->)) +(provide unconstrained-domain->) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -15,6 +17,18 @@ (require "private/contract-object.rkt") (provide (all-from-out "private/contract-object.rkt")) +(require (only-in racket/class + is-a?/c + implementation?/c + subclass?/c + mixin-contract + make-mixin-contract)) +(provide is-a?/c + implementation?/c + subclass?/c + mixin-contract + make-mixin-contract) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; old-style define/contract @@ -54,13 +68,16 @@ racket/contract/private/basic-opters racket/contract/combinator) + +(define (build-flat-contract name pred) (make-predicate-contract name pred)) + (provide opt/c define-opt/c ;(all-from "private/contract-opt.rkt") (except-out (all-from-out racket/contract/private/ds) contract-struct) - (all-from-out racket/contract/private/base) - (all-from-out racket/contract/private/provide) + (all-from-out racket/contract/private/base + racket/contract/private/provide) (except-out (all-from-out racket/contract/private/misc) check-between/c string-len/c @@ -69,8 +86,17 @@ (rename-out [string-len/c string/len]) (except-out (all-from-out racket/contract/private/guts) check-flat-contract - check-flat-named-contract) - (all-from-out racket/contract/private/prop - racket/contract/private/blame - racket/contract/combinator)) - + check-flat-named-contract + make-predicate-contract) + (except-out (all-from-out racket/contract/private/blame) + make-blame) + (except-out (all-from-out racket/contract/private/prop) + chaperone-contract-struct? + contract-struct-first-order + contract-struct-name + contract-struct-projection + contract-struct-stronger? + contract-struct? + flat-contract-struct?) + (all-from-out racket/contract/combinator) + build-flat-contract) diff --git a/collects/mzlib/private/contract-arrow.rkt b/collects/mzlib/private/contract-arrow.rkt index 6471de6009..6c406376d3 100644 --- a/collects/mzlib/private/contract-arrow.rkt +++ b/collects/mzlib/private/contract-arrow.rkt @@ -22,51 +22,12 @@ ->pp-rest case-> opt-> - opt->* - unconstrained-domain->) + opt->*) (define-struct contracted-function (proc ctc) #:property prop:procedure 0 #:property prop:contracted 1) -(define-syntax (unconstrained-domain-> stx) - (syntax-case stx () - [(_ rngs ...) - (with-syntax ([(rngs-x ...) (generate-temporaries #'(rngs ...))] - [(proj-x ...) (generate-temporaries #'(rngs ...))] - [(p-app-x ...) (generate-temporaries #'(rngs ...))] - [(res-x ...) (generate-temporaries #'(rngs ...))]) - #'(let ([rngs-x (coerce-contract 'unconstrained-domain-> rngs)] ...) - (let ([proj-x (contract-projection rngs-x)] ...) - (define name - (build-compound-type-name 'unconstrained-domain-> (contract-name rngs-x) ...)) - (define (proj wrapper) - (λ (blame) - (let* ([p-app-x (proj-x blame)] ... - [res-checker (λ (res-x ...) (values (p-app-x res-x) ...))]) - (λ (val) - (if (procedure? val) - (wrapper - val - (make-keyword-procedure - (λ (kwds kwd-vals . args) - (apply values res-checker kwd-vals args)) - (λ args - (apply values res-checker args))) - impersonator-prop:contracted ctc) - (raise-blame-error blame val "expected a procedure")))))) - (define ctc - (if (and (chaperone-contract? rngs-x) ...) - (make-chaperone-contract - #:name name - #:projection (proj chaperone-procedure) - #:first-order procedure?) - (make-contract - #:name name - #:projection (proj impersonate-procedure) - #:first-order procedure?))) - ctc)))])) - (define (build--> name doms doms-rest rngs kwds quoted-kwds rng-any? func) (let ([doms/c (map (λ (dom) (coerce-contract name dom)) doms)] [rngs/c (map (λ (rng) (coerce-contract name rng)) rngs)] diff --git a/collects/mzlib/private/contract-object.rkt b/collects/mzlib/private/contract-object.rkt index 57b9ee0bc2..1a5840b5a9 100644 --- a/collects/mzlib/private/contract-object.rkt +++ b/collects/mzlib/private/contract-object.rkt @@ -10,12 +10,7 @@ racket/contract/private/helpers "contract-arr-obj-helpers.rkt")) -(provide mixin-contract - make-mixin-contract - is-a?/c - subclass?/c - implementation?/c - object-contract) +(provide object-contract) (define-syntax object-contract (let () @@ -303,46 +298,4 @@ ctc))))])))) -(define (make-mixin-contract . %/<%>s) - ((and/c (flat-contract class?) - (apply and/c (map sub/impl?/c %/<%>s))) - . ->d . - subclass?/c)) -(define (subclass?/c %) - (unless (class? %) - (error 'subclass?/c "expected , given: ~e" %)) - (let ([name (object-name %)]) - (flat-named-contract - `(subclass?/c ,(or name 'unknown%)) - (lambda (x) (subclass? x %))))) - -(define (implementation?/c <%>) - (unless (interface? <%>) - (error 'implementation?/c "expected , given: ~e" <%>)) - (let ([name (object-name <%>)]) - (flat-named-contract - `(implementation?/c ,(or name 'unknown<%>)) - (lambda (x) (implementation? x <%>))))) - -(define (sub/impl?/c %/<%>) - (cond - [(interface? %/<%>) (implementation?/c %/<%>)] - [(class? %/<%>) (subclass?/c %/<%>)] - [else (error 'make-mixin-contract "unknown input ~e" %/<%>)])) - -(define (is-a?/c <%>) - (unless (or (interface? <%>) - (class? <%>)) - (error 'is-a?/c "expected or , given: ~e" <%>)) - (let ([name (object-name <%>)]) - (flat-named-contract - (cond - [name - `(is-a?/c ,name)] - [(class? <%>) - `(is-a?/c unknown%)] - [else `(is-a?/c unknown<%>)]) - (lambda (x) (is-a? x <%>))))) - -(define mixin-contract (class? . ->d . subclass?/c)) diff --git a/collects/mzlib/scribblings/contract.scrbl b/collects/mzlib/scribblings/contract.scrbl index 12e7dc46f1..0d223b7efc 100644 --- a/collects/mzlib/scribblings/contract.scrbl +++ b/collects/mzlib/scribblings/contract.scrbl @@ -88,7 +88,7 @@ from @racketmodname[racket/contract]: vector-immutable/c vector-immutableof] -It also provides the old version of the following forms: +It also provides the old version of the following contracts: @defform[(define/contract id contract-expr init-value-expr)]{ @@ -132,6 +132,11 @@ Produces a flat contract that recognizes instances of the structure type named by @racket[struct-id], and whose field values match the flat contracts produced by the @racket[flat-contract-expr]s.} +@defproc[(build-flat-contract [name symbol?] [predicate (-> any/c any)]) flat-contract?]{ + Builds a flat contract out of @racket[predicate], giving it the name + @racket[name]. Nowadays, just using @racket[predicate] directly is preferred. +} + @defform*[((-> contract-dom-expr ... any) (-> contract-dom-expr ... contract-rng-expr))]{ This is a restricted form of @racketmodname[racket/contract]'s @@ -260,4 +265,30 @@ This is a restricted form of @racketmodname[racket/contract]'s variables and the post-condition is also paramterized over @racket[rng-x], which is bound to the result of the function. -} \ No newline at end of file +} + +@defform*[((->pp-rest ([dom-x contract-dom-expr] ...) rest-x rest-contract-expr pre-cond-expr any) + (->pp-rest ([dom-x contract-dom-expr] ...) + rest-x rest-contract-expr + pre-cond-expr + (values [rng-x contract-rng-expr] ...) + post-cond-expr) + (->pp-rest ([dom-x contract-dom-expr] ...) + rest-x rest-contract-expr + pre-cond-expr + contract-rng-expr + rng-x + post-cond-expr))]{ + Like @racket[->pp], but with an additional contract for the rest arguments of the function. +} + +@defform[(case-> mzlib/contract-arrow-contract-expr ...)]{ + Builds a contract analogous to @racket[case-lambda], + where each case comes from one of the contract expression arguments + (tried in order). +} + +@defform[(object-contract [id mzlib/contract-arrow-contract-expr] ...)]{ + Builds a contract for objects where each @racket[id] is expected to be + a method on the object living up to the corresponding contract +} diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl index 9364928fb2..67ee1f7667 100644 --- a/collects/scribblings/reference/contracts.scrbl +++ b/collects/scribblings/reference/contracts.scrbl @@ -2008,4 +2008,8 @@ makes a binary search tree contract, but one that is struct and returns a projection function that checks the contract. } +<<<<<<< HEAD +======= + +>>>>>>> 0b337dc... rejiggered things to make sure all mzlib/contract exports are documented diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 56144a51c6..a6dbe1daab 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -1,6 +1,20 @@ Version 5.1.1.2 Changed "sequence" to include exact nonnegative integers - +mzlib/contract: removed following (undocumented) exports: + chaperone-contract-struct? + contract-struct-first-order + contract-struct-name + contract-struct-projection + contract-struct-stronger? + contract-struct? + flat-contract-struct? + make-opt-contract/info + opt-contract/info-contract + opt-contract/info-enforcer + opt-contract/info-id + synthesized-value + unknown? + Version 5.1.1, May 2011 Enabled single-precision floats by default Added single-flonum?