Split out during*; new example go2.rkt
This commit is contained in:
parent
5d17a3bc58
commit
63720f80ba
|
@ -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))))
|
|
@ -28,7 +28,8 @@
|
||||||
at
|
at
|
||||||
assert
|
assert
|
||||||
(rename-out [event:when when])
|
(rename-out [event:when when])
|
||||||
during)
|
during
|
||||||
|
during*)
|
||||||
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require racket/stxparam)
|
(require racket/stxparam)
|
||||||
|
@ -171,31 +172,34 @@
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(_ pat expr ...)
|
[(_ pat expr ...)
|
||||||
#`(assert (Observe (:pattern pat)
|
#`(assert (Observe (:pattern pat)
|
||||||
(ref (let ((assertion-map (make-hash)))
|
(ref (during* (action (bindings)
|
||||||
(entity #:assert
|
(match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
|
||||||
(action (bindings handle)
|
expr ...)))))])))
|
||||||
(match-define (list #,@(analyse-pattern-bindings #'pat)) bindings)
|
|
||||||
(let ((facet (react
|
(define (during* f)
|
||||||
(facet-prevent-inert-check! this-facet)
|
(define assertion-map (make-hash))
|
||||||
expr ...)))
|
(entity #:assert
|
||||||
(match (hash-ref assertion-map handle #f)
|
(action (value handle)
|
||||||
[#f
|
(let ((facet (react (facet-prevent-inert-check! this-facet)
|
||||||
(hash-set! assertion-map handle facet)]
|
(f this-turn value))))
|
||||||
['dead
|
(match (hash-ref assertion-map handle #f)
|
||||||
(hash-remove! assertion-map handle)
|
[#f
|
||||||
(stop-facet facet)]
|
(hash-set! assertion-map handle facet)]
|
||||||
[_
|
['dead
|
||||||
(error 'during "Duplicate assertion handle ~a" handle)])))
|
(hash-remove! assertion-map handle)
|
||||||
#:retract
|
(stop-facet facet)]
|
||||||
(action (handle)
|
[_
|
||||||
(match (hash-ref assertion-map handle #f)
|
(error 'during "Duplicate assertion handle ~a" handle)])))
|
||||||
[#f
|
#:retract
|
||||||
(hash-set! assertion-map handle 'dead)]
|
(action (handle)
|
||||||
['dead
|
(match (hash-ref assertion-map handle #f)
|
||||||
(error 'during "Duplicate retraction handle ~a" handle)]
|
[#f
|
||||||
[facet
|
(hash-set! assertion-map handle 'dead)]
|
||||||
(hash-remove! assertion-map handle)
|
['dead
|
||||||
(stop-facet facet)])))))))])))
|
(error 'during "Duplicate retraction handle ~a" handle)]
|
||||||
|
[facet
|
||||||
|
(hash-remove! assertion-map handle)
|
||||||
|
(stop-facet facet)]))))
|
||||||
|
|
||||||
;;---------------------------------------------------------------------------
|
;;---------------------------------------------------------------------------
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
|
|
Loading…
Reference in New Issue