From 1b7d5a2330305494bbfe839bab9ab29247a0d98d Mon Sep 17 00:00:00 2001
From: Sam Caldwell <samcaldwell@utexas.edu>
Date: Wed, 12 Sep 2018 17:16:25 -0400
Subject: [PATCH] cell example

---
 racket/typed/examples/roles/cell.rkt | 71 ++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)
 create mode 100644 racket/typed/examples/roles/cell.rkt

diff --git a/racket/typed/examples/roles/cell.rkt b/racket/typed/examples/roles/cell.rkt
new file mode 100644
index 0000000..38e8135
--- /dev/null
+++ b/racket/typed/examples/roles/cell.rkt
@@ -0,0 +1,71 @@
+#lang typed/syndicate/roles
+
+;; 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
+                (Spawn ★/t))))
+
+(define-type-alias Reader
+  (Role (reader)
+        (Shares (Observe (Cell 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)))))
\ No newline at end of file