pull/2/head
Matthew Butterick 10 years ago
parent d038dfe8cf
commit 56c942bc0f

@ -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)|#
(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)

@ -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)
]
Loading…
Cancel
Save