Notes from lecture 3 – Protocols of interaction

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)))]))

Like the behavioral contract, we can instantiate fixed-apple% and attach a protocol contract created by make-protocol-apple/c:
(define/contract a-fixed-apple-with-a-protocol
  (make-protocol-apple/c)
  (new fixed-apple%
       [quantity-in-pounds 6]))

Invoking value-with-discount without first invoking has-discount? results in a contract violation:
> (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)

The violation disappears if we first invoke has-discount?:
> (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