syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

look more at book club roles

This commit is contained in:
Sam Caldwell 2019-03-29 16:12:46 -04:00
parent 362d7c877d
commit e16db164df
2 changed files with 153 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
racket/typed/examples/roles/book-club.rkt
View File

@ -62,13 +62,14 @@
(define (spawn-seller [inventory : Inventory]) (define (spawn-seller [inventory : Inventory])
(spawn τc (spawn τc
(begin
(start-facet seller (start-facet seller
(field [books Inventory inventory]) (field [books Inventory inventory])
;; Give quotes to interested parties. ;; Give quotes to interested parties.
(during (observe (book-quote (bind title String) discard)) (during (observe (book-quote (bind title String) discard))
;; TODO - lookup ;; TODO - lookup
(assert (book-quote title (lookup title (ref books)))))))) (assert (book-quote title (lookup title (ref books)))))))))
(define-type-alias leader-role (define-type-alias leader-role
(Role (leader) (Role (leader)
@ -101,7 +102,7 @@
(define (spawn-leader [titles : (List String)]) (define (spawn-leader [titles : (List String)])
(spawn τc (spawn τc
(print-role (begin
(start-facet get-quotes (start-facet get-quotes
(field [book-list (List String) (rest titles)] (field [book-list (List String) (rest titles)]
[title String (first titles)]) [title String (first titles)])
@ -162,10 +163,11 @@
(Reacts (Know (Observe (BookInterestT String ★/t ★/t))) (Reacts (Know (Observe (BookInterestT String ★/t ★/t)))
(Role (_) (Role (_)
(Shares (BookInterestT String String Bool)))))) (Shares (BookInterestT String String Bool))))))
(define (spawn-club-member [name : String] (define (spawn-club-member [name : String]
[titles : (List String)]) [titles : (List String)])
(spawn τc (spawn τc
(begin
(start-facet member (start-facet member
;; assert our presence ;; assert our presence
(assert (club-member name)) (assert (club-member name))
@ -173,7 +175,7 @@
(during (observe (book-interest (bind title String) discard discard)) (during (observe (book-interest (bind title String) discard discard))
(define answer (member? title titles)) (define answer (member? title titles))
(printf "~a responds to suggested book ~a: ~a\n" name title answer) (printf "~a responds to suggested book ~a: ~a\n" name title answer)
(assert (book-interest title name answer)))))) (assert (book-interest title name answer)))))))
(run-ground-dataspace τc (run-ground-dataspace τc
(spawn-seller (list (tuple "The Wind in the Willows" 5) (spawn-seller (list (tuple "The Wind in the Willows" 5)

196
racket/typed/proto.rkt
View File

@ -60,6 +60,18 @@
;; a StructName is a Symbol ;; a StructName is a Symbol
;; --------------------------------------------------------------------------
;; Derived Types
;; τ (Listof EP) -> EP
(define (During assertion eps)
(define facet-name (gensym 'during-inner))
(Reacts (Know assertion)
(Role facet-name
(cons (Reacts (¬Know assertion)
(Stop facet-name '()))
eps))))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
;; Examples ;; Examples
@ -71,13 +83,6 @@
(Role 'client (Role 'client
(list (Reacts (Know (Struct 'account (list Int))) '())))) (list (Reacts (Know (Struct 'account (list Int))) '()))))
(define seller
(Role 'seller
(list
(Reacts (Know (Observe (Struct 'BookQuoteT (list String ⋆))))
(Role 'fulfill
(list (Shares (Struct 'BookQuoteT (list String Int)))))))))
;; τ τ -> τ ;; τ τ -> τ
;; short hand for creating a book quote struct type ;; short hand for creating a book quote struct type
(define (book-quote ty1 ty2) (define (book-quote ty1 ty2)
@ -88,45 +93,83 @@
(define (book-interest ty1 ty2 ty3) (define (book-interest ty1 ty2 ty3)
(Struct 'book-interest (list ty1 ty2 ty3))) (Struct 'book-interest (list ty1 ty2 ty3)))
;; τ -> τ
;; short hand for creating a book of the month type
(define (book-of-the-month ty)
(Struct 'book-of-the-month (list ty)))
;; τ -> τ
;; short hand for creating a club member type
(define (club-member ty)
(Struct 'club-member (list ty)))
(define seller
(Role 'seller
(list
(Reacts (Know (Observe (book-quote String ⋆)))
(Role 'fulfill
(list (Shares (book-quote String Int))))))))
(define seller-actual
(Role
'seller27
(list
(Reacts
(Know (Observe (book-quote String ⋆)))
(Role
'during-inner29
(list
(Shares (book-quote String (U (list Int Int))))
(Reacts
(¬Know (Observe (book-quote String ⋆)))
(Stop 'during-inner29 '()))))))))
(define leader-spec (define leader-spec
(Role 'leader (Role 'leader
(list (list
(Reacts (Know (book-quote String Int)) (Reacts
(Role 'poll (Know (book-quote String Int))
(list (Role 'poll
(Reacts (Know (book-interest String String Bool)) (list
(Branch (Reacts
(list (Know (book-interest String String Bool))
(Stop 'leader (Branch
(Role 'announce (list
(list (Stop 'leader
(Shares (Struct 'book-of-the-month (list String)))))) (Role 'announce
(Stop 'poll (list))))))))))) (list
(Shares (book-of-the-month String)))))
(Stop 'poll (list)))))))))))
(define leader-actual (define leader-actual
(Role 'get-quotes (Role
'get-quotes
(list
(Reacts
(Know (book-quote String Int))
(Branch
(list
;; problem 1: spec doesn't say actor can give up when running out of books
(Stop 'get-quotes '())
(Role
'poll-members
(list (list
(Reacts (Know (book-quote String Int)) (Reacts
(Branch (list (Know (book-interest String String ⋆))
;; problem 1: spec doesn't say actor can give up when running out of books (Branch (list
(Stop 'get-quotes '()) ;; problem 2: combining poll-members and get-quotes here (should be another branch)
(Role 'poll-members (Stop 'poll-members
(list (Stop 'get-quotes '()))
(Reacts (Know (book-interest String String ⋆)) (Stop 'get-quotes
(Branch (list (Role 'announce
;; problem 2: combining poll-members and get-quotes here (should be another branch) (list
(Stop 'poll-members (Shares (book-of-the-month String))))))))
(Stop 'get-quotes '())) (Reacts (¬Know (book-interest String String Bool)) (list))
(Stop 'get-quotes (Reacts (Know (book-interest String String Bool)) (list))
(Role 'announce (Reacts (¬Know (book-interest String String Bool)) (list))
(list (Reacts (Know (book-interest String String Bool)) (list)))))))
(Shares (Struct 'book-of-the-month (list String))))))))) (Reacts (¬Know (club-member String)) (list))
(Reacts (¬Know (book-interest String String Bool)) (list)) (Reacts (Know (club-member String)) (list)))))
(Reacts (Know (book-interest String String Bool)) (list))
(Reacts (¬Know (book-interest String String Bool)) (list))
(Reacts (Know (book-interest String String Bool)) (list)))))))
(Reacts (¬Know (Struct 'club-member (list String))) (list))
(Reacts (Know (Struct 'club-member (list String))) (list)))))
(define leader-fixed? (define leader-fixed?
(Role 'get-quotes (Role 'get-quotes
@ -142,13 +185,13 @@
(Stop 'get-quotes (Stop 'get-quotes
(Role 'announce (Role 'announce
(list (list
(Shares (Struct 'book-of-the-month (list String))))))))) (Shares (book-of-the-month String))))))))
(Reacts (¬Know (book-interest String String Bool)) (list)) (Reacts (¬Know (book-interest String String Bool)) (list))
(Reacts (Know (book-interest String String Bool)) (list)) (Reacts (Know (book-interest String String Bool)) (list))
(Reacts (¬Know (book-interest String String Bool)) (list)) (Reacts (¬Know (book-interest String String Bool)) (list))
(Reacts (Know (book-interest String String Bool)) (list))))))) (Reacts (Know (book-interest String String Bool)) (list)))))))
(Reacts (¬Know (Struct 'club-member (list String))) (list)) (Reacts (¬Know (club-member String)) (list))
(Reacts (Know (Struct 'club-member (list String))) (list))))) (Reacts (Know (club-member String)) (list)))))
(define leader-revised (define leader-revised
(Role (Role
@ -176,14 +219,40 @@
(list (list
(Stop (Stop
'get-quotes 'get-quotes
(Role 'announce (list (Shares (Struct 'book-of-the-month (list String)))))) (Role 'announce (list (Shares (book-of-the-month String)))))
(list))))) (list)))))
(Reacts (¬Know (book-interest String String Bool)) (list)) (Reacts (¬Know (book-interest String String Bool)) (list))
(Reacts (Know (book-interest String String Bool)) (list)) (Reacts (Know (book-interest String String Bool)) (list))
(Reacts (¬Know (book-interest String String Bool)) (list)) (Reacts (¬Know (book-interest String String Bool)) (list))
(Reacts (Know (book-interest String String Bool)) (list))))))) (Reacts (Know (book-interest String String Bool)) (list)))))))
(Reacts (¬Know (Struct 'club-member (list String))) (list)) (Reacts (¬Know (club-member String)) (list))
(Reacts (Know (Struct 'club-member (list String))) (list))))) (Reacts (Know (club-member String)) (list)))))
(define member-spec
(Role
'member
(list
(Shares (club-member String))
(Reacts (Know (Observe (book-interest String ⋆ ⋆)))
(Role 'respond
(list
(Shares (book-interest String String Bool))))))))
(define member-actual
(Role
'member41
(list
(Shares (club-member String))
(Reacts
(Know (Observe (book-interest String ⋆ ⋆)))
(Role
'during-inner42
(list
(Shares (book-interest String String Bool))
(Reacts
(¬Know (Observe (book-interest String ⋆ ⋆)))
;; this bit is a noticeable deviation from the spec
(Stop 'during-inner42 '()))))))))
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
;; Compiling Roles to state machines ;; Compiling Roles to state machines
@ -257,7 +326,7 @@
(define st0 (hash-ref seller# (set 'seller))) (define st0 (hash-ref seller# (set 'seller)))
(define transitions (state-transitions st0)) (define transitions (state-transitions st0))
(define quote-request (define quote-request
(Observe (Struct 'BookQuoteT (list String ⋆)))) (Observe (book-quote String ⋆)))
(check-true (hash-has-key? transitions (Know quote-request))) (check-true (hash-has-key? transitions (Know quote-request)))
(check-equal? (hash-ref transitions (Know quote-request)) (check-equal? (hash-ref transitions (Know quote-request))
(set (set 'seller 'fulfill)))) (set (set 'seller 'fulfill))))
@ -586,7 +655,7 @@
(hash)) (hash))
(define seller-txns (hash-ref desc 'seller)) (define seller-txns (hash-ref desc 'seller))
(define quote-request (define quote-request
(Observe (Struct 'BookQuoteT (list String ⋆)))) (Observe (book-quote String ⋆)))
(check-true (hash-has-key? seller-txns (Know quote-request))) (check-true (hash-has-key? seller-txns (Know quote-request)))
(check-equal? (hash-ref seller-txns (Know quote-request)) (check-equal? (hash-ref seller-txns (Know quote-request))
(set (list (start 'fulfill))))) (set (list (start 'fulfill)))))
@ -911,7 +980,36 @@
(check-true (simulates? leader-fixed? leader-spec))) (check-true (simulates? leader-fixed? leader-spec)))
(test-case (test-case
"things aren't quite right with leader-revised" "things aren't quite right with leader-revised"
(check-false (simulates? leader-revised leader-spec)))) (check-false (simulates? leader-revised leader-spec)))
(test-case
"things aren't quite right with member role"
(check-false (simulates? member-actual member-spec))
(define member-actual/revised
(Role
'member41
(list
(Shares (club-member String))
(Reacts
(Know (Observe (book-interest String ⋆ ⋆)))
(Role
'during-inner42
(list
(Shares (book-interest String String Bool))
(Reacts
(¬Know (Observe (book-interest String ⋆ ⋆)))
;; removed (Stop 'during-inner42 '()) here
'())))))))
(check-true (simulates? member-actual/revised member-spec)))
(test-case
"things aren't quite right with seller role"
(check-false (simulates? seller-actual seller))
(define seller-spec/revised
(Role 'seller
;; change body to a During
(list
(During (Observe (book-quote String ⋆))
(list (Shares (book-quote String Int)))))))
(check-true (simulates? seller-actual seller-spec/revised))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; Visualization ;; Visualization