#lang syndicate
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(require "stats.rkt")

(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)
                                         (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))))