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

Use actor names; extract reporting from box

This commit is contained in:
Tony Garnock-Jones 2021-06-03 17:01:59 +02:00
parent defb65cd30
commit 5d17a3bc58
1 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
syndicate/go.rkt
View File

@ -7,31 +7,35 @@
(require "schemas/gen/box-protocol.rkt") (require "schemas/gen/box-protocol.rkt")
(require (only-in "pattern.rkt" :pattern)) (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 (define box
(action (ds LIMIT REPORT_EVERY) (action (ds LIMIT REPORT_EVERY)
(spawn (define root-facet this-facet) (spawn #:name 'box
(define root-facet this-facet)
(define-field value 0) (define-field value 0)
(define start-time (current-inexact-milliseconds)) (define reporter (report-stats REPORT_EVERY))
(define prev-value 0)
(at ds (at ds
(assert (BoxState (value))) (assert (BoxState (value)))
(when (message (SetBox $new-value)) (when (message (SetBox $new-value))
(when (zero? (remainder new-value REPORT_EVERY)) (reporter new-value)
(define end-time (current-inexact-milliseconds)) (when (= new-value LIMIT) (stop-facet root-facet))
(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)))
(when (= new-value LIMIT)
(stop-facet root-facet))
(value new-value)))))) (value new-value))))))
(define client (define client
(action (ds) (action (ds)
(spawn (define root-facet this-facet) (spawn #:name 'client
(define root-facet this-facet)
(at ds (at ds
(when (asserted (BoxState $value)) (send! ds (SetBox (+ value 1)))) (when (asserted (BoxState $value)) (send! ds (SetBox (+ value 1))))
(during (BoxState _) (during (BoxState _)