syndicate-2017/racket/typed/examples/cell.rkt

72 lines
2.1 KiB
Racket

#lang typed/syndicate
;; adapted from section 8.3 of Tony's dissertation
(define-constructor* (cell : CellT id value))
(define-constructor* (create-cell : CreateCellT id value))
(define-constructor* (update-cell : UpdateCellT id value))
(define-constructor* (delete-cell : DeleteCellT id))
(define-type-alias ID Int)
(define-type-alias Value String)
(define-type-alias Cell
(Role (cell)
(Shares (CellT ID Value))
(Reacts (Message (UpdateCellT ID ★/t))
)
(Reacts (Message (DeleteCellT ID))
(Stop cell))))
(define-type-alias CellFactory
(Role (cell-factory)
(Reacts (Message (CreateCellT ID Value))
;; want to say that what it spawns is a Cell
(Spawns ★/t))))
(define-type-alias Reader
(Role (reader)
(Shares (Observe (CellT ID ★/t)))))
(define-type-alias Writer
(Role (writer)
;; sends update and delete messages
))
(define-type-alias ds-type
(U (CellT ID Value)
(Observe (CellT ID ★/t))
(Message (CreateCellT ID Value))
(Message (UpdateCellT ID Value))
(Message (DeleteCellT ID))
(Observe (CreateCellT ★/t ★/t))
(Observe (UpdateCellT ID ★/t))
(Observe (DeleteCellT ID))))
(define (spawn-cell! [initial-value : Value])
(define id 1234)
(send! (create-cell id initial-value))
id)
(define (spawn-cell-factory)
(spawn ds-type
(start-facet cell-factory
(on (message (create-cell (bind id ID) (bind init Value)))
(spawn ds-type
(start-facet the-cell
(field [value Value init])
(assert (cell id (ref value)))
(on (message (update-cell id (bind new-value Value)))
(set! value new-value))
(on (message (delete-cell id))
(stop the-cell))))))))
(define (spawn-cell-monitor [id : ID])
(spawn ds-type
(start-facet monitor
(on (asserted (cell id (bind value Value)))
(printf "Cell ~a updated to: ~a\n" id value))
(on (retracted (cell id discard))
(printf "Cell ~a deleted\n" id)))))