pull/2/head
Matthew Butterick 10 years ago
parent b73cc5944d
commit cf596cabd7

@ -1,7 +1,9 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax))
(require racket/contract "../define/provide.rkt" "value.rkt") (require racket/contract "../define/provide.rkt" "value.rkt")
(define-syntax-rule (make-blame-handler try-proc expected-sym) (define-syntax-rule (make-blame-handler try-proc expected-sym)
(λ(b) (λ(b)
(λ(x) (λ(x)
@ -10,37 +12,30 @@
b x b x
'(expected: "~a" given: "~e") '(expected: "~a" given: "~e")
expected-sym x))]) expected-sym x))])
(try-proc x))))) (try-proc x)))))
(define+provide coerce/integer?
(make-contract (provide make-coercion-contract)
#:name 'coerce/integer? (define-syntax (make-coercion-contract stx)
#:projection (make-blame-handler ->int 'can-be-integer?))) (syntax-case stx ()
[(_ stem)
(let ([stem-datum (syntax->datum #'stem)])
(define+provide coerce/string? (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)]
(make-contract [->stem (format-id stx "->~a" #'stem)]
#:name 'coerce/string? [can-be-stem? (format-id stx "can-be-~a?" #'stem)])
#:projection (make-blame-handler ->string 'can-be-string?))) #'(define+provide coerce/stem?
(make-contract
#:name 'coerce/stem?
(define+provide coerce/symbol? #:projection (make-blame-handler ->stem 'can-be-stem?)))))]))
(make-contract
#:name 'coerce/symbol?
#:projection (make-blame-handler ->symbol 'can-be-symbol?))) (make-coercion-contract int)
(make-coercion-contract string)
(make-coercion-contract symbol)
(define+provide coerce/path? (make-coercion-contract path)
(make-contract (make-coercion-contract boolean)
#:name 'coerce/path?
#:projection (make-blame-handler ->path 'can-be-path?))) #|
(define/contract (foo x)
(coerce/string? . -> . any/c)
(define+provide coerce/boolean? x)|#
(make-contract
#:name 'coerce/boolean?
#:projection (make-blame-handler ->boolean 'can-be-boolean?)))

@ -52,6 +52,6 @@
(let* ([duplicate-keys (filter-not empty? (hash-map (count-incidence x) (let* ([duplicate-keys (filter-not empty? (hash-map (count-incidence x)
(λ(k v) (if (> v 1) k '()))))]) (λ(k v) (if (> v 1) k '()))))])
(error (string-append (if (= (len duplicate-keys) 1) (error (string-append (if (= (len duplicate-keys) 1)
"Item isnt" "item isnt"
"Items arent") " unique:") duplicate-keys)) "items arent") " unique:") duplicate-keys))
result)) result))
Loading…
Cancel
Save