Notes from lecture 3 – Protocols of interaction
Even though behavioral interfaces subsume syntactic interfaces, they are still not as expressive as needed in many scenarios. For instance, they fall short of describing the order in which the methods of an object should be called. Such specifications, dubbed protocols of interaction, are very common restrictions on the way components interact with their clients that show up in many programming domains from implementing an IDE to building the server-side of a web app by composing microservices (see Netflix).
Unfortunately, even Racket’s contract system is not powerful enough to express protocols directly. We can though fake it with the use of shadow state, i.e., a small piece of memory that only a contract has access to, where some pieces of the contract store information and others check. For example, returning to our grocery store running example from lecture 2, if we want to specify a protocol for fixed-apple% that prescribes that an invocation of value-with-discount is valid only if we first invoke has-discount?, we can create a mutable cell flag that is only visible to the contract (thus we define a constructor function that creates a fresh cell for each contract it constructs) and then add post-conditions to has-discount? and value-with-discount that set and/or inspect flag accordingly:
(define (make-protocol-apple/c) (define flag (box #f)) (object/c [has-discount? (->i ([this (is-a?/c product<%>)]) (result boolean?) #:post () (set-box! flag #t))] [value (-> (is-a?/c product<%>) positive?)] [value-with-discount (->i ([this (is-a?/c product<%>)]) (result (this) (<=/c (send this value))) #:post () (and (unbox flag) (set-box! flag #f)))]))
(define/contract a-fixed-apple-with-a-protocol (make-protocol-apple/c) (new fixed-apple% [quantity-in-pounds 6]))
> (send a-fixed-apple-with-a-protocol value-with-discount) value-with-discount: broke its own contract
#:post condition violation
blaming: (definition a-fixed-apple-with-a-protocol)
(assuming the contract is correct)
> (send a-fixed-apple-with-a-protocol has-discount?) #t
> (send a-fixed-apple-with-a-protocol value-with-discount) 16.2
In fact research in programming languages and contracts has shown that we can do better than subtle encoding of protocols as imperative behavioral contracts.
For languages that do not support contracts, we can play the same trick as for behavioral contracts and use assertions. As a replacement for the shadow state we can use a private field such as can-call-value-with-discount? below:
(define apple+protocol-assertions% (class* object% (product<%>) (super-new) (init-field quantity-in-pounds) (field [price-per-pound-in-dollars 3] [discount -0.1] [offer-expiration 100000000000]) (define can-call-value-with-discount? #f) (define/public (has-discount?) (define result (>= offer-expiration (date->seconds (current-date)))) (unless (boolean? result) (raise "assertion violation: method doesn't live up to its promises")) (set! can-call-value-with-discount? #t) result) (define/public (value) (define result (* quantity-in-pounds price-per-pound-in-dollars)) (unless (number? result) (raise "assertion violation: method doesn't live up to its promises")) result) (define/public (value-with-discount) (define result (+ (value) (* (value) discount))) (unless (number? result) (raise "assertion violation: method doesn't live up to its promises")) (unless can-call-value-with-discount? (raise "protocol assertion violation: cannot call method at this point")) (set! can-call-value-with-discount? #f) result)))
> (define another-kind-of-apple-with-a-protocol (new apple+protocol-assertions% [quantity-in-pounds 6])) > (send another-kind-of-apple-with-a-protocol value-with-discount) uncaught exception: "protocol assertion violation: cannot
call method at this point"
> (send another-kind-of-apple-with-a-protocol has-discount?) #t
> (send another-kind-of-apple-with-a-protocol value-with-discount) 16.2
And of course, we can play again here the same tricks as we did with behavioral contracts to refactor the code:
(define (check-with-protocol property check-protocol update-protocol x msg protocol-msg) (unless (property x) (raise msg)) (unless (check-protocol) (raise protocol-msg)) (update-protocol) x)
(define apple-protocol-contract-wrapper% (class* object% (product<%>) (super-new) (init-field inner-apple) (define can-call-value-with-discount? #f) (define/public (has-discount?) (check-with-protocol boolean? (λ () #t) (thunk (set! can-call-value-with-discount? #t)) (send inner-apple has-discount?) "assertion violation: method doesn't live up to its promises" "unreachable")) (define/public (value) (check-with-protocol positive? (λ () #t) values (send inner-apple value) "assertion violation: method doesn't live up to its promises" "unreachable")) (define/public (value-with-discount) (check-with-protocol (λ (result) (and (number? result) (<= result (send inner-apple value)))) (thunk can-call-value-with-discount?) (thunk (set! can-call-value-with-discount? #f)) (send inner-apple value-with-discount) "assertion violation: method doesn't live up to its promises" "protocol assertion violation: cannot call method at this point"))))
> (define yet-another-kind-of-apple-with-a-protocol (new apple-protocol-contract-wrapper% [inner-apple (new fixed-apple% [quantity-in-pounds 6])])) > (send yet-another-kind-of-apple-with-a-protocol value-with-discount) uncaught exception: "protocol assertion violation: cannot
call method at this point"
> (send yet-another-kind-of-apple-with-a-protocol has-discount?) #t
> (send yet-another-kind-of-apple-with-a-protocol value-with-discount) 16.2