Contract Miscellanea

8.16.0.1

Contract Miscellanea🔗ℹ

Cameron Moy

1 Combinators🔗ℹ

This library is experimental; compatibility may not be maintained.

procedure
(dynamic->d make-contract) → contract?
make-contract :
(-> (unconstrained-domain-> contract?)
contract?)

This contract protects a procedure. It applies make-contract when the procedure is called with its arguments. The return value is expected to be a function contract that is then applied to the procedure, and the arguments are then reapplied to that protected procedure.

Examples:

> (define increasing/c
    (dynamic->d
      (λ (x)
        (-> integer? (>/c x)))))
> (define/contract add1* increasing/c add1)
> (add1* 42)
43
> (define/contract values* increasing/c values)
> (values* 42)
values*: broke its own contract
  promised: a number strictly greater than 42
  produced: 42
  in: the range of
      dynamic->d
  contract from: (definition values*)
  blaming: (definition values*)
   (assuming the contract is correct)
  at: eval:4:0

procedure
(self/c make-contract
[ #:chaperone? chaperone?]) → contract?
make-contract : (-> any/c contract?)
chaperone? : boolean? = #f

Constructs a contract where the contract itself depends on the value it’s protecting. When the contract is attached to a value, make-contract is applied to it and the resulting contract is then attached to that value.

Examples:

> (define cdr-returns-car/c
    (self/c
      (λ (p)
        (match-define (cons x f) p)
        (cons/c any/c (-> x)))))
> (define/contract good-self cdr-returns-car/c (cons 1 (const 1)))
> ((cdr good-self))
1
> 1
1
> (define/contract bad-self cdr-returns-car/c (cons 1 (const 2)))
> ((cdr bad-self))
bad-self: broke its own contract
  promised: 1
  produced: 2
  in: the range of
      the cdr of
      self/c
  contract from: (definition bad-self)
  blaming: (definition bad-self)
   (assuming the contract is correct)
  at: eval:10:0

procedure
(elementof/c contract get-element) → flat-contract?
contract : contract?
get-element : (-> any/c any/c)

Constructs a contract where the result of get-element on the protected value is checked against contract. However, the wrapper (if any) produced by contract is discarded.

Examples:

> (define car-is-int? (elementof/c integer? car))
> (define/contract good-pair car-is-int? (cons 1 2))
> (define/contract bad-pair car-is-int? (cons "hi" 2))
bad-pair: broke its own contract
  promised: integer?
  produced: "hi"
  in: (elementof/c integer?)
  contract from: (definition bad-pair)
  blaming: (definition bad-pair)
   (assuming the contract is correct)
  at: eval:14:0

procedure
(case->i arrow-contract ...) → contract?
arrow-contract : contract?

Like case->, but with support for ->i.

Examples:

> (define/contract might-count
    (case->i
      (-> string? integer?)
      (->i ([s string?] [n (s) (=/c (string-length s))]) [res integer?]))
    (lambda (s . args) (string-length s)))
> (might-count "hi")
2
> (might-count "hi" 2)
2
> (might-count "hi" 3)
might-count: contract violation
  expected: (=/c 2)
  given: 3
  in: the n argument of
      (case->i
       ((-> string? integer?)
        (->i
         ((s string?)
          (n (s) (=/c (string-length s))))
         (res integer?))))
  contract from: (definition might-count)
  blaming: top-level
   (assuming the contract is correct)
  at: eval:15:0

syntax
(apply/c [contract-expr to-protect-expr maybe-swap] ...+)

maybe-swap =
| #:swap
syntax
(return/c [contract-expr to-protect-expr maybe-swap] ...+)

maybe-swap =
| #:swap

These contracts expect a procedure and sends a constant value through another contract when the procedure is applied or returns respectively. The #:swap option swaps the blame for violation of the contract.

Examples:

> (define (apply-at-most-once/c)
    (define count 0)
    (define (incr n)
      (set! count (+ count n))
      (<= count 1))
    (apply/c [incr 1]))
> (define/contract f (apply-at-most-once/c) void)
> (f)
> (f)
f: contract violation
  expected: incr
  given: 1
  in: apply/c
  contract from: (definition f)
  blaming: top-level
   (assuming the contract is correct)
  at: eval:20:0

procedure
(class-object/c class-contract
object-contract) → contract?
class-contract : contract?
object-contract : contract?

Creates a class contract that acts exactly like class-contract, except that instantiated objects are additionally constrained by object-contract.

Examples:

> (define cat%/c
    (class-object/c
      (class/c [meow (->m integer? string?)])
      (object/c [meow (->m positive? string?)])))
> (define/contract cat%
    cat%/c
    (class object%
      (define/public (meow n)
        (string-join (map (const "meow") (range n))))
      (super-new)))
> (define leo (new cat%))
> (send leo meow 1/2)
meow: contract violation
  expected: integer?
  given: 1/2
  in: the 1st argument of
      the meow method in
      the class contract of
      (class-object/c
       (class/c (meow (->m integer? string?)))
       (object/c (meow (->m positive? string?))))
  contract from: (definition cat%)
  contract on: cat%
  blaming: top-level
   (assuming the contract is correct)
  at: eval:24:0
> (send leo meow -2)
meow: contract violation
  expected: positive?
  given: -2
  in: the 1st argument of
      the meow method in
      the object contract of
      (class-object/c
       (class/c (meow (->m integer? string?)))
       (object/c (meow (->m positive? string?))))
  contract from: (definition cat%)
  contract on: cat%
  blaming: top-level
   (assuming the contract is correct)
  at: eval:24:0
> (send leo meow 4)
"meow meow meow meow"

procedure
(classof/c object-contract) → contract?
object-contract : contract?

The same as class-object/c without a class contract constraint.

procedure
(dependent-class-object/c class-contract
make-object-contract) → contract?
class-contract : contract?
make-object-contract : procedure?

Like class-object/c except the second argument is a procedure that accepts the initialization arguments (as keyword arguments or rest arguments) and returns an object contract.

Examples:

> (define dog%/c
    (dependent-class-object/c
      (class/c [bark (->m string? string?)])
      (λ (#:sound sound)
        (object/c
          [bark (->m string? (λ (s) (equal? s sound)))]))))
> (define/contract dog%
    dog%/c
    (class object%
      (init sound)
      (define/public (bark x) x)
      (super-new)))
> (define spot (new dog% [sound "woof"]))
> (send spot bark "meow")
bark: broke its own contract
  promised: ???
  produced: "meow"
  in: the range of
      the bark method in
      the object contract of
      (dependent-class-object/c
       (class/c (bark (->m string? string?)))
       eval:29:0)
  contract from: (definition dog%)
  contract on: dog%
  blaming: (definition dog%)
   (assuming the contract is correct)
  at: eval:30:0
> (send spot bark "woof")
"woof"

procedure
(dependent-classof/c make-object-contract) → contract?
make-object-contract : procedure?

The same as dependent-class-object/c without a class contract constraint.

procedure
(channel*/c get-contract put-contract) → contract?
get-contract : contract?
put-contract : contract?

Creates a class contract that acts exactly like channel/c, except that the contract for getting a value and putting a value can be different.

Examples:

> (define/contract x
    (channel*/c integer? number?)
    (make-channel))
> (thread (λ () (channel-put x 11.5)))
#<thread>
> (channel-get x)
x: broke its own contract
  promised: integer?
  produced: 11.5
  in: the channel get of
      (channel*/c integer? number?)
  contract from: (definition x)
  blaming: (definition x)
   (assuming the contract is correct)
  at: eval:34:0

procedure
(async-channel*/c get-contract
put-contract) → contract?
get-contract : contract?
put-contract : contract?

The same as channel*/c, except for asynchronous channels.

2 provide Forms🔗ℹ

syntax
(exercise-out id ...)

Exercises the given options before providing.

Examples:

> (module inner racket
    (require contract-etc
             racket/contract/option)
    (provide (exercise-out foo)
             (rename-out [foo unchecked-foo]))
    (define/contract (foo)
      (option/c (-> integer?))
      "nan"))
> (require 'inner)
> (unchecked-foo)
"nan"
> (foo)
foo: broke its own contract
  promised: integer?
  produced: "nan"
  in: the range of
      the option of
      (option/c (-> integer?))
  contract from: (function foo)
  blaming: (function foo)
   (assuming the contract is correct)
  at: eval:37:0

syntax
(waive-out id ...)

Similar to exercise-out, except it waives the given options before providing.

3 Annotations🔗ℹ

(require contract-etc/annotate)

package: contract-etc-lib

Typically, programmers will only attach contracts at module or library boundaries with contract-out and not use contracts at the definition level with define/contract. This is because fine-grained contract boundaries cause major performance problems due to the overhead of repeated checking.

Contract annotations provide a convenient means of enabling and disabling internal contract checks as needed. For example, you may decide that for local testing you want to disable internal contract checks, but enable them during continuous integration testing.

syntax
(: id contract-expr)

Annotates the definition of id with a contract. The first-order part of the contract is checked immediately. For a flat contract, nothing else needs to happen. For a higher-order contract, an option of contract-expr is attached to id.

Where, and whether, that option is enabled depends on the environment variables present at run time.

If CONTRACT_EXERCISE is set, then the option is enabled by default.
If CONTRACT_EXERCISE_TEST is set, then the option is enabled by default only in the test submodule of the current file.
If neither are set, then the option is disabled by default.

Examples:

> (: sub2 (-> number? number?))
> (define (sub2) 42)
sub2: broke its own contract
  promised: a procedure that accepts 1 non-keyword argument
  produced: #<procedure:sub2>
  sub2 accepts: 0 arguments
  in: (option/c
       (-> number? number?)
       #:tester
       #<procedure:...arrow-val-first.rkt:1639:0>)
  contract from: (function sub2)
  blaming: (function sub2)
   (assuming the contract is correct)
  at: eval:42:0
> (: add2 (-> integer? integer?))
> (define (add2 x)
    (+ x 2))
> (add2 1.5)
3.5
> ((exercise-option add2) 1.5)
add2: contract violation
  expected: integer?
  given: 1.5
  in: the 1st argument of
      the option of
      (option/c
       (-> integer? integer?)
       #:tester
       #<procedure:...arrow-val-first.rkt:1639:0>)
  contract from: (function add2)
  blaming: top-level
   (assuming the contract is correct)
  at: eval:44:0