moved unstable/prop-contract into racket/contract/base

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

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))
 

collects/db/base.rkt

@@ -1,6 +1,5 @@
 #lang racket/base
-(require racket/contract/base
+(require racket/contract/base)
-         unstable/prop-contract)
 
 ;; ============================================================
 

collects/db/scribblings/query.scrbl

@@ -5,8 +5,7 @@
           racket/sandbox
           "config.rkt"
           "tabbing.rkt"
-          (for-label db db/util/geometry db/util/postgresql
+          (for-label db db/util/geometry db/util/postgresql))
-                     unstable/prop-contract))
 
 @title[#:tag "query-api"]{Queries}
 

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")

collects/racket/contract/private/struct-prop.rkt

@@ -1,6 +1,9 @@
 #lang racket/base
-(require racket/contract/base
+(require "guts.rkt"
-         racket/contract/combinator)
+         "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]))

collects/racket/dict.rkt

@@ -1,6 +1,5 @@
 #lang racket/base
 (require racket/contract/base
-         unstable/prop-contract
          "private/dict.rkt")
 
 ;; ----------------------------------------

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]

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]
 

collects/unstable/scribblings/prop-contract.scrbl

@@ -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]

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"]

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))