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

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:

  ; In "contracted-toy-factory-sig.ss":
  #lang scheme
  
  (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:

  ; In "contracted-simple-factory-unit.ss":
  #lang scheme
  
  (require "contracted-toy-factory-sig.ss")
  
  (define-unit contracted-simple-factory@
    (import)
    (export contracted-toy-factory^)
  
    (printf "Factory started.\n")
  
    (define-struct toy (color) #:transparent)
  
    (define (build-toys n)
      (for/list ([i (in-range n)])
        (make-toy 'blue)))
  
    (define (repaint t col)
      (make-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.ss")
  > (define-values/invoke-unit/infer contracted-simple-factory@)

  Factory started.

  > (build-toys 3)

  (#(struct:toy blue) #(struct:toy blue) #(struct:toy blue))

  > (build-toys #f)

  top-level broke the contract (-> integer? (listof toy?)) on

  build-toys; expected <integer?>, given: #f

  > (repaint 3 'blue)

  top-level broke the contract (-> toy? symbol? toy?) on

  repaint; expected <toy?>, given: 3

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.

  ; In "wrapped-simple-factory-unit.ss":
  #lang scheme
  
  (require "toy-factory-sig.ss")
  
  (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")
  
    (define-struct toy (color) #:transparent)
  
    (define (build-toys n)
      (for/list ([i (in-range n)])
        (make-toy 'blue)))
  
    (define (repaint t col)
      (make-toy col)))
  
  (provide contracted-simple-factory@)

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

  Factory started.

  > (build-toys 3)

  (#(struct:toy blue) #(struct:toy blue) #(struct:toy blue))

  > (build-toys #f)

  top-level broke the contract

    (unit/c

     (import)

    

  (export (toy-factory^

              (build-toys

              

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

              (repaint (-> toy?

  symbol? toy?))

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

       

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

   on

  wrapped-simple-factory@; expected <integer?>, given: #f

  > (repaint 3 'blue)

  top-level broke the contract

    (unit/c

     (import)

    

  (export (toy-factory^

              (build-toys

              

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

              (repaint (-> toy?

  symbol? toy?))

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

       

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

   on

  wrapped-simple-factory@; expected <toy?>, given: 3