From 56c942bc0fb0aa05ed5e550505e17624b07ceda5 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Thu, 13 Mar 2014 09:58:52 -0700
Subject: [PATCH] updates

---
 coerce/contract.rkt      | 40 +++++++++++++++++++---------------------
 scribblings/coerce.scrbl | 17 +----------------
 2 files changed, 20 insertions(+), 37 deletions(-)

diff --git a/coerce/contract.rkt b/coerce/contract.rkt
index bcf5b2b..5ce54ff 100644
--- a/coerce/contract.rkt
+++ b/coerce/contract.rkt
@@ -3,7 +3,6 @@
 (require racket/contract "../define/provide.rkt" "value.rkt")
 
 
-
 (define-syntax-rule (make-blame-handler try-proc expected-sym)
   (λ(b)
     (λ(x)
@@ -14,28 +13,27 @@
                                     expected-sym x))])
         (try-proc x)))))
 
-
 (provide make-coercion-contract)
 (define-syntax (make-coercion-contract stx)
   (syntax-case stx ()
+    [(_ stem coerce-proc)
+     (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)]
+                   [can-be-stem? (format-id stx "can-be-~a?" #'stem)])
+       #'(make-contract
+          #:name 'coerce/stem?
+          #:projection (make-blame-handler coerce-proc 'can-be-stem?)))]
     [(_ stem)
-     (let ([stem-datum (syntax->datum #'stem)])
-       (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)]
-                     [->stem (format-id stx "->~a" #'stem)]
-                     [can-be-stem? (format-id stx "can-be-~a?" #'stem)])
-         #'(make-contract
-              #:name 'coerce/stem?
-              #:projection (make-blame-handler ->stem 'can-be-stem?))))]))
-
-
-(define+provide coerce/int? (make-coercion-contract int))
-(define+provide coerce/symbol? (make-coercion-contract symbol))
-(define+provide coerce/path? (make-coercion-contract path))
-(define+provide coerce/boolean? (make-coercion-contract boolean))
-(define+provide coerce/string? (make-coercion-contract string))
+     (with-syntax ([->stem (format-id stx "->~a" #'stem)])
+       #'(make-coercion-contract stem ->stem))]))
 
-
-#|
-(define/contract (foo x)
-  (coerce/string? . -> . any/c)
-  x)|#
\ No newline at end of file
+(define-syntax (define+provide-coercion-contract stx)
+  (syntax-case stx ()
+    [(_ stem)
+     (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)])
+       #'(define+provide coerce/stem? (make-coercion-contract stem)))]))
+
+(define+provide-coercion-contract int)
+(define+provide-coercion-contract string)
+(define+provide-coercion-contract symbol)
+(define+provide-coercion-contract path)
+(define+provide-coercion-contract boolean)
diff --git a/scribblings/coerce.scrbl b/scribblings/coerce.scrbl
index 49caf69..f2660fa 100644
--- a/scribblings/coerce.scrbl
+++ b/scribblings/coerce.scrbl
@@ -145,7 +145,7 @@ Report whether @racket[_v] can be coerced to the specified type.
 
 
 
-@section{Contracts}
+@section{Contracts that coerce}
 @defmodule[sugar/coerce/contract]
 
 @deftogether[(
@@ -168,20 +168,5 @@ If @racket[_v] can be coerced to the specified type, these contracts will return
     (int-sum 1.6 3.8)
 ]
 
-@defproc[
-(make-coercion-contract 
-[type string?]) 
-contract?]
-Make a coercion contract named @code{coerce/type?} that will coerce a value to the speficied type. Assumes the existence of a @code{->type} function to do the coercion.
 
 
-@examples[#:eval my-eval
-(define (->list x)
-    (if (list? x) x (list x)))
-(define coerce/list? (make-coercion-contract list))
-(define/contract (listify x)
-    (any/c . -> . coerce/list?)
-    x)
-(listify '(a b c))
-(listify 24)
-]
\ No newline at end of file