additional fixes to the docs and racket/contract's exports to make them match up

collects/racket/contract/base.rkt

@@ -24,6 +24,11 @@
              procedure-accepts-and-more?
              check-procedure
              check-procedure/more
+             make-contracted-function
+             
+             contracted-function?
+             contracted-function-proc
+             contracted-function-ctc
              make-contracted-function)
  (all-from-out "private/arr-i.rkt")
  (all-from-out "private/box.rkt")
@@ -40,7 +45,15 @@
              check-flat-named-contract)
  
  (except-out (all-from-out "private/blame.rkt") make-blame)
- (all-from-out "private/prop.rkt")
  
- opt/c define-opt/c ;(all-from-out "private/opt.rkt")
+ (except-out (all-from-out "private/prop.rkt")
- )
+             contract-struct-name  
+             contract-struct-first-order
+             contract-struct-projection
+             contract-struct-stronger?
+             contract-struct?
+             chaperone-contract-struct?
+             flat-contract-struct?)
+ 
+ ;; from private/opt.rkt:
+ opt/c define-opt/c)

collects/racket/contract/private/arrow.rkt

@@ -39,7 +39,10 @@ v4 todo:
          procedure-accepts-and-more?
          check-procedure
          check-procedure/more
-         (struct-out contracted-function))
+         contracted-function?
+         contracted-function-proc
+         contracted-function-ctc
+         make-contracted-function)
 
 (define-syntax-parameter making-a-method #f)
 (define-for-syntax (make-this-parameters id)

collects/racket/contract/private/guts.rkt

@@ -8,8 +8,7 @@
 (require (for-syntax racket/base
                      "helpers.rkt"))
 
-(provide 
+(provide coerce-contract
-         coerce-contract
          coerce-contracts
          coerce-flat-contract
          coerce-flat-contracts
@@ -23,7 +22,6 @@
          flat-contract
          flat-contract-predicate
          flat-named-contract
-         build-flat-contract
          
          build-compound-type-name
          
@@ -182,9 +180,19 @@
 (define-syntax (define/final-prop stx)
   (syntax-case stx ()
     [(_ header bodies ...)
-     (with-syntax ([ctc (if (identifier? #'header)
+     (with-syntax ([ctc 
-                            #'header
+                    (syntax-case #'header ()
-                            (car (syntax-e #'header)))])
+                      [id
+                       (identifier? #'id)
+                       #'id]
+                      [(id1 . rest)
+                       (identifier? #'id1)
+                       #'id1]
+                      [_ 
+                       (raise-syntax-error #f 
+                                           "malformed header position"
+                                           stx 
+                                           #'header)])])
        (with-syntax ([ctc/proc (string->symbol (format "~a/proc" (syntax-e #'ctc)))])
          #'(begin
              (define ctc/proc
@@ -501,6 +509,3 @@
                                            (predicate-contract-pred that))))
    #:name (λ (ctc) (predicate-contract-name ctc))
    #:first-order (λ (ctc) (predicate-contract-pred ctc))))
-
-(define (build-flat-contract name pred) (make-predicate-contract name pred))
-

collects/racket/contract/private/misc.rkt

@@ -477,7 +477,7 @@
 (define/final-prop (not/c f)
   (let* ([ctc (coerce-flat-contract 'not/c f)]
          [pred (flat-contract-predicate ctc)])
-    (build-flat-contract
+    (flat-named-contract
      (build-compound-type-name 'not/c ctc)
      (λ (x) (not (pred x))))))
 
@@ -636,7 +636,7 @@
 
 (define/subexpression-pos-prop (syntax/c ctc-in)
   (let ([ctc (coerce-contract 'syntax/c ctc-in)])
-    (build-flat-contract
+    (flat-named-contract
      (build-compound-type-name 'syntax/c ctc)
      (let ([pred (flat-contract-predicate ctc)])
        (λ (val)

collects/scheme/exists/lang.rkt

@@ -4,27 +4,29 @@
 
 ;; this code builds the list of predicates (in case it changes, this may need to be re-run)
 #;
-(define predicates
+(define runtime-predicates
   (let ([fn (build-path (collection-path "scheme")
                         "compiled" 
-                        "main_ss.zo")])
+                        "main_rkt.zo")])
     (let-values ([(vars stx)
                   (module-compiled-exports
                    (parameterize ([read-accept-compiled #t])
                      (call-with-input-file fn read)))])
-      
+      (sort
-      (filter (λ (sym) 
+       (filter (λ (sym) 
-                (let ([str (symbol->string sym)])
+                 (let ([str (symbol->string sym)])
-                  (and (not (equal? str ""))
+                   (and (regexp-match #rx"[?]$" str)
-                       (regexp-match #rx"[?]$" str)
+                        (not (regexp-match #rx"[=<>][?]$" str)))))
-                       (not (regexp-match #rx"[=<>][?]$" str)))))
+               (map car (cdr (assoc 0 vars))))
-              (map car (cdr (assoc 0 vars)))))))
+       string<=?
-
+       #:key symbol->string))))
 
 (define-for-syntax predicates
   '(absolute-path?
     arity-at-least?
     bitwise-bit-set?
+    blame-original?
+    blame-swapped?
     blame?
     boolean?
     box?
@@ -35,6 +37,10 @@
     bytes-converter?
     bytes?
     channel?
+    chaperone-contract-property?
+    chaperone-contract?
+    chaperone-of?
+    chaperone?
     char-alphabetic?
     char-blank?
     char-graphic?
@@ -59,21 +65,18 @@
     continuation-prompt-tag?
     continuation?
     contract-first-order-passes?
+    contract-property?
     contract-stronger?
     contract?
-    contract-property?
-    contract-struct?
     custodian-box?
     custodian-memory-accounting-available?
     custodian?
+    custom-print-quotable?
     custom-write?
     date-dst?
     date?
-    dict-can-functional-set?
-    dict-can-remove-keys?
-    dict-mutable?
-    dict?
     directory-exists?
+    double-flonum?
     empty?
     eof-object?
     ephemeron?
@@ -91,6 +94,7 @@
     exn:fail:contract:blame?
     exn:fail:contract:continuation?
     exn:fail:contract:divide-by-zero?
+    exn:fail:contract:non-fixnum-result?
     exn:fail:contract:variable?
     exn:fail:contract?
     exn:fail:filesystem:exists?
@@ -113,12 +117,14 @@
     file-exists?
     file-stream-port?
     fixnum?
-    flat-contract?
     flat-contract-property?
-    flat-contract-struct?
+    flat-contract?
+    flonum?
     generic?
     handle-evt?
+    has-contract?
     hash-eq?
+    hash-equal?
     hash-eqv?
     hash-has-key?
     hash-placeholder?
@@ -126,6 +132,10 @@
     hash?
     identifier?
     immutable?
+    impersonator-of?
+    impersonator-property-accessor-procedure?
+    impersonator-property?
+    impersonator?
     implementation?
     inexact-real?
     inexact?
@@ -166,6 +176,7 @@
     placeholder?
     port-closed?
     port-provides-progress-evts?
+    port-try-file-lock?
     port-writes-atomic?
     port-writes-special?
     port?
@@ -197,6 +208,7 @@
     semaphore?
     sequence?
     set!-transformer?
+    single-flonum?
     special-comment?
     srcloc?
     string?
@@ -204,12 +216,14 @@
     struct-constructor-procedure?
     struct-mutator-procedure?
     struct-predicate-procedure?
+    struct-type-property-accessor-procedure?
     struct-type-property?
     struct-type?
     struct?
     subclass?
     subprocess?
     symbol-interned?
+    symbol-unreadable?
     symbol?
     syntax-local-transforming-module-provides?
     syntax-original?
@@ -229,7 +243,7 @@
     udp-connected?
     udp?
     unit?
-    ; ??? unknown?
+    unsupplied-arg?
     variable-reference?
     vector?
     void?

collects/scribblings/reference/contracts.scrbl

@@ -1436,6 +1436,12 @@ the other; both are provided for convenience and clarity.
 
 }
 
+@defproc[(blame-replace-negative [b blame?] [neg any/c]) blame?]{
+  Produces a @racket[blame?] object just like @racket[b] except
+             that it uses @racket[neg] instead of the negative 
+             position @racket[b] has.
+}
+  
 @defproc[(raise-blame-error [b blame?] [x any/c] [fmt string?] [v any/c] ...)
          none/c]{
 
@@ -1449,19 +1455,13 @@ specific to the precise violation.
 
 }
 
-@defproc[(exn:fail:contract:blame? [x any/c]) boolean?]{
+@defstruct[(exn:fail:contract:blame exn:fail:contract) ([object blame?])]{
-This predicate recognizes exceptions raised by @racket[raise-blame-error].
+  This exception is raised to signal a contract error. The @racket[blame]
-}
+  field extracts the @racket[blame?] object associated with a contract violation.
-
-@defproc[(exn:fail:contract:blame-object [e exn:fail:contract:blame?]) blame?]{
-This accessor extracts the blame object associated with a contract violation.
 }
 
 @subsection{Contracts as structs}
 
-@emph{@bold{Note:}
- The interface in this section is unstable and subject to change.}
-
 @para{
 The property @racket[prop:contract] allows arbitrary structures to act as
 contracts.  The property @racket[prop:chaperone-contract] allows arbitrary
@@ -1630,7 +1630,8 @@ where contracts appear in the source and where the positive and negative
 positions of the contracts appear.
 
 To make Check Syntax show obligation information for your new contract
-combinators, use the following properties:
+combinators, use the following properties (some helper macros and functions
+are below):
 
 @itemize[@item{@racketblock0['racket/contract:contract :
                              (vector/c symbol? (listof syntax?) (listof syntax?))]
@@ -1692,6 +1693,28 @@ combinators, use the following properties:
                  }
          ]
 
+@defform/subs[(define/final-prop header body ...)
+              ([header main-id
+                       (main-id id ...)
+                       (main-id id ... . id)])]{
+  The same as @racket[(define header body ...)], except that uses of
+              @racket[main-id] in the header are annotated 
+              with the @racket['racket/contract:contract] property
+              (as above).
+}
+ 
+@defform/subs[(define/subexpression-pos-prop header body ...)
+              ([header main-id
+                       (main-id id ...)
+                       (main-id id ... . id)])]{
+  The same as @racket[(define header body ...)], except that uses of
+              @racket[main-id] in the header are annotated 
+              with the @racket['racket/contract:contract] property
+              (as above) and arguments are annotated with the
+              @racket['racket/contract:positive-position] property.
+}
+
+
 @; ------------------------------------------------------------------------
 
 @section{Contract Utilities}
@@ -1871,3 +1894,63 @@ defines the @racket[bst/c] contract that checks the binary
 search tree invariant. Removing the @racket[-opt/c] also
 makes a binary search tree contract, but one that is
 (approximately) 20 times slower.}
+
+@section{Legacy Contracts}
+
+@defproc[(make-proj-contract [name any/c] 
+                             [proj
+                              (or/c (-> any/c 
+                                        any/c
+                                        (list/c any/c any/c)
+                                        contact?
+                                        (-> any/c any/c))
+                                    (-> any/c 
+                                        any/c
+                                        (list/c any/c any/c)
+                                        contact?
+                                        boolean?
+                                        (-> any/c any/c)))]
+                             [first-order (-> any/c boolean?)])
+         contract?]{
+  Builds a contract using an old interface. 
+  
+  Modulo errors, it is equivalent to:
+  @racketblock[(make-contract
+                #:name name
+                #:first-order first-order
+                #:projection
+                (cond
+                  [(procedure-arity-includes? proj 5)
+                   (lambda (blame)
+                     (proj (blame-positive blame)
+                           (blame-negative blame)
+                           (list (blame-source blame) (blame-value blame))
+                           (blame-contract blame)
+                           (not (blame-swapped? blame))))]
+                  [(procedure-arity-includes? proj 4)
+                   (lambda (blame)
+                     (proj (blame-positive blame)
+                           (blame-negative blame)
+                           (list (blame-source blame) (blame-value blame))
+                           (blame-contract blame)))]))]
+}
+                   
+@defproc[(raise-contract-error [val any/c] [src any/c] [pos any/c] [name any/c] [fmt string?] [arg any/c] ...)
+         any/c]{
+  Calls @racket[raise-blame-error] after building a @racket[blame] struct from 
+  the @racket[val], @racket[src], @racket[pos], and @racket[name] arguments.
+  The @racket[fmt] string and following arguments are passed to
+  @racket[format] and used as the string in the error message.
+}
+               
+@defproc[(contract-proc [c contract?])
+         (->* (symbol? symbol? (or/c syntax? (list/c any/c any/c)))
+              (boolean?)
+              (-> any/c any))]{
+  Constructs an old-style projection from a contract.
+  
+  The resulting function accepts the information that is in a @racket[blame]
+  struct and returns a projection function that checks the contract.
+  
+}
+                              

collects/unstable/contract.rkt

@@ -1,8 +1,6 @@
 #lang racket/base
 (require racket/contract racket/dict racket/match)
 
-(define (proj-get c) contract-proc)
-
 (define path-element?
   (or/c path-string? (symbols 'up 'same)))
 ;; Eli: We already have a notion of "path element" which is different
@@ -174,7 +172,7 @@
                         values
                         (for/list ([elem (in-list elems)]
                                    [elem/c (in-list elem/cs)])
-                          ((((proj-get elem/c) elem/c) pos neg src name blame) elem))))))
+                          (((contract-proc elem/c) pos neg src name blame) elem))))))
                  (lambda (idx) idx)
                  #f
                  (lambda (idx) (more?))
@@ -301,12 +299,12 @@
 (define (project-in p x)
   (match p
     [(proj c o i s n b)
-     ((((proj-get c) c) i o s n (not b)) x)]))
+     (((contract-proc c) i o s n (not b)) x)]))
 
 (define (project-out p x)
   (match p
     [(proj c o i s n b)
-     ((((proj-get c) c) o i s n b) x)]))
+     (((contract-proc c) o i s n b) x)]))
 
 (define (dict->bindings dict)
   (match dict