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) | ||||
| ||||
| ||||
| ||||
| ||||
| ||||
wrapped-simple-factory@; expected <integer?>, given: #f | ||||
| > (repaint 3 'blue) | ||||
| ||||
| ||||
| ||||
| ||||
| ||||
wrapped-simple-factory@; expected <toy?>, given: 3 |