diff --git a/racket/syndicate/examples/actor/two-buyer-protocol.rkt b/racket/syndicate/examples/actor/two-buyer-protocol.rkt new file mode 100644 index 0000000..266dda2 --- /dev/null +++ b/racket/syndicate/examples/actor/two-buyer-protocol.rkt @@ -0,0 +1,253 @@ +#lang syndicate +;; An extended two-buyer book-purchase protocol, based loosely on that +;; given in Honda/Yoshida/Carbone 2008, "Multiparty Asynchronous +;; Session Types". + +;; SAMPLE OUTPUT: +;;--------------------------------------------------------------------------- +;; A learns that the price of "Catch 22" is 2.22 +;; A makes an offer to split the price of "Catch 22", contributing 1.11 +;; B is being asked to contribute 1.11 toward "Catch 22" at price 2.22 +;; B accepts the offer, leaving them with 3.8899999999999997 remaining funds +;; A learns that the split-proposal for "Catch 22" was accepted +;; The order for "Catch 22" has id 10001483, and will be delivered on March 9th +;; A learns that "Encyclopaedia Brittannica" is out-of-stock. +;; A learns that the price of "Candide" is 34.95 +;; A makes an offer to split the price of "Candide", contributing 17.475 +;; B is being asked to contribute 17.475 toward "Candide" at price 34.95 +;; B hasn't enough funds (3.8899999999999997 remaining) +;; A learns that the split-proposal for "Candide" was rejected +;; A makes an offer to split the price of "Candide", contributing 26.212500000000002 +;; B is being asked to contribute 8.7375 toward "Candide" at price 34.95 +;; B hasn't enough funds (3.8899999999999997 remaining) +;; A learns that the split-proposal for "Candide" was rejected +;; A makes an offer to split the price of "Candide", contributing 30.581250000000004 +;; B is being asked to contribute 4.368749999999999 toward "Candide" at price 34.95 +;; B hasn't enough funds (3.8899999999999997 remaining) +;; A learns that the split-proposal for "Candide" was rejected +;; A makes an offer to split the price of "Candide", contributing 32.765625 +;; B is being asked to contribute 2.184375000000003 toward "Candide" at price 34.95 +;; B accepts the offer, leaving them with 1.7056249999999968 remaining funds +;; A learns that the split-proposal for "Candide" was accepted +;; The order for "Candide" has id 10001484, and will be delivered on March 9th +;; A learns that the price of "The Wind in the Willows" is 3.95 +;; A makes an offer to split the price of "The Wind in the Willows", contributing 1.975 +;; B is being asked to contribute 1.975 toward "The Wind in the Willows" at price 3.95 +;; B hasn't enough funds (1.7056249999999968 remaining) +;; A learns that the split-proposal for "The Wind in the Willows" was rejected +;; A makes an offer to split the price of "The Wind in the Willows", contributing 2.9625000000000004 +;; B is being asked to contribute 0.9874999999999998 toward "The Wind in the Willows" at price 3.95 +;; B accepts the offer, leaving them with 0.718124999999997 remaining funds +;; A learns that the split-proposal for "The Wind in the Willows" was accepted +;; A has bought everything they wanted! +;; The order for "The Wind in the Willows" has id 10001485, and will be delivered on March 9th +;;--------------------------------------------------------------------------- + +(require syndicate/actor) + +;; Role: SELLER +;; - when interest in (book-quote $title _) appears, +;; asserts (book-quote title (Option Float)), #f meaning not available, +;; and otherwise an asking-price. +;; - when interest in (order $title $offer-price _ _) appears, +;; asserts (order title offer-price #f #f) for "no sale", otherwise +;; (order title offer-price PositiveInteger String), an accepted sale. + +;; Role: BUYER +;; - observes (book-quote title $price) to learn prices. +;; - observes (order title offer-price $id $delivery-date) to make orders. + +;; Role: SPLIT-PROPOSER +;; - observes (split-proposal title asking-price contribution $accepted?) +;; to make a split-proposal and learn whether it was accepted or not. + +;; Role: SPLIT-DISPOSER +;; - when interest in (split-proposal $title $asking-price $contribution _) +;; appears, asserts (split-proposal title asking-price contribution #t) +;; to indicate they are willing to go through with the deal, in which case +;; they then perform the role of BUYER for title/asking-price, or asserts +;; (split-proposal title asking-price contribution #f) to indicate they +;; are unwilling to go through with the deal. + +(struct book-quote (title price) #:prefab) ;; Assertion +(struct order (title price id delivery-date) #:prefab) ;; Assertion + +(struct split-proposal (title price contribution accepted) #:prefab) ;; Assertion + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Utility syntax. Under consideration for possible addition to actor.rkt. +;; +(define-syntax while-relevant-assert + (syntax-rules () + [(_ P) + (until (retracted (observe P)) + (assert P))])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; SELLER +;; +(define (seller) + (actor (forever #:collect [(books (hash "The Wind in the Willows" 3.95 + "Catch 22" 2.22 + "Candide" 34.95)) + (next-order-id 10001483)] + + ;; Give quotes to interested parties. + ;; + (during (observe (book-quote $title _)) + (assert (book-quote title (hash-ref books title #f)))) + + ;; Respond to order requests. + ;; + (on (asserted (observe (order $title $offer-price _ _))) + (define asking-price (hash-ref books title #f)) + (cond + + [(or (not asking-price) (< offer-price asking-price)) + ;; We cannot sell a book we do not have, and we will not sell for less + ;; than our asking price. + ;; + (while-relevant-assert (order title offer-price #f #f))] + + [else + ;; Tell the ordering party their order ID and delivery date. + ;; + (actor + (while-relevant-assert + (order title offer-price next-order-id "March 9th"))) + + ;; Remove the book from our shelves, and increment our order ID. + ;; + (values (hash-remove books title) (+ next-order-id 1))]))))) + +;; Serial SPLIT-PROPOSER +;; +(define (buyer-a) + + ;; Attempt to entice some SPLIT-DISPOSER to purchase each title in titles, one after another. + ;; + (define (try-to-buy titles) + (match titles + ['() + (log-info "A has bought everything they wanted!")] + [(cons title remaining-titles) + + ;; First, retrieve a quote for the title, and analyze the result. + ;; + (match (state [] [(asserted (book-quote title $price)) price]) + [#f + (log-info "A learns that ~v is out-of-stock." title) + (try-to-buy remaining-titles)] + + [price + (log-info "A learns that the price of ~v is ~a" title price) + + ;; Next, repeatedly make split offers to a SPLIT-DISPOSER until either one is + ;; accepted, or the contribution from the SPLIT-DISPOSER becomes pointlessly small. + ;; + (let try-to-split ((contribution (/ price 2))) + (log-info "A makes an offer to split the price of ~v, contributing ~a" + title + contribution) + (cond + [(> contribution (- price 0.10)) + ;; Not worth bothering to split the price. May as well buy it ourselves. + ;; TODO: could perform BUYER here + ;; + (log-info "A gives up on ~v." title) + (try-to-buy remaining-titles)] + + [else + ;; Make our proposal, and wait for a response. + ;; SEE NOTE (A). + ;; + (match (state [] [(asserted (split-proposal title price contribution $accepted?)) + accepted?]) + [#t + (log-info "A learns that the split-proposal for ~v was accepted" title) + (try-to-buy remaining-titles)] + [#f + (log-info "A learns that the split-proposal for ~v was rejected" title) + ;; Offer to contribute a little more. + (try-to-split (+ contribution (/ (- price contribution) 2)))])]))])])) + + ;; NOTE (A): Wrote this originally where the anchor to this note is found. The code here + ;; doesn't release assertions properly; we fall foul of the "run the continuation clauses + ;; while the subscriptions are still active" property of the current actor.rkt + ;; implementation. + ;; + ;; (state [] + ;; [(asserted (split-proposal title price contribution #t)) + ;; (log-info "A learns that the split-proposal for ~v was accepted" title) + ;; (try-to-buy remaining-titles)] + ;; [(asserted (split-proposal title price contribution #f)) + ;; (log-info "A learns that the split-proposal for ~v was rejected" title) + ;; (try-to-split (+ contribution (/ (- price contribution) 2)))]) + ;; + + (actor (try-to-buy (list "Catch 22" + "Encyclopaedia Brittannica" + "Candide" + "The Wind in the Willows")))) + +;; Serial SPLIT-DISPOSER +;; +(define (buyer-b) + (actor (forever + + ;; This actor maintains a record of the amount of money it has to spend. + ;; + #:collect [(funds 5.00)] + + (on (asserted (observe (split-proposal $title $price $their-contribution _))) + + (define my-contribution (- price their-contribution)) + (log-info "B is being asked to contribute ~a toward ~v at price ~a" + my-contribution + title + price) + + (cond + [(> my-contribution funds) + (log-info "B hasn't enough funds (~a remaining)" funds) + (while-relevant-assert (split-proposal title price their-contribution #f))] + + [else + + ;; Spawn a small actor (TODO: when we revise actor.rkt's implementation style, + ;; this could perhaps be a facet rather than a full actor) to handle the + ;; actual purchase now that we have agreed on a split. + ;; + (actor (define-values (order-id delivery-date) + (state + [;; While we are in this state, waiting for order confirmation, take + ;; the opportunity to signal to our SPLIT-PROPOSER that we accepted + ;; their proposal. + ;; + (assert (split-proposal title price their-contribution #t))] + [(asserted (order title price $id $date)) + ;; We have received order confirmation from the SELLER. + ;; + (values id date)])) + (log-info "The order for ~v has id ~a, and will be delivered on ~a" + title + order-id + delivery-date)) + + ;; Meanwhile, update our records of our available funds, and continue to wait + ;; for more split-proposals to arrive. + ;; + (define remaining-funds (- funds my-contribution)) + (log-info "B accepts the offer, leaving them with ~a remaining funds" + remaining-funds) + remaining-funds]))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Starting configuration: +;; +(seller) +(buyer-a) +(buyer-b)