On this page:
14.6.1 Adding Contracts to Signatures
14.6.2 Adding Contracts to Units

14.6 Contracts for Units

There are a couple of ways of protecting units with contracts. One way is useful when writing new signatures, and the other handles the case when a unit must conform to an already existing signature.

14.6.1 Adding Contracts to Signatures

When contracts are added to a signature, then all units which implement that signature are protected by those contracts. The following version of the toy-factory^ signature adds the contracts previously written in comments:

"contracted-toy-factory-sig.rkt"

#lang racket
 
(define-signature contracted-toy-factory^
  ((contracted
    [build-toys (-> integer? (listof toy?))]
    [repaint    (-> toy? symbol? toy?)]
    [toy?       (-> any/c boolean?)]
    [toy-color  (-> toy? symbol?)])))
 
(provide contracted-toy-factory^)

Now we take the previous implementation of simple-factory@ and implement this version of toy-factory^ instead:

"contracted-simple-factory-unit.rkt"

#lang racket
 
(require "contracted-toy-factory-sig.rkt")
 
(define-unit contracted-simple-factory@
  (import)
  (export contracted-toy-factory^)
 
  (printf "Factory started.\n")
 
  (struct toy (color) #:transparent)
 
  (define (build-toys n)
    (for/list ([i (in-range n)])
      (toy 'blue)))
 
  (define (repaint t col)
    (toy col)))
 
(provide contracted-simple-factory@)

As before, we can invoke our new unit and bind the exports so that we can use them. This time, however, misusing the exports causes the appropriate contract errors.

> (require "contracted-simple-factory-unit.rkt")
> (define-values/invoke-unit/infer contracted-simple-factory@)

Factory started.

> (build-toys 3)

(list (toy 'blue) (toy 'blue) (toy 'blue))

> (build-toys #f)

build-toys: contract violation

  expected: integer?

  given: #f

  in: the 1st argument of

      (-> integer? (listof toy?))

  contract from:

      (unit contracted-simple-factory@)

  blaming: top-level

   (assuming the contract is correct)

  at: eval:34.0

> (repaint 3 'blue)

repaint: contract violation

  expected: toy?

  given: 3

  in: the 1st argument of

      (-> toy? symbol? toy?)

  contract from:

      (unit contracted-simple-factory@)

  blaming: top-level

   (assuming the contract is correct)

  at: eval:34.0

14.6.2 Adding Contracts to Units

However, sometimes we may have a unit that must conform to an already existing signature that is not contracted. In this case, we can create a unit contract with unit/c or use the define-unit/contract form, which defines a unit which has been wrapped with a unit contract.

For example, here’s a version of toy-factory@ which still implements the regular toy-factory^, but whose exports have been protected with an appropriate unit contract.

"wrapped-simple-factory-unit.rkt"

#lang racket
 
(require "toy-factory-sig.rkt")
 
(define-unit/contract wrapped-simple-factory@
  (import)
  (export (toy-factory^
           [build-toys (-> integer? (listof toy?))]
           [repaint    (-> toy? symbol? toy?)]
           [toy?       (-> any/c boolean?)]
           [toy-color  (-> toy? symbol?)]))
 
  (printf "Factory started.\n")
 
  (struct toy (color) #:transparent)
 
  (define (build-toys n)
    (for/list ([i (in-range n)])
      (toy 'blue)))
 
  (define (repaint t col)
    (toy col)))
 
(provide wrapped-simple-factory@)
> (require "wrapped-simple-factory-unit.rkt")
> (define-values/invoke-unit/infer wrapped-simple-factory@)

Factory started.

> (build-toys 3)

(list (toy 'blue) (toy 'blue) (toy 'blue))

> (build-toys #f)

wrapped-simple-factory@: contract violation

  expected: integer?

  given: #f

  in: the 1st argument of

      (unit/c

       (import)

       (export (toy-factory^

                (build-toys

                 (-> integer? (listof toy?)))

                (repaint (-> toy? symbol? toy?))

                (toy? (-> any/c boolean?))

                (toy-color (-> toy? symbol?))))

       (init-depend))

  contract from:

      (unit wrapped-simple-factory@)

  blaming: top-level

   (assuming the contract is correct)

  at: <collects>/racket/unit.rkt

> (repaint 3 'blue)

wrapped-simple-factory@: contract violation

  expected: toy?

  given: 3

  in: the 1st argument of

      (unit/c

       (import)

       (export (toy-factory^

                (build-toys

                 (-> integer? (listof toy?)))

                (repaint (-> toy? symbol? toy?))

                (toy? (-> any/c boolean?))

                (toy-color (-> toy? symbol?))))

       (init-depend))

  contract from:

      (unit wrapped-simple-factory@)

  blaming: top-level

   (assuming the contract is correct)

  at: <collects>/racket/unit.rkt