Notes from Lecture 3 -- Protocols of interaction

Notes from Lecture 3 – Protocols of interaction

Behavioral interfaces subsume syntactic interfaces but they are 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 cell that only a contract has access to and that some pieces of the contract set and others check its value. 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: In fact research in programming languages and contracts has shown that we can do better.

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

Similar as for the behavioral contract, we can instantiate fixed-apple% and attach to the resulting object 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)

that 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

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?)
      (let ([result
             (>= offer-expiration (date->seconds (current-date)))])
        (if (boolean? result)
            (begin
              (set! can-call-value-with-discount? #t)
              result)
            (raise "assertion violation: method doesn't live up to its promises"))))

    (define/public (value)
      (let ([result
             (* quantity-in-pounds  price-per-pound-in-dollars)])
        (if (number? result)
            result
            (raise "assertion violation: method doesn't live up to its promises"))))

    (define/public (value-with-discount)
      (let ([result
             (+ (value) (* (value) discount))])
        (if (number? result)
            (if can-call-value-with-discount?
                (begin
                  (set! can-call-value-with-discount? #f)
                  result)
                (raise "protocol assertion violation: cannot call method at this point"))
            (raise "assertion violation: method doesn't live up to its promises"))))))

> (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 for behavioral contracts to refactor the code:

(define (check-with-protocol property check-protocol update-protocol x msg protocol-msg)
  (if (property x)
      (if (check-protocol)
          (begin (update-protocol) x)
          (raise protocol-msg))
      (raise msg)))

(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