Ported exists.ss to new properties.

svn: r17692

collects/scheme/contract/exists.ss

@@ -9,25 +9,24 @@
   (let ([in (∃/c-in ctc)]
         [out (∃/c-out ctc)]
         [pred? (∃/c-pred? ctc)])
-  (λ (pos-blame neg-blame src-info orig-str positive-position?)
+  (λ (blame)
-    (if positive-position?
+    (if (blame-swapped? blame)
-	in
         (λ (val)
           (if (pred? val)
               (out val)
-              (raise-contract-error val src-info pos-blame orig-str 
+              (raise-blame-error blame
-                                    "non-polymorphic value: ~e"
+                                 val 
-                                    val)))))))
+                                 "non-polymorphic value: ~e"
+                                 val)))
+	in))))
 
 (define-struct ∃/c (in out pred? name)
   #:omit-define-syntaxes
-  #:property proj-prop ∃-proj
+  #:property prop:contract
-  #:property name-prop (λ (ctc) (∃/c-name ctc))
+  (build-contract-property
-  #:property first-order-prop
+   #:name (λ (ctc) (∃/c-name ctc))
-  (λ (ctc) (λ (x) #t)) ;; ???
+   #:first-order (λ (ctc) (λ (x) #t)) ;; ???
-      
+   #:projection ∃-proj))
-  #:property stronger-prop
-  (λ (this that) #f))
 
 (define-struct ∃ ())