bounded
| (require bounded) | package: bounded |
This module defines contracts that emulate bounded polymorphism.
syntax
(bounded-polymorphic->/c ([x bound] ...) c)
At each application of a function, the bounded-polymorphic->/c contract creates a fresh contract for each type variable x. Values flowing into the polymorphic function (i.e. values protected by some x in negative position with respect to bounded-polymorphic->/c) are contracted with the corresponding bound contract. Values flowing out of the polymorphic function (i.e. values protected by some x in positive position with respect to bounded-polymorphic->/c) are checked to ensure they were wrapped by the corresponding x contract in a negative position. If so, the bound contract is removed from the value; if not, a contract violation is signaled.
Contracts supplied as bounds must be higher order contracts.
> (define (id x) x)
> (define/contract (check fn val) (bounded-polymorphic->/c ([X (integer? . -> . integer?)]) (X any/c . -> . X)) (fn val) fn)
> (check id 0) #<procedure:id>
> (check id 'bad) check: broke its own contract
promised: integer?
produced: 'bad
in: the 1st argument of
the 1st argument of
(bounded-polymorphic->/c
((X (-> integer? integer?)))
(-> X any/c X))
contract from: (function check)
blaming: (function check)
(assuming the contract is correct)
at: eval:3.0
> ((check id 0) 'ok) 'ok
To correctly enforce blame, additional contracts applied to values flowing through a bounded contract variable in a negative position are enforced after flowing through the corresponding contract in a positive position.
> (define (id x) x)
> (define/contract (coerce-string fn) (any/c . -> . (string? . -> . string?)) fn)
> (define/contract (check fn) (bounded-polymorphic->/c ([X (integer? . -> . integer?)]) (X . -> . X)) (coerce-string fn))
> ((check id) 0) coerce-string: contract violation
expected: string?
given: 0
in: the 1st argument of
the range of
(-> any/c (-> string? string?))
contract from: (function coerce-string)
blaming: top-level
(assuming the contract is correct)
at: eval:3.0
syntax
(object/c-opaque member-spec ...)
member-spec = method-spec | (field field-spec ...) method-spec = method-id | (method-id method-contract) field-spec = field-id | (field-id contract-expr)
> (define one-method% (class object% (define/public (foo) 'foo) (super-new)))
> (define two-method% (class one-method% (inherit foo) (define/public (bar) 'bar) (super-new)))
> (define one (new one-method%))
> (define two (new two-method%))
> (define/contract (use-one obj) (-> (object/c-opaque (foo (->m symbol?))) any/c) (send obj foo) obj)
> (define/contract (use-two obj) (-> (object/c-opaque (foo (->m symbol?))) any/c) (send obj bar) obj)
> (define/contract (use-one-poly obj) (bounded-polymorphic->/c ([X (object/c-opaque (foo (->m symbol?)))]) (-> X X)) (send obj foo) obj)
> (define/contract (use-two-poly obj) (bounded-polymorphic->/c ([X (object/c-opaque (foo (->m symbol?)))]) (-> X X)) (send obj bar) obj)
> (use-one-poly one) (object:one-method% ...)
> (use-one-poly two) (object:two-method% ...)
> (use-two-poly one) send: no such method
method name: bar
class name: one-method%
> (use-two-poly two) bar: contract violation;
cannot call hidden method
in: the bar method in
the 1st argument of
(bounded-polymorphic->/c
((X (object/c-opaque (foo (->m symbol?)))))
(-> X X))
contract from: (function use-two-poly)
contract on: use-two-poly
blaming: (function use-two-poly)
(assuming the contract is correct)
at: eval:9.0
> (send (use-one two) bar) bar: contract violation;
cannot call hidden method
in: the bar method in
the 1st argument of
(-> anonymous-contract any/c)
contract from: (function use-one)
contract on: use-one
blaming: (function use-one)
(assuming the contract is correct)
at: eval:6.0
> (send (use-one-poly two) bar) 'bar