From 63720f80ba0abf1752b6cbd13a801772c7f5d5ac Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Thu, 3 Jun 2021 17:02:14 +0200
Subject: [PATCH] Split out during*; new example go2.rkt

---
 syndicate/go2.rkt    | 70 ++++++++++++++++++++++++++++++++++++++++++++
 syndicate/syntax.rkt | 56 +++++++++++++++++++----------------
 2 files changed, 100 insertions(+), 26 deletions(-)
 create mode 100644 syndicate/go2.rkt

diff --git a/syndicate/go2.rkt b/syndicate/go2.rkt
new file mode 100644
index 0000000..440e240
--- /dev/null
+++ b/syndicate/go2.rkt
@@ -0,0 +1,70 @@
+#lang racket/base
+
+(require racket/match)
+
+(require "main.rkt")
+
+(define (report-stats REPORT_EVERY)
+  (define start-time (current-inexact-milliseconds))
+  (define prev-value 0)
+  (lambda (new-value)
+    (when (zero? (remainder new-value REPORT_EVERY))
+      (define end-time (current-inexact-milliseconds))
+      (define delta (/ (- end-time start-time) 1000.0))
+      (define count (- new-value prev-value))
+      (set! prev-value new-value)
+      (set! start-time end-time)
+      (log-info "Box got ~a (~a Hz)" new-value (/ count delta)))))
+
+(define box
+  (action (k LIMIT REPORT_EVERY)
+    (spawn #:name 'box
+           (define root-facet this-facet)
+           (define disarm (facet-prevent-inert-check! this-facet))
+           (define-field value 0)
+           (define reporter (report-stats REPORT_EVERY))
+           (send! k (hash 'getter
+                          (ref (during* (action (observer)
+                                          (log-info "observer ~v" observer)
+                                          (at observer (assert (value))))))
+                          'setter
+                          (ref (entity #:message
+                                       (action (new-value)
+                                         ;; (log-info "new-value ~v" new-value)
+                                         (reporter new-value)
+                                         (when (= new-value LIMIT) (stop-facet root-facet))
+                                         (value new-value)))))))))
+
+(define client
+  (action (getter setter)
+    (log-info "client start")
+    (spawn #:name 'client
+           (define root-facet this-facet)
+           (define count 0)
+           (at getter
+               (assert (ref (entity #:assert
+                                    (action (_value _handle)
+                                      (set! count (+ count 1)))
+                                    #:retract
+                                    (action (_handle)
+                                      (set! count (- count 1))
+                                      (when (zero? count)
+                                        (log-info "Client detected box termination")
+                                        (stop-facet root-facet))))))
+               (assert (ref (entity #:assert
+                                    (action (value _handle) (send! setter (+ value 1))))))))))
+
+(module+ main
+  (time
+   (actor-system
+    (define root-facet this-facet)
+    (define disarm (facet-prevent-inert-check! this-facet))
+    (box this-turn
+         (ref (entity #:message
+                      (action (refs)
+                        (log-info "refs ~v" refs)
+                        (match-define (hash-table ('getter g) ('setter s)) refs)
+                        (client this-turn g s)
+                        (stop-facet root-facet))))
+         500000
+         100000))))
diff --git a/syndicate/syntax.rkt b/syndicate/syntax.rkt
index 8e018dd..9d74e4f 100644
--- a/syndicate/syntax.rkt
+++ b/syndicate/syntax.rkt
@@ -28,7 +28,8 @@
          at
          assert
          (rename-out [event:when when])
-         during)
+         during
+         during*)
 
 (require racket/match)
 (require racket/stxparam)
@@ -171,31 +172,34 @@
     (syntax-case stx ()
       [(_ pat expr ...)
        #`(assert (Observe (:pattern pat)
-                          (ref (let ((assertion-map (make-hash)))
-                                 (entity #:assert
-                                         (action (bindings handle)
-                                           (match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
-                                           (let ((facet (react
-                                                         (facet-prevent-inert-check! this-facet)
-                                                         expr ...)))
-                                             (match (hash-ref assertion-map handle #f)
-                                               [#f
-                                                (hash-set! assertion-map handle facet)]
-                                               ['dead
-                                                (hash-remove! assertion-map handle)
-                                                (stop-facet facet)]
-                                               [_
-                                                (error 'during "Duplicate assertion handle ~a" handle)])))
-                                         #:retract
-                                         (action (handle)
-                                           (match (hash-ref assertion-map handle #f)
-                                             [#f
-                                              (hash-set! assertion-map handle 'dead)]
-                                             ['dead
-                                              (error 'during "Duplicate retraction handle ~a" handle)]
-                                             [facet
-                                              (hash-remove! assertion-map handle)
-                                              (stop-facet facet)])))))))])))
+                          (ref (during* (action (bindings)
+                                          (match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
+                                          expr ...)))))])))
+
+(define (during* f)
+  (define assertion-map (make-hash))
+  (entity #:assert
+          (action (value handle)
+            (let ((facet (react (facet-prevent-inert-check! this-facet)
+                                (f this-turn value))))
+              (match (hash-ref assertion-map handle #f)
+                [#f
+                 (hash-set! assertion-map handle facet)]
+                ['dead
+                 (hash-remove! assertion-map handle)
+                 (stop-facet facet)]
+                [_
+                 (error 'during "Duplicate assertion handle ~a" handle)])))
+          #:retract
+          (action (handle)
+            (match (hash-ref assertion-map handle #f)
+              [#f
+               (hash-set! assertion-map handle 'dead)]
+              ['dead
+               (error 'during "Duplicate retraction handle ~a" handle)]
+              [facet
+               (hash-remove! assertion-map handle)
+               (stop-facet facet)]))))
 
 ;;---------------------------------------------------------------------------
 ;;; Local Variables: