add has-option? to check if a value has an option contract or not

This commit is contained in:
Robby Findler 2013-02-23 16:18:55 -06:00
parent 18c009276d
commit 64d7911fe5
2 changed files with 15 additions and 6 deletions

View File

@ -1,7 +1,8 @@
#lang racket
(provide option/c transfer-option exercise-option waive-option invariant/c)
(provide option/c transfer-option exercise-option waive-option invariant/c
has-option?)
(require syntax/location
@ -265,8 +266,12 @@
(provide (contract-out [rename new-id id (transfer/c id)] ...)))))])
#`(combine-out))))
(define (has-option? val)
(and (has-contract? val)
(option? (value-contract val))))
(define (exercise-option val)
(cond [(and (has-contract? val) (option? (value-contract val)))
(cond [(has-option? val)
(let ((info (proxy-info val)))
(((info-proj info)
(info-blame info))
@ -274,7 +279,8 @@
[else (error 'exercise-option-error "~a has no option to exercise" val)]))
(define (waive-option val)
(cond [(and (has-contract? val) (option? (value-contract val))) (info-val (proxy-info val))]
(cond [(has-option? val)
(info-val (proxy-info val))]
[else (error 'waive-option-error "~a has no option to waive" val)]))

View File

@ -66,7 +66,7 @@ is a predicate. In any other case, the result is a contract error.
}
@defproc[(exercise-option [x any/c]) any/c]{
@defproc[(exercise-option [x has-option?]) any/c]{
Returns @racket[x] with contract ckecking enabled if an @racket[option/c] guards
@racket[x]. In any other case the result is an error.
@ -118,7 +118,7 @@ to the positive and negative blame parties respectively. If @racket[id] is not b
}
@defproc[(waive-option [x any/c]) any/c]{
@defproc[(waive-option [x has-option?]) any/c]{
If an @racket[option/c] guards @racket[x], then @racket[waive-option] returns
@racket[x] without the @racket[option/c] guard.
@ -184,7 +184,10 @@ are chaperone contracts, then the result will be a chaperone contract.
(vector-ref vec 2)]
}
@defproc[(has-option? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] has an option contract.
}
@(close-eval the-eval)