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

Split out during*; new example go2.rkt

This commit is contained in:
Tony Garnock-Jones 2021-06-03 17:02:14 +02:00
parent 5d17a3bc58
commit 63720f80ba
2 changed files with 100 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
syndicate/go2.rkt Normal file
View File

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

56
syndicate/syntax.rkt
View File

@ -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: