Refactoring all the private contract stuff into its own playpen.

svn: r16052

collects/mzlib/contract.ss

@@ -29,22 +29,22 @@
 ;; except the arrow contracts
 ;;
 
-(require scheme/private/contract-base
+(require scheme/contract/private/base
-         scheme/private/contract-misc
+         scheme/contract/private/misc
-         scheme/private/contract-provide
+         scheme/contract/private/provide
-         scheme/private/contract-guts
+         scheme/contract/private/guts
-         scheme/private/contract-ds
+         scheme/contract/private/ds
-         scheme/private/contract-opt
+         scheme/contract/private/opt
-         scheme/private/contract-basic-opters)
+         scheme/contract/private/basic-opters)
 
 (provide 
  opt/c define-opt/c ;(all-from "private/contract-opt.ss")
- (except-out (all-from-out scheme/private/contract-ds)
+ (except-out (all-from-out scheme/contract/private/ds)
              lazy-depth-to-look)
  
- (all-from-out scheme/private/contract-base)
+ (all-from-out scheme/contract/private/base)
- (all-from-out scheme/private/contract-provide)
+ (all-from-out scheme/contract/private/provide)
- (except-out (all-from-out scheme/private/contract-misc)
+ (except-out (all-from-out scheme/contract/private/misc)
              check-between/c
              string-len/c
              check-unary-between/c)

collects/mzlib/private/contract-arr-checks.ss

@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (provide (all-defined-out))
-(require scheme/private/contract-guts)
+(require scheme/contract/private/guts)
 
 (define empty-case-lambda/c
   (flat-named-contract '(case->)

collects/mzlib/private/contract-arr-obj-helpers.ss

@@ -4,7 +4,7 @@
 
 (require (for-syntax scheme/base))
 (require (for-template scheme/base)
-         (for-template scheme/private/contract-guts)
+         (for-template scheme/contract/private/guts)
          (for-template "contract-arr-checks.ss"))
 
 (provide make-/proc ->/h ->*/h ->d/h ->d*/h ->r/h 

collects/mzlib/private/contract-arrow.ss

@@ -1,11 +1,11 @@
 #lang scheme/base
 
-(require scheme/private/contract-guts
+(require scheme/contract/private/guts
-         scheme/private/contract-opt
+         scheme/contract/private/opt
          "contract-arr-checks.ss")
 (require (for-syntax scheme/base)
-         (for-syntax scheme/private/contract-opt-guts)
+         (for-syntax scheme/contract/private/opt-guts)
-         (for-syntax scheme/private/contract-helpers)
+         (for-syntax scheme/contract/private/helpers)
          (for-syntax "contract-arr-obj-helpers.ss")
          (for-syntax syntax/stx)
          (for-syntax syntax/name))

collects/mzlib/private/contract-define.ss

@@ -4,7 +4,7 @@
 
 (require (for-syntax scheme/base)
          (only-in scheme/contract contract)
-         (for-syntax (prefix-in a: scheme/private/contract-helpers)))
+         (for-syntax (prefix-in a: scheme/contract/private/helpers)))
 
 ;; First, we have the old define/contract implementation, which
 ;; is still used in mzlib/contract.

collects/mzlib/private/contract-object.ss

@@ -1,11 +1,11 @@
 #lang scheme/base
 (require "contract-arrow.ss"
-         scheme/private/contract-guts
+         scheme/contract/private/guts
          scheme/private/class-internal
          "contract-arr-checks.ss")
 
 (require (for-syntax scheme/base
-                     scheme/private/contract-helpers
+                     scheme/contract/private/helpers
                      "contract-arr-obj-helpers.ss"))
 
 (provide mixin-contract

collects/scheme/class.ss

@@ -1,7 +1,7 @@
 (module class mzscheme
 
-  (require "private/contract-object.ss")
+  (require "contract/private/object.ss")
-  (provide (all-from "private/contract-object.ss"))
+  (provide (all-from "contract/private/object.ss"))
   
   ;; All of the implementation is actually in private/class-internal.ss,
   ;;  which provides extra (private) functionality to contract.ss.

collects/scheme/contract.ss

@@ -9,34 +9,34 @@ differences from v3:
 
 |#
 
-(require "private/contract-arrow.ss"
+(require "contract/private/arrow.ss"
-         "private/contract-base.ss"
+         "contract/private/base.ss"
-         "private/contract-exists.ss"
+         scheme/contract/exists
-         "private/contract-misc.ss"
+         "contract/private/misc.ss"
-         "private/contract-provide.ss"
+         "contract/private/provide.ss"
-         "private/contract-regions.ss"
+         scheme/contract/regions
-         "private/contract-guts.ss"
+         "contract/private/guts.ss"
-         "private/contract-ds.ss"
+         "contract/private/ds.ss"
-         "private/contract-opt.ss"
+         "contract/private/opt.ss"
-         "private/contract-basic-opters.ss")
+         "contract/private/basic-opters.ss")
 
 (provide 
- opt/c define-opt/c ;(all-from-out "private/contract-opt.ss")
+ opt/c define-opt/c ;(all-from-out "contract/private/opt.ss")
- (except-out (all-from-out "private/contract-ds.ss")
+ (except-out (all-from-out "contract/private/ds.ss")
              lazy-depth-to-look)
  
- (except-out (all-from-out "private/contract-arrow.ss") 
+ (except-out (all-from-out "contract/private/arrow.ss") 
              making-a-method
              procedure-accepts-and-more?
              check-procedure
              check-procedure/more)
- (except-out (all-from-out "private/contract-exists.ss") ∃?)
+ (except-out (all-from-out scheme/contract/exists) ∃?)
- (except-out (all-from-out "private/contract-misc.ss")
+ (except-out (all-from-out "contract/private/misc.ss")
              check-between/c
              check-unary-between/c)
- (all-from-out "private/contract-regions.ss")
+ (all-from-out scheme/contract/regions)
- (all-from-out "private/contract-provide.ss")
+ (all-from-out "contract/private/provide.ss")
- (all-from-out "private/contract-base.ss"))
+ (all-from-out "contract/private/base.ss"))
 
 ;; from contract-guts.ss
 

collects/scheme/contract/base.ss

@@ -3,31 +3,31 @@
 ;; A stripped down version of scheme/contract for use in
 ;; the PLT code base where appropriate.
 
-(require scheme/private/contract-arrow
+(require "private/arrow.ss"
-         scheme/private/contract-base
+         "private/base.ss"
-         scheme/private/contract-misc
+         "private/misc.ss"
-         scheme/private/contract-provide
+         "private/provide.ss"
-         scheme/private/contract-guts
+         "private/guts.ss"
-         scheme/private/contract-ds
+         "private/ds.ss"
-         scheme/private/contract-opt)
+         "private/opt.ss")
 
 (provide 
- opt/c define-opt/c ;(all-from-out "private/contract-opt.ss")
+ opt/c define-opt/c ;(all-from-out "private/opt.ss")
- (except-out (all-from-out scheme/private/contract-ds)
+ (except-out (all-from-out "private/ds.ss")
              lazy-depth-to-look)
  
- (except-out (all-from-out scheme/private/contract-arrow) 
+ (except-out (all-from-out "private/arrow.ss")
              making-a-method
              procedure-accepts-and-more?
              check-procedure
              check-procedure/more)
- (except-out (all-from-out scheme/private/contract-misc)
+ (except-out (all-from-out "private/misc.ss")
              check-between/c
              check-unary-between/c)
- (all-from-out scheme/private/contract-provide)
+ (all-from-out "private/provide.ss")
- (all-from-out scheme/private/contract-base))
+ (all-from-out "private/base.ss"))
 
-;; from contract-guts.ss
+;; from private/guts.ss
 
 (provide any
          and/c

collects/scheme/contract/exists.ss

@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require "contract-guts.ss")
+(require "private/guts.ss")
 
 (provide new-∃/c
          ∃?)

collects/scheme/contract/private/arrow.ss

@@ -18,12 +18,12 @@ v4 todo:
 
 |#
 
-(require "contract-guts.ss"
+(require "guts.ss"
-         "contract-opt.ss"
+         "opt.ss"
          scheme/stxparam)
 (require (for-syntax scheme/base)
-         (for-syntax "contract-opt-guts.ss")
+         (for-syntax "opt-guts.ss")
-         (for-syntax "contract-helpers.ss")
+         (for-syntax "helpers.ss")
          (for-syntax syntax/stx)
          (for-syntax syntax/name))
 

collects/scheme/contract/private/base.ss

@@ -15,8 +15,8 @@ improve method arity mismatch contract violation error messages?
 
 (require (for-syntax scheme/base)
          scheme/stxparam
-         "contract-guts.ss"
+         "guts.ss"
-         "contract-helpers.ss")
+         "helpers.ss")
 
 (define-syntax-parameter current-contract-region (λ (stx) #'(#%variable-reference)))
 

collects/scheme/contract/private/basic-opters.ss

@@ -1,10 +1,10 @@
 #lang scheme/base
 
-(require "contract-guts.ss"
+(require "guts.ss"
-         "contract-opt.ss"
+         "opt.ss"
-         "contract-base.ss")
+         "base.ss")
 (require (for-syntax scheme/base
-                     "contract-opt-guts.ss"))
+                     "opt-guts.ss"))
 
 ;;
 ;; opt/pred helper

collects/scheme/contract/private/ds-helpers.ss

@@ -5,7 +5,7 @@
          build-enforcer-clauses
          generate-arglists)
 
-(require "contract-opt-guts.ss")
+(require "opt-guts.ss")
 (require (for-template scheme/base)
          (for-syntax scheme/base))
 

collects/scheme/contract/private/ds.ss

@@ -17,13 +17,13 @@ it around flattened out.
 
 |#
 
-(require "contract-guts.ss"
+(require "guts.ss"
-         "contract-opt.ss"
+         "opt.ss"
          mzlib/etc)
 (require (for-syntax scheme/base)
-         (for-syntax "contract-ds-helpers.ss")
+         (for-syntax "ds-helpers.ss")
-         (for-syntax "contract-helpers.ss")
+         (for-syntax "helpers.ss")
-         (for-syntax "contract-opt-guts.ss")
+         (for-syntax "opt-guts.ss")
          (for-syntax mzlib/etc))
 
 (provide define-contract-struct

collects/scheme/contract/private/guts.ss

@@ -1,10 +1,10 @@
 #lang scheme/base
 
-(require "contract-helpers.ss"
+(require "helpers.ss"
          scheme/pretty)
 
 (require (for-syntax scheme/base
-                     "contract-helpers.ss"))
+                     "helpers.ss"))
 
 (provide raise-contract-error
          guilty-party

collects/scheme/contract/private/misc.ss

@@ -2,11 +2,11 @@
 
 (require (for-syntax scheme/base
                      scheme/struct-info
-                     "contract-helpers.ss"
+                     "helpers.ss"
-                     "contract-opt-guts.ss")
+                     "opt-guts.ss")
          scheme/promise
-         "contract-opt.ss"
+         "opt.ss"
-         "contract-guts.ss")
+         "guts.ss")
 
 (provide flat-rec-contract
          flat-murec-contract

collects/scheme/contract/private/object.ss

@@ -1,7 +1,7 @@
 #lang scheme/base
-(require "contract-arrow.ss"
+(require "arrow.ss"
-         "contract-guts.ss"
+         "guts.ss"
-         "class-internal.ss"
+         scheme/private/class-internal
          scheme/stxparam)
 
 (require (for-syntax scheme/base))

collects/scheme/contract/private/opt-guts.ss

@@ -1,7 +1,7 @@
 #lang scheme/base
 (require syntax/private/boundmap ;; needs to be the private one, since the public one has contracts
          (for-template scheme/base)
-         (for-template "contract-guts.ss")
+         (for-template "guts.ss")
          (for-syntax scheme/base))
 
 (provide get-opter reg-opter! opter

collects/scheme/contract/private/opt.ss

@@ -1,9 +1,9 @@
 #lang scheme/base
-(require "contract-guts.ss"
+(require "guts.ss"
          scheme/stxparam
          mzlib/etc)
 (require (for-syntax scheme/base)
-         (for-syntax "contract-opt-guts.ss")
+         (for-syntax "opt-guts.ss")
          (for-syntax mzlib/etc)
          (for-syntax scheme/stxparam))
 

collects/scheme/contract/private/provide.ss

@@ -4,11 +4,11 @@
 
 (require (for-syntax scheme/base
                      scheme/list
-                     (prefix-in a: "contract-helpers.ss"))
+                     (prefix-in a: "helpers.ss"))
-         "contract-arrow.ss"
+         "arrow.ss"
-         "contract-base.ss"
+         "base.ss"
-         "contract-exists.ss"
+         scheme/contract/exists
-         "contract-guts.ss")
+         "guts.ss")
 
 (define-syntax (verify-contract stx)
   (syntax-case stx ()

collects/scheme/contract/regions.ss

@@ -9,11 +9,11 @@
                      scheme/struct-info
                      syntax/define
                      syntax/kerncase
-                     (prefix-in a: "contract-helpers.ss"))
+                     (prefix-in a: "private/helpers.ss"))
          scheme/splicing
-         "contract-arrow.ss"
+         "private/arrow.ss"
-         "contract-base.ss"
+         "private/base.ss"
-         "contract-guts.ss")
+         "private/guts.ss")
 
 ;; These are useful for all below.
 

collects/scheme/exists/lang.ss

@@ -1,6 +1,6 @@
 #lang scheme
 
-(require "../private/contract-exists.ss")
+(require scheme/contract/exists)
 
 ;; this code builds the list of predicates (in case it changes, this may need to be re-run)
 #;

collects/scribblings/reference/contracts.scrbl

@@ -17,9 +17,9 @@ another. Programmers specify the behavior of a module exports via
 @scheme[provide/contract] and the contract system enforces those
 constraints.
 
-@note-lib[scheme/contract #:use-sources (scheme/private/contract-ds
+@note-lib[scheme/contract #:use-sources (scheme/contract/private/ds
-                                         scheme/private/contract-base
+                                         scheme/contract/private/base
-                                         scheme/private/contract-guts)]
+                                         scheme/contract/private/guts)]
 
 @deftech{Contracts} come in two forms: those constructed by the
 various operations listed in this section of the manual, and various

collects/syntax/private/stxparse/lib.ss

@@ -5,7 +5,7 @@
          syntax/stx
          syntax/kerncase
          scheme/struct-info
-         scheme/private/contract-helpers
+         scheme/contract/private/helpers
          (for-syntax scheme/base
                      syntax/kerncase
                      "rep.ss"

collects/tests/macro-debugger/tests/collects.ss

@@ -195,17 +195,17 @@
     scheme/mzscheme
     scheme/nest
     scheme/private/class-internal
-    scheme/private/contract-base
+    scheme/contract/private/base
-    scheme/private/contract-arrow
+    scheme/contract/private/arrow
-    scheme/private/contract-basic-opters
+    scheme/contract/private/basic-opters
-    scheme/private/contract-ds
+    scheme/contract/private/ds
-    scheme/private/contract-ds-helpers
+    scheme/contract/private/ds-helpers
-    scheme/private/contract-exists
+    scheme/contract/private/exists
-    scheme/private/contract-guts
+    scheme/contract/private/guts
-    scheme/private/contract-helpers
+    scheme/contract/private/helpers
-    scheme/private/contract-misc
+    scheme/contract/private/misc
-    scheme/private/contract-opt
+    scheme/contract/private/opt
-    scheme/private/contract-opt-guts
+    scheme/contract/private/opt-guts
     scheme/private/define-struct
     scheme/private/define-struct
     scheme/private/for

collects/tests/mzscheme/contract-test.ss

@@ -11,7 +11,7 @@
         (namespace-require '(for-syntax scheme/base))
         (namespace-require '(for-template scheme/base))
         (namespace-require 'scheme/contract)
-        (namespace-require '(only scheme/private/contract-arrow procedure-accepts-and-more?))
+        (namespace-require '(only scheme/contract/private/arrow procedure-accepts-and-more?))
         (namespace-require 'scheme/class)
         (namespace-require 'scheme/promise))
       n))