Updated contracts in XML collection.

svn: r17720

collects/xml/private/structures.ss

@@ -58,15 +58,18 @@
 (define permissive-xexprs (make-parameter #f))
 
 (define permissive/c
-  (make-proj-contract 'permissive/c
+  (simple-flat-contract
-                      (lambda (pos neg src-info name)
+   #:name 'permissive/c
-                        (lambda (v)
+   #:projection
-                          (if (permissive-xexprs)
+   (lambda (blame)
-                              v
+     (lambda (v)
-                              (raise-contract-error
+       (if (permissive-xexprs)
-                               v src-info pos name "not in permissive mode"))))
+         v
-                      (lambda (v)
+         (raise-blame-error
-                        (permissive-xexprs))))
+          blame v "not in permissive mode"))))
+   #:first-order
+   (lambda (v)
+     (permissive-xexprs))))
 
 ; content? : TST -> Bool
 (define content/c

collects/xml/private/xexpr.ss

@@ -33,31 +33,30 @@
                                (or/c (cons/c (listof (list/c symbol? string?)) (listof xexpr))
                                      (listof xexpr)))))
 
-(define xexpr/c 
-  (make-proj-contract
-   'xexpr?
-   (lambda (pos neg src-info name)
-     (lambda (val)
-       (with-handlers ([exn:invalid-xexpr?
-                        (lambda (exn)
-                          (raise-contract-error
-                           val
-                           src-info
-                           pos
-                           name
-                           "Not an Xexpr. ~a~n~nContext:~n~a"
-                           (exn-message exn)
-                           (pretty-format val)))])
-         (validate-xexpr val)
-         val)))
-   (lambda (v) #t)))
-
 (define (xexpr? x)
   (correct-xexpr? x (lambda () #t) (lambda (exn) #f)))
 
 (define (validate-xexpr x)
   (correct-xexpr? x (lambda () #t) (lambda (exn) (raise exn))))
 
+(define xexpr/c 
+  (simple-flat-contract
+   #:name 'xexpr?
+   #:projection
+   (lambda (blame)
+     (lambda (val)
+       (with-handlers ([exn:invalid-xexpr?
+                        (lambda (exn)
+                          (raise-blame-error
+                           blame
+                           val
+                           "Not an Xexpr. ~a~n~nContext:~n~a"
+                           (exn-message exn)
+                           (pretty-format val)))])
+         (validate-xexpr val)
+         val)))
+   #:first-order xexpr?))
+
 ;; ;; ;; ;; ;; ;; ;
 ;; ; xexpr? helpers