Hide legacy typed/syndicate #lang, consolidate to the "roles" version

2021-04-22 12:04:06 -04:00 · 2021-04-22 12:04:06 -04:00 · c3559f1611
parent 8b67d0ba03
commit c3559f1611
53 changed files with 193 additions and 398 deletions
--- a/racket/typed/examples/bank-account.rkt
+++ b/racket/typed/examples/bank-account.rkt
@ -1,14 +1,19 @@
 #lang typed/syndicate

+;; Expected Output
+;; 0
+;; 70
+;; #f
+
 (define-constructor (account balance)
  #:type-constructor AccountT
  #:with Account (AccountT Int)
-  #:with AccountRequest (AccountT ★))
+  #:with AccountRequest (AccountT ★/t))

 (define-constructor (deposit amount)
  #:type-constructor DepositT
  #:with Deposit (DepositT Int)
-  #:with DepositRequest (DepositT ★))
+  #:with DepositRequest (DepositT ★/t))

 (define-type-alias ds-type
  (U Account
@ -18,45 +23,43 @@
     (Observe DepositRequest)
     (Observe (Observe DepositRequest))))

-(dataspace ds-type
+(define-type-alias account-manager-role
+  (Role (account-manager)
+        (Shares Account)
+        (Reacts (Asserted Deposit))))

-           (spawn ds-type
-                  (facet _
-                         (fields [balance Int 0])
-                         (assert (account (ref balance)))
-                         (on (asserted (deposit (bind amount Int)))
-                             (set! balance (+ (ref balance) amount)))))
+(define-type-alias client-role
+  (Role (client)
+        (Reacts (Asserted Account))))

-           (spawn ds-type
-                  (facet _
-                         (fields)
-                         (on (asserted (account (bind amount Int)))
-                             (displayln amount))))

-           (spawn ds-type
-                  (facet _
-                         (fields)
-                         (on (asserted (observe (deposit discard)))
-                               (facet _
-                                      (fields)
-                                      (assert (deposit 100))
-                                      (assert (deposit -30)))))))
+(run-ground-dataspace ds-type

-#|
-;; Hello-worldish "bank account" example.
+  (spawn ds-type
+    (lift+define-role acct-mngr-role
+    (start-facet account-manager
+      (field [balance Int 0])
+      (assert (account (ref balance)))
+      (on (asserted (deposit (bind amount Int)))
+          (set! balance (+ (ref balance) amount))))))

-(struct account (balance) #:prefab)
-(struct deposit (amount) #:prefab)
+  (spawn ds-type
+    (lift+define-role obs-role
+    (start-facet observer
+      (on (asserted (account (bind amount Int)))
+          (displayln amount)))))

-(spawn (field [balance 0])
-       (assert (account (balance)))
-       (on (message (deposit $amount))
-           (balance (+ (balance) amount))))
+  (spawn ds-type
+    (lift+define-role buyer-role
+    (start-facet buyer
+      (on (asserted (observe (deposit discard)))
+          (start-facet deposits
+            (assert (deposit 100))
+            (assert (deposit -30))))))))

-(spawn (on (asserted (account $balance))
-           (printf "Balance changed to ~a\n" balance)))
-
-(spawn* (until (asserted (observe (deposit _))))
-        (send! (deposit +100))
-        (send! (deposit -30)))
-|#
+(module+ test
+  (check-simulates acct-mngr-role account-manager-role)
+  (check-simulates obs-role client-role)
+  ;; Tried to write this, then it failed, I looked and buyer doesn't actually implement that spec
+  #;(check-simulates buyer-role client-role)
+  )
--- a/racket/typed/examples/roles/book-club.rkt
+++ b/racket/typed/examples/roles/book-club.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output
 ;; leader learns that there are 5 copies of The Wind in the Willows
--- a/racket/typed/examples/roles/cell.rkt
+++ b/racket/typed/examples/roles/cell.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; adapted from section 8.3 of Tony's dissertation

--- a/racket/typed/examples/roles/chat-tcp2.rkt
+++ b/racket/typed/examples/roles/chat-tcp2.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require typed/syndicate/drivers/tcp)

--- a/racket/typed/examples/roles/file-system.rkt
+++ b/racket/typed/examples/roles/file-system.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (define-constructor (file name content)
  #:type-constructor FileT
--- a/racket/typed/examples/roles/flink-support.rkt
+++ b/racket/typed/examples/roles/flink-support.rkt
--- a/racket/typed/examples/roles/flink.rkt
+++ b/racket/typed/examples/roles/flink.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; ---------------------------------------------------------------------------------------------------
 ;; Protocol
@ -550,8 +550,8 @@ The JobManager then performs the job and, when finished, asserts
  (spawn-client (string->job INPUT)))

 (module+ test
-  (verify-actors (Eventually (A (JobCompletion ID (List InputTask) TaskResult)))
-                 #;(Always (Implies (A (Observe (JobCompletion ID (List InputTask) ★/t)))
+  #;(verify-actors #;(Eventually (A (JobCompletion ID (List InputTask) TaskResult)))
+                 (Always (Implies (A (Observe (JobCompletion ID (List InputTask) ★/t)))
                                  (Eventually (A (JobCompletion ID (List InputTask) TaskResult)))))
                 job-manager-impl
                 task-manager-impl
@ -570,3 +570,7 @@ The JobManager then performs the job and, when finished, asserts
  (check-has-simulating-subgraph task-manager-impl TaskPerformer)
  (check-has-simulating-subgraph task-manager-impl TaskAssigner)
  (check-has-simulating-subgraph job-manager-impl TaskAssigner))
+
+;; infinite loop?
+#;(module+ test
+  (check-simulates job-manager-impl job-manager-impl))
--- a/racket/typed/examples/roles/internal-knowledge.rkt
+++ b/racket/typed/examples/roles/internal-knowledge.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output:
 #|
--- a/racket/typed/examples/roles/ping-pong.rkt
+++ b/racket/typed/examples/roles/ping-pong.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output
 ;; pong: 8339
--- a/racket/typed/examples/roles/provides.rkt
+++ b/racket/typed/examples/roles/provides.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (provide a-fun)

--- a/racket/typed/examples/roles/realize.rkt
+++ b/racket/typed/examples/roles/realize.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output:
 #|
--- a/racket/typed/examples/roles/require-struct/client.rkt
+++ b/racket/typed/examples/roles/require-struct/client.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require-struct msg #:as Msg
                #:from "driver.rkt")
--- a/racket/typed/examples/roles/require-struct/driver.rkt
+++ b/racket/typed/examples/roles/require-struct/driver.rkt
--- a/racket/typed/examples/require:typed/client.rkt
+++ b/racket/typed/examples/require:typed/client.rkt
@ -0,0 +1,5 @@
+#lang typed/syndicate
+
+(require/typed "lib.rkt" [x : Int])
+
+(displayln (+ x 1))
--- a/racket/typed/examples/roles/require:typed/lib.rkt
+++ b/racket/typed/examples/roles/require:typed/lib.rkt
--- a/racket/typed/examples/requires.rkt
+++ b/racket/typed/examples/requires.rkt
@ -0,0 +1,5 @@
+#lang typed/syndicate
+
+(require "provides.rkt")
+
+(a-fun 5)
--- a/racket/typed/examples/roles/bank-account.rkt
+++ b/racket/typed/examples/roles/bank-account.rkt
@ -1,65 +0,0 @@
-#lang typed/syndicate/roles
-
-;; Expected Output
-;; 0
-;; 70
-;; #f
-
-(define-constructor (account balance)
-  #:type-constructor AccountT
-  #:with Account (AccountT Int)
-  #:with AccountRequest (AccountT ★/t))
-
-(define-constructor (deposit amount)
-  #:type-constructor DepositT
-  #:with Deposit (DepositT Int)
-  #:with DepositRequest (DepositT ★/t))
-
-(define-type-alias ds-type
-  (U Account
-     (Observe AccountRequest)
-     (Observe (Observe AccountRequest))
-     Deposit
-     (Observe DepositRequest)
-     (Observe (Observe DepositRequest))))
-
-(define-type-alias account-manager-role
-  (Role (account-manager)
-        (Shares Account)
-        (Reacts (Asserted Deposit))))
-
-(define-type-alias client-role
-  (Role (client)
-        (Reacts (Asserted Account))))
-
-
-(run-ground-dataspace ds-type
-
-  (spawn ds-type
-    (lift+define-role acct-mngr-role
-    (start-facet account-manager
-      (field [balance Int 0])
-      (assert (account (ref balance)))
-      (on (asserted (deposit (bind amount Int)))
-          (set! balance (+ (ref balance) amount))))))
-
-  (spawn ds-type
-    (lift+define-role obs-role
-    (start-facet observer
-      (on (asserted (account (bind amount Int)))
-          (displayln amount)))))
-
-  (spawn ds-type
-    (lift+define-role buyer-role
-    (start-facet buyer
-      (on (asserted (observe (deposit discard)))
-          (start-facet deposits
-            (assert (deposit 100))
-            (assert (deposit -30))))))))
-
-(module+ test
-  (check-simulates acct-mngr-role account-manager-role)
-  (check-simulates obs-role client-role)
-  ;; Tried to write this, then it failed, I looked and buyer doesn't actually implement that spec
-  #;(check-simulates buyer-role client-role)
-  )
--- a/racket/typed/examples/roles/require:typed/client.rkt
+++ b/racket/typed/examples/roles/require:typed/client.rkt
@ -1,5 +0,0 @@
-#lang typed/syndicate/roles
-
-(require/typed "lib.rkt" [x : Int])
-
-(displayln (+ x 1))
--- a/racket/typed/examples/roles/requires.rkt
+++ b/racket/typed/examples/roles/requires.rkt
@ -1,5 +0,0 @@
-#lang typed/syndicate/roles
-
-(require "provides.rkt")
-
-(a-fun 5)
--- a/racket/typed/examples/roles/two-buyer-protocol.rkt
+++ b/racket/typed/examples/roles/two-buyer-protocol.rkt
@ -1,163 +0,0 @@
-#lang typed/syndicate/roles
-
-;; Expected Output
-;; Completed Order:
-;; Catch 22
-;; 10001483
-;; March 9th
-
-(define-constructor (price v)
-  #:type-constructor PriceT
-  #:with Price (PriceT Int))
-
-(define-constructor (out-of-stock)
-  #:type-constructor OutOfStockT
-  #:with OutOfStock (OutOfStockT))
-
-(define-type-alias QuoteAnswer
-  (U Price OutOfStock))
-
-(define-constructor (quote title answer)
-  #:type-constructor QuoteT
-  #:with Quote (QuoteT String QuoteAnswer)
-  #:with QuoteRequest (Observe (QuoteT String ★/t))
-  #:with QuoteInterest (Observe (QuoteT ★/t ★/t)))
-
-(define-constructor (split-proposal title price contribution accepted)
-  #:type-constructor SplitProposalT
-  #:with SplitProposal (SplitProposalT String Int Int Bool)
-  #:with SplitRequest (Observe (SplitProposalT String Int Int ★/t))
-  #:with SplitInterest (Observe (SplitProposalT ★/t ★/t ★/t ★/t)))
-
-(define-constructor (order-id id)
-  #:type-constructor OrderIdT
-  #:with OrderId (OrderIdT Int))
-
-(define-constructor (delivery-date date)
-  #:type-constructor DeliveryDateT
-  #:with DeliveryDate (DeliveryDateT String))
-
-(define-type-alias (Maybe t)
-  (U t Bool))
-
-(define-constructor (order title price oid delivery-date)
-  #:type-constructor OrderT
-  #:with Order (OrderT String Int (Maybe OrderId) (Maybe DeliveryDate))
-  #:with OrderRequest (Observe (OrderT String Int ★/t ★/t))
-  #:with OrderInterest (Observe (OrderT ★/t ★/t ★/t ★/t)))
-
-(define-type-alias ds-type
-  (U ;; quotes
-   Quote
-   QuoteRequest
-   (Observe QuoteInterest)
-   ;; splits
-   SplitProposal
-   SplitRequest
-   (Observe SplitInterest)
-   ;; orders
-   Order
-   OrderRequest
-   (Observe OrderInterest)))
-
-(define-type-alias seller-role
-  (Role (seller)
-    (During (Observe (QuoteT String ★/t))
-      (Shares (QuoteT String QuoteAnswer)))
-    #;(Reacts (Asserted (Observe (QuoteT String ★/t)))
-            (Role (_)
-              ;; QuoteAnswer was originally, erroneously, Int
-              (Shares (QuoteT String QuoteAnswer))))))
-
-(run-ground-dataspace ds-type
-
-;; seller
-(spawn ds-type
-  (lift+define-role seller-impl
-  (start-facet _ ;; #:implements seller-role
-    (field [book (Tuple String Int) (tuple "Catch 22" 22)]
-           [next-order-id Int 10001483])
-    (on (asserted (observe (quote (bind title String) discard)))
-        (start-facet x
-          (on (retracted (observe (quote title discard)))
-              (stop x))
-          (define answer
-            (match title
-              ["Catch 22"
-               (price 22)]
-              [_
-               (out-of-stock)]))
-          (assert (quote title answer))))
-    (on (asserted (observe (order (bind title String) (bind offer Int) discard discard)))
-        (start-facet x
-          (on (retracted (observe (order title offer discard discard)))
-              (stop x))
-          (let ([asking-price 22])
-            (if (and (equal? title "Catch 22") (>= offer asking-price))
-                (let ([id (ref next-order-id)])
-                  (set! next-order-id (+ 1 id))
-                  (assert (order title offer (order-id id) (delivery-date "March 9th"))))
-                (assert (order title offer #f #f)))))))))
-
-;; buyer A
-(spawn ds-type
-  (lift+define-role buyer-a-impl
-  (start-facet buyer
-    (field [title String "Catch 22"]
-           [budget Int 1000])
-    (on (asserted (quote (ref title) (bind answer QuoteAnswer)))
-        (match answer
-          [(out-of-stock)
-           (stop buyer)]
-          [(price (bind amount Int))
-           (start-facet negotiation
-             (field [contribution Int (/ amount 2)])
-             (on (asserted (split-proposal (ref title) amount (ref contribution) (bind accept? Bool)))
-                 (if accept?
-                     (stop buyer)
-                     (if (> (ref contribution) (- amount 5))
-                         (stop negotiation (displayln "negotiation failed"))
-                         (set! contribution
-                               (+ (ref contribution) (/ (- amount (ref contribution)) 2)))))))])))))
-
-;; buyer B
-(spawn ds-type
-  (lift+define-role buyer-b-impl
-  (start-facet buyer-b
-    (field [funds Int 5])
-    (on (asserted (observe (split-proposal (bind title String) (bind price Int) (bind their-contribution Int) discard)))
-        (let ([my-contribution (- price their-contribution)])
-          (cond
-            [(> my-contribution (ref funds))
-             (start-facet decline
-               (assert (split-proposal title price their-contribution #f))
-               (on (retracted (observe (split-proposal title price their-contribution discard)))
-                   (stop decline)))]
-            [#t
-             (start-facet accept
-               (assert (split-proposal title price their-contribution #t))
-               (on (retracted (observe (split-proposal title price their-contribution discard)))
-                   (stop accept))
-               (on start
-                   (spawn ds-type
-                     (start-facet purchase
-                       (on (asserted (order title price (bind order-id? (Maybe OrderId)) (bind delivery-date? (Maybe DeliveryDate))))
-                           (match (tuple order-id? delivery-date?)
-                             [(tuple (order-id (bind id Int)) (delivery-date (bind date String)))
-                              ;; complete!
-                              (begin (displayln "Completed Order:")
-                                     (displayln title)
-                                     (displayln id)
-                                     (displayln date)
-                                     (stop purchase))]
-                             [discard
-                              (begin (displayln "Order Rejected")
-                                     (stop purchase))]))))))]))))))
-)
-
-(module+ test
-  (check-simulates seller-impl seller-impl)
-  ;; found a bug in spec, see seller-role above
-  (check-simulates seller-impl seller-role)
-  (check-simulates buyer-a-impl buyer-a-impl)
-  (check-simulates buyer-b-impl buyer-b-impl))
--- a/racket/typed/examples/roles/simple-dataflow.rkt
+++ b/racket/typed/examples/roles/simple-dataflow.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output
 ;; f: 0
--- a/racket/typed/examples/roles/simple-dataspace.rkt
+++ b/racket/typed/examples/roles/simple-dataspace.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (run-ground-dataspace Int
  (spawn Int
--- a/racket/typed/examples/roles/simple-during.rkt
+++ b/racket/typed/examples/roles/simple-during.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output
 ;; +GO
--- a/racket/typed/examples/roles/simple-query-hash.rkt
+++ b/racket/typed/examples/roles/simple-query-hash.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output
 ;; adding key2 -> 88
--- a/racket/typed/examples/roles/simple-query-set.rkt
+++ b/racket/typed/examples/roles/simple-query-set.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output
 ;; size: 0
--- a/racket/typed/examples/roles/simple-query-value.rkt
+++ b/racket/typed/examples/roles/simple-query-value.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output
 ;; query: 0
--- a/racket/typed/examples/roles/simple-stop-facet.rkt
+++ b/racket/typed/examples/roles/simple-stop-facet.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 ;; Expected Output:
 ;; +42
--- a/racket/typed/examples/roles/struct-out/client.rkt
+++ b/racket/typed/examples/roles/struct-out/client.rkt
--- a/racket/typed/examples/roles/struct-out/struct-in.rkt
+++ b/racket/typed/examples/roles/struct-out/struct-in.rkt
--- a/racket/typed/examples/roles/struct-out/struct-out.rkt
+++ b/racket/typed/examples/roles/struct-out/struct-out.rkt
--- a/racket/typed/examples/roles/struct-out/typed-out.rkt
+++ b/racket/typed/examples/roles/struct-out/typed-out.rkt
--- a/racket/typed/examples/roles/struct-out/untyped.rkt
+++ b/racket/typed/examples/roles/struct-out/untyped.rkt
--- a/racket/typed/examples/two-buyer-protocol.rkt
+++ b/racket/typed/examples/two-buyer-protocol.rkt
@ -20,14 +20,14 @@
 (define-constructor (quote title answer)
  #:type-constructor QuoteT
  #:with Quote (QuoteT String QuoteAnswer)
-  #:with QuoteRequest (Observe (QuoteT String ★))
-  #:with QuoteInterest (Observe (QuoteT ★ ★)))
+  #:with QuoteRequest (Observe (QuoteT String ★/t))
+  #:with QuoteInterest (Observe (QuoteT ★/t ★/t)))

 (define-constructor (split-proposal title price contribution accepted)
  #:type-constructor SplitProposalT
  #:with SplitProposal (SplitProposalT String Int Int Bool)
-  #:with SplitRequest (Observe (SplitProposalT String Int Int ★))
-  #:with SplitInterest (Observe (SplitProposalT ★ ★ ★ ★)))
+  #:with SplitRequest (Observe (SplitProposalT String Int Int ★/t))
+  #:with SplitInterest (Observe (SplitProposalT ★/t ★/t ★/t ★/t)))

 (define-constructor (order-id id)
  #:type-constructor OrderIdT
@ -40,11 +40,11 @@
 (define-type-alias (Maybe t)
  (U t Bool))

-(define-constructor (order title price id delivery-date)
+(define-constructor (order title price oid delivery-date)
  #:type-constructor OrderT
  #:with Order (OrderT String Int (Maybe OrderId) (Maybe DeliveryDate))
-  #:with OrderRequest (Observe (OrderT String Int ★ ★))
-  #:with OrderInterest (Observe (OrderT ★ ★ ★ ★)))
+  #:with OrderRequest (Observe (OrderT String Int ★/t ★/t))
+  #:with OrderInterest (Observe (OrderT ★/t ★/t ★/t ★/t)))

 (define-type-alias ds-type
  (U ;; quotes
@ -60,88 +60,104 @@
   OrderRequest
   (Observe OrderInterest)))

-(dataspace ds-type
+(define-type-alias seller-role
+  (Role (seller)
+    (During (Observe (QuoteT String ★/t))
+      (Shares (QuoteT String QuoteAnswer)))
+    #;(Reacts (Asserted (Observe (QuoteT String ★/t)))
+            (Role (_)
+              ;; QuoteAnswer was originally, erroneously, Int
+              (Shares (QuoteT String QuoteAnswer))))))
+
+(run-ground-dataspace ds-type

 ;; seller
 (spawn ds-type
-       (facet _
-              (fields [book (Tuple String Int) (tuple "Catch 22" 22)]
-                      [next-order-id Int 10001483])
-              (on (asserted (observe (quote (bind title String) discard)))
-                  (facet x
-                         (fields)
-                         (on (retracted (observe (quote title discard)))
-                             (stop x (begin)))
-                         (match title
-                           ["Catch 22"
-                            (assert (quote title (price 22)))]
-                           [discard
-                            (assert (quote title (out-of-stock)))])))
-              (on (asserted (observe (order (bind title String) (bind offer Int) discard discard)))
-                  (facet x
-                         (fields)
-                         (on (retracted (observe (order title offer discard discard)))
-                             (stop x (begin)))
-                         (let [asking-price 22]
-                           (if (and (equal? title "Catch 22") (>= offer asking-price))
-                               (let [id (ref next-order-id)]
-                                 (begin (set! next-order-id (+ 1 id))
-                                        (assert (order title offer (order-id id) (delivery-date "March 9th")))))
-                               (assert (order title offer #f #f))))))))
+  (lift+define-role seller-impl
+  (start-facet _ ;; #:implements seller-role
+    (field [book (Tuple String Int) (tuple "Catch 22" 22)]
+           [next-order-id Int 10001483])
+    (on (asserted (observe (quote (bind title String) discard)))
+        (start-facet x
+          (on (retracted (observe (quote title discard)))
+              (stop x))
+          (define answer
+            (match title
+              ["Catch 22"
+               (price 22)]
+              [_
+               (out-of-stock)]))
+          (assert (quote title answer))))
+    (on (asserted (observe (order (bind title String) (bind offer Int) discard discard)))
+        (start-facet x
+          (on (retracted (observe (order title offer discard discard)))
+              (stop x))
+          (let ([asking-price 22])
+            (if (and (equal? title "Catch 22") (>= offer asking-price))
+                (let ([id (ref next-order-id)])
+                  (set! next-order-id (+ 1 id))
+                  (assert (order title offer (order-id id) (delivery-date "March 9th"))))
+                (assert (order title offer #f #f)))))))))

 ;; buyer A
 (spawn ds-type
-       (facet buyer
-              (fields [title String "Catch 22"]
-                      [budget Int 1000])
-              (on (asserted (quote (ref title) (bind answer QuoteAnswer)))
-                  (match answer
-                    [(out-of-stock)
-                     (stop buyer (begin))]
-                    [(price (bind amount Int))
-                     (facet negotiation
-                            (fields [contribution Int (/ amount 2)])
-                            (on (asserted (split-proposal (ref title) amount (ref contribution) (bind accept? Bool)))
-                                (if accept?
-                                    (stop buyer (begin))
-                                    (if (> (ref contribution) (- amount 5))
-                                        (stop negotiation (displayln "negotiation failed"))
-                                        (set! contribution
-                                              (+ (ref contribution) (/ (- amount (ref contribution)) 2)))))))]))))
+  (lift+define-role buyer-a-impl
+  (start-facet buyer
+    (field [title String "Catch 22"]
+           [budget Int 1000])
+    (on (asserted (quote (ref title) (bind answer QuoteAnswer)))
+        (match answer
+          [(out-of-stock)
+           (stop buyer)]
+          [(price (bind amount Int))
+           (start-facet negotiation
+             (field [contribution Int (/ amount 2)])
+             (on (asserted (split-proposal (ref title) amount (ref contribution) (bind accept? Bool)))
+                 (if accept?
+                     (stop buyer)
+                     (if (> (ref contribution) (- amount 5))
+                         (stop negotiation (displayln "negotiation failed"))
+                         (set! contribution
+                               (+ (ref contribution) (/ (- amount (ref contribution)) 2)))))))])))))

 ;; buyer B
 (spawn ds-type
-       (facet buyer-b
-              (fields [funds Int 5])
-              (on (asserted (observe (split-proposal (bind title String) (bind price Int) (bind their-contribution Int) discard)))
-                  (let [my-contribution (- price their-contribution)]
-                    (cond
-                      [(> my-contribution (ref funds))
-                       (facet decline
-                              (fields)
-                              (assert (split-proposal title price their-contribution #f))
-                              (on (retracted (observe (split-proposal title price their-contribution discard)))
-                                  (stop decline (begin))))]
-                      [#t
-                       (facet accept
-                              (fields)
-                              (assert (split-proposal title price their-contribution #t))
-                              (on (retracted (observe (split-proposal title price their-contribution discard)))
-                                  (stop accept (begin)))
-                              (on start
-                                  (spawn ds-type
-                                         (facet purchase
-                                                (fields)
-                                                (on (asserted (order title price (bind order-id? (Maybe OrderId)) (bind delivery-date? (Maybe DeliveryDate))))
-                                                    (match (tuple order-id? delivery-date?)
-                                                      [(tuple (order-id (bind id Int)) (delivery-date (bind date String)))
-                                                       ;; complete!
-                                                       (begin (displayln "Completed Order:")
-                                                              (displayln title)
-                                                              (displayln id)
-                                                              (displayln date)
-                                                              (stop purchase (begin)))]
-                                                      [discard
-                                                       (begin (displayln "Order Rejected")
-                                                           (stop purchase (begin)))]))))))])))))
+  (lift+define-role buyer-b-impl
+  (start-facet buyer-b
+    (field [funds Int 5])
+    (on (asserted (observe (split-proposal (bind title String) (bind price Int) (bind their-contribution Int) discard)))
+        (let ([my-contribution (- price their-contribution)])
+          (cond
+            [(> my-contribution (ref funds))
+             (start-facet decline
+               (assert (split-proposal title price their-contribution #f))
+               (on (retracted (observe (split-proposal title price their-contribution discard)))
+                   (stop decline)))]
+            [#t
+             (start-facet accept
+               (assert (split-proposal title price their-contribution #t))
+               (on (retracted (observe (split-proposal title price their-contribution discard)))
+                   (stop accept))
+               (on start
+                   (spawn ds-type
+                     (start-facet purchase
+                       (on (asserted (order title price (bind order-id? (Maybe OrderId)) (bind delivery-date? (Maybe DeliveryDate))))
+                           (match (tuple order-id? delivery-date?)
+                             [(tuple (order-id (bind id Int)) (delivery-date (bind date String)))
+                              ;; complete!
+                              (begin (displayln "Completed Order:")
+                                     (displayln title)
+                                     (displayln id)
+                                     (displayln date)
+                                     (stop purchase))]
+                             [discard
+                              (begin (displayln "Order Rejected")
+                                     (stop purchase))]))))))]))))))
 )
+
+(module+ test
+  (check-simulates seller-impl seller-impl)
+  ;; found a bug in spec, see seller-role above
+  (check-simulates seller-impl seller-role)
+  (check-simulates buyer-a-impl buyer-a-impl)
+  (check-simulates buyer-b-impl buyer-b-impl))
--- a/racket/typed/syndicate/first-facet-lang-attempt.rkt
+++ b/racket/typed/syndicate/first-facet-lang-attempt.rkt
--- a/racket/typed/syndicate/lang/reader.rkt
+++ b/racket/typed/syndicate/lang/reader.rkt
@ -1,2 +1,2 @@
 #lang s-exp syntax/module-reader
-typed/main
+typed/syndicate/roles
--- a/racket/typed/tests/basic-bad-assertion.rkt
+++ b/racket/typed/tests/basic-bad-assertion.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/comm-ty-composition.rkt
+++ b/racket/typed/tests/comm-ty-composition.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (assertion-struct ping : Ping (v))
 (assertion-struct pong : Pong (v))
--- a/racket/typed/tests/define-dataflow.rkt
+++ b/racket/typed/tests/define-dataflow.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (run-ground-dataspace (U)
 (spawn (U)
--- a/racket/typed/tests/effect-polymorhpism.rkt
+++ b/racket/typed/tests/effect-polymorhpism.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/expressions.rkt
+++ b/racket/typed/tests/expressions.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/floating-define.rkt
+++ b/racket/typed/tests/floating-define.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/for-loop-regression.rkt
+++ b/racket/typed/tests/for-loop-regression.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/for-loops.rkt
+++ b/racket/typed/tests/for-loops.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/hashes.rkt
+++ b/racket/typed/tests/hashes.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/inference.rkt
+++ b/racket/typed/tests/inference.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/pattern-annotations.rkt
+++ b/racket/typed/tests/pattern-annotations.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/phantom-rho.rkt
+++ b/racket/typed/tests/phantom-rho.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/primitives.rkt
+++ b/racket/typed/tests/primitives.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/regression-count-new-words.rkt
+++ b/racket/typed/tests/regression-count-new-words.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/regression-define-with-effects.rkt
+++ b/racket/typed/tests/regression-define-with-effects.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/sequences.rkt
+++ b/racket/typed/tests/sequences.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/sets.rkt
+++ b/racket/typed/tests/sets.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)

--- a/racket/typed/tests/spawn.rkt
+++ b/racket/typed/tests/spawn.rkt
@ -1,4 +1,4 @@
-#lang typed/syndicate/roles
+#lang typed/syndicate

 (require rackunit/turnstile)