On this page:
make-proj-contract
build-compound-type-name
coerce-contract
flat-contract/ predicate?
raise-contract-error
Version: 4.1

7.5 Building New Contract Combinators

Contracts are represented internally as functions that accept information about the contract (who is to blame, source locations, etc) and produce projections (in the spirit of Dana Scott) that enforce the contract. A projection is a function that accepts an arbitrary value, and returns a value that satisfies the corresponding contract. For example, a projection that accepts only integers corresponds to the contract (flat-contract integer?), and can be written like this:

  (define int-proj

    (lambda (x)

      (if (integer? x)

          x

          (signal-contract-violation))))

As a second example, a projection that accepts unary functions on integers looks like this:

  (define int->int-proj

    (lambda (f)

      (if (and (procedure? f)

               (procedure-arity-includes? f 1))

          (lambda (x)

            (int-proj (f (int-proj x))))

          (signal-contract-violation))))

Although these projections have the right error behavior, they are not quite ready for use as contracts, because they do not accomodate blame, and do not provide good error messages. In order to accomodate these, contracts do not just use simple projections, but use functions that accept the names of two parties that are the candidates for blame, as well as a record of the source location where the contract was established and the name of the contract. They can then, in turn, pass that information to raise-contract-error to signal a good error message (see below for details on its behavior).

Here is the first of those two projections, rewritten for use in the contract system:

  (define (int-proj pos neg src-info name)

    (lambda (x)

      (if (integer? x)

          x

          (raise-contract-error

           val

           src-info

           pos

           name

           "expected <integer>, given: ~e"

           val))))

The first two new arguments specify who is to be blamed for positive and negative contract violations, respectively. Contracts, in this system, are always established between two parties. One party provides some value according to the contract, and the other consumes the value, also according to the contract. The first is called the “positive” person and the second the “negative”. So, in the case of just the integer contract, the only thing that can go wrong is that the value provided is not an integer. Thus, only the positive argument can ever accrue blame (and thus only pos is passed to raise-contract-error).

Compare that to the projection for our function contract:

  (define (int->int-proj pos neg src-info name)

    (let ([dom (int-proj neg pos src-info name)]

          [rng (int-proj pos neg src-info name)])

      (lambda (f)

        (if (and (procedure? f)

                 (procedure-arity-includes? f 1))

            (lambda (x)

              (rng (f (dom x))))

            (raise-contract-error

             val

             src-info

             pos

             name

             "expected a procedure of one argument, given: ~e"

             val)))))

In this case, the only explicit blame covers the situation where either a non-procedure is supplied to the contract, or where the procedure does not accept one argument. As with the integer projection, the blame here also lies with the producer of the value, which is why raise-contract-error gets pos and not neg as its argument.

The checking for the domain and range are delegated to the int-proj function, which is supplied its arguments in the first two line of the int->int-proj function. The trick here is that, even though the int->int-proj function always blames what it sees as positive we can reverse the order of the pos and neg arguments so that the positive becomes the negative.

This is not just a cheap trick to get this example to work, however. The reversal of the positive and the negative is a natural consequence of the way functions behave. That is, imagine the flow of values in a program between two modules. First, one module defines a function, and then that module is required by another. So, far the function itself has to go from the original, providing module to the requiring module. Now, imagine that the providing module invokes the function, suppying it an argument. At this point, the flow of values reverses. The argument is travelling back from the requiring module to the providing module! And finally, when the function produces a result, that result flows back in the original direction. Accordingly, the contract on the domain reverses the positive and the negative, just like the flow of values reverses.

We can use this insight to generalize the function contracts and build a function that accepts any two contracts and returns a contract for functions between them.

  (define (make-simple-function-contract dom-proj range-proj)

    (lambda (pos neg src-info name)

      (let ([dom (dom-proj neg pos src-info name)]

            [rng (range-proj pos neg src-info name)])

        (lambda (f)

          (if (and (procedure? f)

                   (procedure-arity-includes? f 1))

              (lambda (x)

                (rng (f (dom x))))

              (raise-contract-error

               val

               src-info

               pos

               name

               "expected a procedure of one argument, given: ~e"

               val))))))

Projections like the ones described above, but suited to other, new kinds of value you might make, can be used with the contract library primitives below.

(make-proj-contract

 

name

 

 

 

 

 

 

proj

 

 

 

 

 

 

first-order-test)

 

 

contract?

  name : any/c

  proj : (symbol? symbol? any/c any/c . -> . any/c)

  first-order-test : (any/c . -> . any/c)

The simplest way to build a contract. It can be less efficient than using other contract constructors described below, but it is the right choice for new contract constructors or first-time contract builders.

The first argument is the name of the contract. It can be an arbitrary S-expression. The second is a projection (see above).

The final argument is a predicate that is a conservative, first-order test of a value. It should be a function that accepts one argument and returns a boolean. If it returns #f, its argument must be guaranteed to fail the contract, and the contract should detect this right when the projection is invoked. If it returns true, the value may or may not violate the contract, but any violations must not be signaled immediately.

From the example above, the predicate should accept unary functions, but reject all other values.

(build-compound-type-name c/s ...)  any

  c/s : any/c

Produces an S-expression to be used as a name for a contract. The arguments should be either contracts or symbols. It wraps parenthesis around its arguments and extracts the names from any contracts it is supplied with.

(coerce-contract id expr)

Evaluates expr and, if the result is a contract, just returns it. If the result is a procedure of arity one, it converts that into a contract. If the result is neither, it signals an error, using the first argument in the error message. The message says that a contract or a procedure of arity one was expected.

(flat-contract/predicate? val)  boolean?

  val : any/c

A predicate that indicates when coerce-contract will fail.

(raise-contract-error

 

val

 

 

 

 

 

 

src-info

 

 

 

 

 

 

to-blame

 

 

 

 

 

 

contract-name

 

 

 

 

 

 

fmt

 

 

 

 

 

 

arg ...)

 

 

any

  val : any/c

  src-info : any/c

  to-blame : symbol?

  contract-name : any/c

  fmt : string?

  arg : any/c

Signals a contract violation. The first argument is the value that failed to satisfy the contract. The second argument is is the src-info passed to the projection and the third should be either pos or neg (typically pos, see the beginning of this section) that was passed to the projection. The fourth argument is the contract-name that was passed to the projection and the remaining arguments are used with format to build an actual error message.