re arranged the file names in the contract library and exported a few more things from the main library to satisfy plai

svn: r2488

collects/mzlib/contract.ss

@@ -1,17 +1,13 @@
 (module contract mzscheme
   (require "private/contract.ss"
            "private/contract-arrow.ss"
-           "private/contract-util.ss"
+           "private/contract-guts.ss"
            "private/contract-ds.ss")
   
   
   (provide 
    (all-from "private/contract-ds.ss")
    (all-from "private/contract-arrow.ss")
-   (all-from-except "private/contract-util.ss"
+   (all-from-except "private/contract-guts.ss"
-                    raise-contract-error
-                    contract-proc
-                    make-contract
-                    contract-proc
                     build-compound-type-name)
-   (all-from-except "private/contract.ss")))
+   (all-from "private/contract.ss")))

collects/mzlib/private/contract-arrow.ss

@@ -1,7 +1,7 @@
 (module contract-arrow mzscheme
   (require (lib "etc.ss")
            (lib "list.ss")
-           "contract-util.ss"
+           "contract-guts.ss"
            "class-internal.ss")
   
   (require-for-syntax (lib "list.ss")

collects/mzlib/private/contract-ds.ss

@@ -1,6 +1,6 @@
 
 (module contract-ds mzscheme
-  (require "contract-util.ss")
+  (require "contract-guts.ss")
   (require-for-syntax "contract-ds-helpers.ss"
                       "contract-helpers.scm")
   

collects/mzlib/private/contract-guts.ss

@@ -1,4 +1,4 @@
-(module contract-util mzscheme
+(module contract-guts mzscheme
   (require "contract-helpers.scm"
            (lib "pretty.ss")
            (lib "list.ss"))
@@ -81,7 +81,7 @@
                 (define bangers (make-struct-field-mutator set count 'field))
                 ...))))])))
   
-  (define-values (proj-prop proj-pred? proj-get) 
+  (define-values (proj-prop proj-pred? raw-proj-get) 
     (make-struct-type-property 'contract-projection))
   (define-values (name-prop name-pred? name-get)
     (make-struct-type-property 'contract-name))
@@ -90,6 +90,26 @@
   (define-values (flat-prop flat-pred? flat-get)
     (make-struct-type-property 'contract-flat))
   
+  (define-values (pos-proj-prop pos-proj-pred? pos-proj-get) 
+    (make-struct-type-property 'contract-positive-projection))
+  (define-values (neg-proj-prop neg-proj-pred? neg-proj-get) 
+    (make-struct-type-property 'contract-negative-projection))
+  
+  (define (proj-get ctc)
+    (cond
+      [(proj-pred? ctc)
+       (raw-proj-get ctc)]
+      [(and (neg-proj-pred? ctc)
+            (pos-proj-pred? ctc))
+       (let ([pos-abs (pos-proj-get ctc)]
+             [neg-abs (pos-proj-get ctc)])
+         (λ (pos neg src-info str)
+           (let ([p-proj (pos-abs pos src-info str)]
+                 [n-proj (neg-abs neg src-info str)])
+             (lambda (v)
+               (n-proj (p-proj v))))))]
+      [else (error 'proj-get "unknown ~e" ctc)]))
+  
   ;; contract-stronger? : contract contract -> boolean
   ;; indicates if one contract is stronger (ie, likes fewer values) than another
   ;; this is not a total order.

collects/mzlib/private/contract.ss

@@ -23,7 +23,7 @@ add struct contracts for immutable structs?
            (lib "list.ss")
            (lib "pretty.ss")
            "contract-arrow.ss"
-           "contract-util.ss")
+           "contract-guts.ss")
   
   (require "contract-helpers.scm")
   (require-for-syntax (prefix a: "contract-helpers.scm"))

collects/plai/private/datatype-core.ss

@@ -7,9 +7,7 @@
 
 (module datatype-core mzscheme
   (require (lib "pconvert-prop.ss")
-	   (lib "contract.ss" "mzlib" "private")
+	   (lib "contract.ss"))
-           (lib "contract-util.ss" "mzlib" "private")
-           (lib "contract-arrow.ss" "mzlib" "private"))
   (require-for-syntax "core-utils.ss")
 
   (provide define-datatype-core