move predicate/c from unstable/contract to racket/contract. In process,

change the implementation to special case struct procedures and to use
it in provide/contract.

This speeds up the rendering phase of the Guide documentation by more than 2x.
Thanks to Matthew for spotting the opportunity!

collects/racket/contract/private/arrow.rkt

@@ -35,6 +35,7 @@ v4 todo:
          case->
          unconstrained-domain->
          the-unsupplied-arg
+         (rename-out [-predicate/c predicate/c])
          unsupplied-arg?
          making-a-method
          procedure-accepts-and-more?
@@ -1950,3 +1951,25 @@ v4 todo:
                       'pos
                       'neg)])
      (λ (x) (send o m x)))))
+
+
+(define predicate/c-private->ctc 
+  (let ([predicate/c (-> any/c boolean?)])
+    predicate/c))
+
+(struct predicate/c ()
+  #:property prop:chaperone-contract
+  (build-chaperone-contract-property
+   #:projection (let ([pc (contract-struct-projection predicate/c-private->ctc)])
+                  (λ (ctc)
+                    (λ (blame)
+                      (let ([proj (pc blame)])
+                        (λ (val)
+                          (if (struct-predicate-procedure? val)
+                              val
+                              (proj val)))))))
+   #:name (lambda (ctc) 'predicate/c)
+   #:first-order (let ([f (contract-struct-first-order predicate/c-private->ctc)]) (λ (ctc) f))
+   #:stronger (λ (this that) (contract-struct-stronger? predicate/c-private->ctc that))))
+
+(define -predicate/c (predicate/c))

collects/racket/contract/private/provide.rkt

@@ -479,7 +479,7 @@
                                      mutator-ids
                                      field-contract-ids)]
                          [(predicate-code predicate-new-name)
-                          (code-for-one-id/new-name stx predicate-id #f (syntax (-> any/c boolean?)) #f)]
+                          (code-for-one-id/new-name stx predicate-id #f (syntax predicate/c) #f)]
                          [(constructor-code constructor-new-name)
                           (code-for-one-id/new-name
                            stx

collects/scribblings/reference/contracts.scrbl

@@ -761,6 +761,17 @@ be blamed using the above contract:
   (apply g (build-list i add1)))
 ]}
 
+@defthing[predicate/c contract?]{
+  Use this contract to indicate that some function 
+  is a predicate. It is semantically equivalent to
+  @racket[(-> any/c boolean?)].
+                             
+  This contract also includes an optimization so that functions returning
+  @racket[#t] from @racket[struct-predicate-procedure?] are just returned directly, without
+  being wrapped. This contract is used by @racket[provide/contract]'s
+  @racket[struct] subform so that struct predicates end up not being wrapped.
+}
+
 @defthing[the-unsupplied-arg unsupplied-arg?]{
   Used by @racket[->i] (and @racket[->d]) to bind 
   optional arguments that are not supplied by a call site.
@@ -781,7 +792,6 @@ The most convenient way to use parametric contract is to use
 The @racketmodname[racket/contract/parametric] provides a few more, 
 general-purpose parametric contracts.
 
-
 @defform[(parametric->/c (x ...) c)]{
 
 Creates a contract for parametric polymorphic functions.  Each function is

collects/tests/racket/contract-test.rktl

@@ -1157,6 +1157,30 @@
           (regexp-match #rx"expected keyword argument #:the-missing-keyword-arg-b"
                         (exn-message x)))))
   
+  (test/pos-blame
+   'predicate/c1
+   '(contract predicate/c 1 'pos 'neg))
+  (test/pos-blame
+   'predicate/c2
+   '(contract predicate/c (λ (x y) 1) 'pos 'neg))
+  (test/pos-blame
+   'predicate/c3
+   '((contract predicate/c (λ (x) 1) 'pos 'neg) 12))
+  (test/spec-passed
+   'predicate/c4
+   '((contract predicate/c (λ (x) #t) 'pos 'neg) 12))
+  
+  ;; this test ensures that no contract wrappers
+  ;; are created for struct predicates
+  (test/spec-passed/result
+   'predicate/c5
+   '(let ()
+      (struct x (a))
+      (eq? (contract predicate/c x? 'pos 'neg) x?))
+   #t)
+  
+
+
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;
   ;; procedure accepts-and-more
@@ -1176,7 +1200,6 @@
   (ctest #t procedure-accepts-and-more? (case-lambda [(x y . z) 1] [(x) 1]) 1)
   (ctest #f procedure-accepts-and-more? (case-lambda [(x y . z) 1] [(x) 1]) 0)
   
-
 ;                         
 ;                         
 ;                         

collects/unstable/contract.rkt

@@ -180,7 +180,6 @@
 (define thunk/c (-> any/c))
 (define unary/c (-> any/c any/c))
 (define binary/c (-> any/c any/c any/c))
-(define predicate/c (-> any/c boolean?))
 (define comparison/c (-> any/c any/c boolean?))
 (define predicate-like/c (-> any/c truth/c))
 (define comparison-like/c (-> any/c any/c truth/c))
@@ -426,7 +425,6 @@
  [thunk/c contract?]
  [unary/c contract?]
  [binary/c contract?]
- [predicate/c contract?]
  [comparison/c contract?]
  [predicate-like/c contract?]
  [comparison-like/c contract?]

collects/unstable/scribblings/contract.scrbl

@@ -154,18 +154,10 @@ respectively, and produce a single result.
 }
 
 @deftogether[(
-@defthing[predicate/c contract?]
 @defthing[predicate-like/c contract?]
 )]{
 
-These contracts recognize predicates: functions of a single argument that
-produce a boolean result.
-
-The first constrains its output to satisfy @racket[boolean?].  Use
-@racket[predicate/c] in positive position for predicates that guarantee a result
-of @racket[#t] or @racket[#f].
-
-The second constrains its output to satisfy @racket[truth/c].  Use
+This contract recognizes unary functions whose results satisfy @racket[truth/c].  Use
 @racket[predicate-like/c] in negative position for predicates passed as
 arguments that may return arbitrary values as truth values.