suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add a #:name argument to flat-contract-with-explanation

Browse Source
This commit is contained in:
Robby Findler 2017-04-13 10:19:20 -05:00
parent e7f68472e5
commit 6492226411
3 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-doc/scribblings/reference/contracts.scrbl
View File

@ -124,7 +124,8 @@ and how they can be used to implement contracts.
@section[#:tag "data-structure-contracts"]{Data-structure Contracts}
@declare-exporting-ctc[racket/contract/base]
@defproc[(flat-contract-with-explanation [get-explanation (-> any/c (or/c boolean? (-> blame? any)))])
@defproc[(flat-contract-with-explanation [get-explanation (-> any/c (or/c boolean? (-> blame? any)))]
[#:name name any/c (object-name get-explanation)])
flat-contract?]{
Provides a way to use flat contracts that, when a contract fails,
provide more information about the failure.
@ -133,7 +134,10 @@ and how they can be used to implement contracts.
treated as the predicate in a @tech{flat contract}. If it returns
a procedure, then it is treated similarly to returning @racket[#f],
except the result procedure is called to actually signal the contract
violation.
violation.
The @racket[name] argument is used as the name of the contract; it defaults
to the name of the @racket[get-explanation] function.
@racketblock[(flat-contract-with-explanation
(λ (val)

1
pkgs/racket-test/tests/racket/contract/name.rkt
View File

@ -64,6 +64,7 @@
(test-name 'kalidoscope (flat-named-contract 'kalidoscope exact-positive-integer?))
(test-name 'brick (flat-named-contract 'brick (integer-in 11 22)))
(test-name 'brick (flat-contract-with-explanation (let ([brick (λ (x) #t)]) brick)))
(test-name '(-> integer? integer?) (-> integer? integer?))
(test-name '(-> integer? any) (-> integer? any))

3
racket/collects/racket/contract/private/misc.rkt
View File

@ -1062,7 +1062,7 @@
#:stronger (λ (this that) (contract-stronger? ctc that))
#:list-contract? (list-contract? ctc)))
(define (flat-contract-with-explanation ?)
(define (flat-contract-with-explanation ? #:name [name (object-name ?)])
(define (call-? x)
(define reason (? x))
(unless (or (boolean? reason)
@ -1072,6 +1072,7 @@
(format "~s" '(or/c boolean? (-> blame? any)))))
reason)
(make-flat-contract
#:name name
#:first-order (λ (x) (equal? #t (call-? x)))
#:late-neg-projection
(λ (b)