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") (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.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") (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 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