From 933965b2c22cfb372f45ee88daeef9da9570d08b Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Sun, 18 Dec 2011 01:40:33 -0700 Subject: [PATCH] moved unstable/prop-contract into racket/contract/base --- collects/data/order.rkt | 1 - collects/data/scribblings/order.scrbl | 1 - collects/db/base.rkt | 3 +- collects/db/scribblings/query.scrbl | 3 +- collects/racket/contract/base.rkt | 4 +- .../contract/private/struct-prop.rkt} | 9 +- collects/racket/dict.rkt | 1 - .../reference/contracts-struct-prop.scrbl | 115 ++++++++++++++++++ .../scribblings/reference/contracts.scrbl | 4 + .../unstable/scribblings/prop-contract.scrbl | 72 ----------- collects/unstable/scribblings/unstable.scrbl | 1 - .../unstable/tests/test-docs-complete.rkt | 1 - 12 files changed, 129 insertions(+), 86 deletions(-) rename collects/{unstable/prop-contract.rkt => racket/contract/private/struct-prop.rkt} (94%) create mode 100644 collects/scribblings/reference/contracts-struct-prop.scrbl delete mode 100644 collects/unstable/scribblings/prop-contract.scrbl diff --git a/collects/data/order.rkt b/collects/data/order.rkt index 58115b65e7..de13da99e9 100644 --- a/collects/data/order.rkt +++ b/collects/data/order.rkt @@ -2,7 +2,6 @@ (require racket/dict racket/contract/base racket/string - unstable/prop-contract ffi/unsafe/atomic) (define ordering/c diff --git a/collects/data/scribblings/order.scrbl b/collects/data/scribblings/order.scrbl index f33daf945d..667dea1bb6 100644 --- a/collects/data/scribblings/order.scrbl +++ b/collects/data/scribblings/order.scrbl @@ -2,7 +2,6 @@ @(require scribble/eval (for-label data/order racket/contract - unstable/prop-contract racket/dict racket/base)) diff --git a/collects/db/base.rkt b/collects/db/base.rkt index 710cfd9186..d7c6e7ed37 100644 --- a/collects/db/base.rkt +++ b/collects/db/base.rkt @@ -1,6 +1,5 @@ #lang racket/base -(require racket/contract/base - unstable/prop-contract) +(require racket/contract/base) ;; ============================================================ diff --git a/collects/db/scribblings/query.scrbl b/collects/db/scribblings/query.scrbl index 9975295f47..20970d5b23 100644 --- a/collects/db/scribblings/query.scrbl +++ b/collects/db/scribblings/query.scrbl @@ -5,8 +5,7 @@ racket/sandbox "config.rkt" "tabbing.rkt" - (for-label db db/util/geometry db/util/postgresql - unstable/prop-contract)) + (for-label db db/util/geometry db/util/postgresql)) @title[#:tag "query-api"]{Queries} diff --git a/collects/racket/contract/base.rkt b/collects/racket/contract/base.rkt index 17bdd1e965..42505f8599 100644 --- a/collects/racket/contract/base.rkt +++ b/collects/racket/contract/base.rkt @@ -7,6 +7,7 @@ "private/hash.rkt" "private/vector.rkt" "private/struct.rkt" + "private/struct-prop.rkt" "private/misc.rkt" "private/provide.rkt" "private/guts.rkt" @@ -29,7 +30,8 @@ "private/box.rkt" "private/hash.rkt" "private/vector.rkt" - "private/struct.rkt") + "private/struct.rkt" + "private/struct-prop.rkt") (except-out (all-from-out "private/base.rkt") current-contract-region) (except-out (all-from-out "private/misc.rkt") diff --git a/collects/unstable/prop-contract.rkt b/collects/racket/contract/private/struct-prop.rkt similarity index 94% rename from collects/unstable/prop-contract.rkt rename to collects/racket/contract/private/struct-prop.rkt index 9399d4186e..b99db9d617 100644 --- a/collects/unstable/prop-contract.rkt +++ b/collects/racket/contract/private/struct-prop.rkt @@ -1,6 +1,9 @@ #lang racket/base -(require racket/contract/base - racket/contract/combinator) +(require "guts.rkt" + "blame.rkt" + "prop.rkt" + "misc.rkt") +(provide (rename-out [struct-type-property/c* struct-type-property/c])) (define (get-stpc-proj stpc) (let ([get-val-proj @@ -40,5 +43,3 @@ (struct-type-property/c (coerce-contract 'struct-type-property/c value-contract)))]) struct-type-property/c)) - -(provide (rename-out [struct-type-property/c* struct-type-property/c])) diff --git a/collects/racket/dict.rkt b/collects/racket/dict.rkt index 01a3cbebdf..9147cd7e7d 100644 --- a/collects/racket/dict.rkt +++ b/collects/racket/dict.rkt @@ -1,6 +1,5 @@ #lang racket/base (require racket/contract/base - unstable/prop-contract "private/dict.rkt") ;; ---------------------------------------- diff --git a/collects/scribblings/reference/contracts-struct-prop.scrbl b/collects/scribblings/reference/contracts-struct-prop.scrbl new file mode 100644 index 0000000000..0332a6c927 --- /dev/null +++ b/collects/scribblings/reference/contracts-struct-prop.scrbl @@ -0,0 +1,115 @@ +#lang scribble/manual +@(require scribble/struct scribble/decode scribble/eval + (for-label racket/base racket/contract)) + +@(define the-eval (make-base-eval)) +@(the-eval '(require racket/contract)) + +@title{Structure Type Property Contracts} + +@defproc[(struct-type-property/c [value-contract contract?]) + contract?]{ + +Produces a contract for a @tech{structure type property}. When the +contract is applied to a struct type property, it produces a wrapped +struct type property that applies @racket[value-contract] to the value +associated with the property when it used to create a new struct type +(via @racket[struct], @racket[make-struct-type], etc). + +The struct type property's accessor function is not affected; if it is +exported, it must be protected separately. + +As an example, consider the following module. It creates a structure +type property, @racket[prop], whose value should be a function mapping +a structure instance to a numeric predicate. The module also exports +@racket[app-prop], which extracts the predicate from a structure +instance and applies it to a given value. + +@interaction[#:eval the-eval +(module propmod racket + (require racket/contract) + (define-values (prop prop? prop-ref) + (make-struct-type-property 'prop)) + (define (app-prop x v) + (((prop-ref x) x) v)) + (provide/contract + [prop? (-> any/c boolean?)] + [prop (struct-type-property/c + (-> prop? (-> integer? boolean?)))] + [app-prop (-> prop? integer? boolean?)]) + (provide prop-ref)) +] + +The @racket[structmod] module creates a structure type named +@racket[s] with a single field; the value of @racket[prop] is a +function that extracts the field value from an instance. Thus the +field ought to be an integer predicate, but notice that +@racket[structmod] places no contract on @racket[s] enforcing that +constraint. + +@interaction[#:eval the-eval +(module structmod racket + (require 'propmod) + (struct s (f) #:property prop (lambda (s) (s-f s))) + (provide (struct-out s))) +(require 'propmod 'structmod) +] + +First we create an @racket[s] instance with a integer predicate, so +the constraint on @racket[prop] is in fact satisfied. The first call +to @racket[app-prop] is correct; the second simply violates the +contract of @racket[app-prop]. + +@interaction[#:eval the-eval +(define s1 (s even?)) +(app-prop s1 5) +(app-prop s1 'apple) +] + +We are able to create @racket[s] instances with values other than +integer predicates, but applying @racket[app-prop] on them blames +@racket[structmod], because the function associated with +@racket[prop]---that is, @racket[(lambda (s) (s-f s))]---does not +always produce a value satisfying @racket[(-> integer? boolean?)]. + +@interaction[#:eval the-eval +(define s2 (s "not a fun")) +(app-prop s2 5) + +(define s3 (s list)) +(app-prop s3 5) +] + +The fix would be to propagate the obligation inherited from +@racket[prop] to @racket[s]: + +@racketblock[ +(provide (contract-out + [struct s ([f (-> integer? boolean?)])])) +] + +Finally, if we directly apply the property accessor, +@racket[prop-ref], and then misuse the resulting function, the +@racket[propmod] module is blamed: + +@interaction[#:eval the-eval +((prop-ref s3) 'apple) +] + +The @racket[propmod] module has an obligation to ensure a function +associated with @racket[prop] is applied only to values satisfying +@racket[prop?]. By directly providing @racket[prop-ref], it enables +that constraint to be violated (and thus it is blamed), even though +the bad application actually occurs elsewhere. + +Generally there is no need to provide a structure type property +accessor at all; it is typically only used by other functions within +the module. But if it must be provided, it should be protected thus: + +@racketblock[ +(provide (contract-out + [prop-ref (-> prop? (-> prop? (-> integer? boolean?)))])) +] +} + +@close-eval[the-eval] diff --git a/collects/scribblings/reference/contracts.scrbl b/collects/scribblings/reference/contracts.scrbl index 56b0a80af4..df68d687df 100644 --- a/collects/scribblings/reference/contracts.scrbl +++ b/collects/scribblings/reference/contracts.scrbl @@ -967,6 +967,10 @@ lazy contract. @; ------------------------------------------------------------------------ +@include-section["contracts-struct-prop.scrbl"] + +@; ------------------------------------------------------------------------ + @section[#:tag "attaching-contracts-to-values"]{Attaching Contracts to Values} @declare-exporting-ctc[racket/contract/base] diff --git a/collects/unstable/scribblings/prop-contract.scrbl b/collects/unstable/scribblings/prop-contract.scrbl deleted file mode 100644 index ca74af499f..0000000000 --- a/collects/unstable/scribblings/prop-contract.scrbl +++ /dev/null @@ -1,72 +0,0 @@ -#lang scribble/manual -@(require scribble/struct scribble/decode scribble/eval "utils.rkt" - (for-label racket/base racket/contract unstable/prop-contract)) - -@(define the-eval (make-base-eval)) -@(the-eval '(require racket/contract unstable/prop-contract)) - -@title{Contracts for struct type properties} - -@defmodule[unstable/prop-contract] - -@unstable[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]] - -@defproc[(struct-type-property/c [value-contract contract?]) - contract?]{ - -Produces a contract for struct type properties. When the contract is -applied to a struct type property, it produces a wrapped struct type -property that applies @racket[value-contract] to the value associated -with the property when used to create a new struct type (via -@racket[struct], @racket[make-struct-type], etc). - -The struct type property's accessor function is not affected; it must -be protected separately. - -@examples[#:eval the-eval -(module propmod racket - (require racket/contract - unstable/prop-contract) - (define-values (prop prop? prop-ref) - (make-struct-type-property 'prop)) - (define (prop-app x v) - (((prop-ref x) x) v)) - (provide/contract - [prop? (-> any/c boolean?)] - [prop (struct-type-property/c - (-> prop? (-> number? boolean?)))] - [prop-app (-> prop? number? boolean?)]) - (provide prop-ref)) - -(module structmod racket - (require 'propmod) - (struct s (f) #:property prop (lambda (s) (s-f s))) - (provide (struct-out s))) - -(require 'propmod 'structmod) -(define s1 (s even?)) -(prop-app s1 5) -(prop-app s1 'apple) - -(define s2 (s "not a fun")) -(prop-app s2 5) - -(define s3 (s list)) -(prop-app s3 5) - -((prop-ref s3) 'apple) -] -The first contract error above is a simple function contract violation -on @racket[prop-app]. The second and third contract errors above blame -the @racketidfont{structmod} module, because it accepted the struct type -property contract. To avoid blame, @racketidfont{structmod} -should have placed a contract on @racket[s]. The final contract error, -involving @racket[s3], blames @racketidfont{propmod} because the struct -type property contract obliges @racketidfont{propmod} to make sure the -property's value is not misused, but @racketidfont{propmod} allows -direct access to the property value via @racket[prop-ref]. To -avoid blame, @racketidfont{propmod} should remove the export of -@racket[prop-ref] or protect it with a contract. -} - -@close-eval[the-eval] diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index 91ff636984..915975c39d 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -75,7 +75,6 @@ Keep documentation and tests up to date. @include-section["bytes.scrbl"] @include-section["contract.scrbl"] @include-section["wrapc.scrbl"] -@include-section["prop-contract.scrbl"] @include-section["debug.scrbl"] @include-section["define.scrbl"] @include-section["file.scrbl"] diff --git a/collects/unstable/tests/test-docs-complete.rkt b/collects/unstable/tests/test-docs-complete.rkt index 7a4ce32639..82effc3e83 100644 --- a/collects/unstable/tests/test-docs-complete.rkt +++ b/collects/unstable/tests/test-docs-complete.rkt @@ -5,7 +5,6 @@ (check-docs (quote unstable/struct)) (check-docs (quote unstable/string)) (check-docs (quote unstable/sequence)) -(check-docs (quote unstable/prop-contract)) (check-docs (quote unstable/pretty)) (check-docs (quote unstable/port)) (check-docs (quote unstable/match))