timestate
This commit is contained in:
parent
490e414904
commit
15504cccab
|
@ -0,0 +1,21 @@
|
|||
#lang syndicate/actor
|
||||
|
||||
(provide (struct-out later-than)
|
||||
stop-when-timeout)
|
||||
|
||||
(require/activate syndicate/drivers/timer)
|
||||
|
||||
(struct later-than (msecs) #:prefab)
|
||||
|
||||
(actor #:name 'drivers/timestate
|
||||
(during (observe (later-than $msecs))
|
||||
(define timer-id (gensym 'timestate))
|
||||
(field [expired? #f])
|
||||
(on-start (send! (set-timer timer-id msecs 'absolute)))
|
||||
(on (message (timer-expired timer-id _)) (expired? #t))
|
||||
(assert #:when (expired?) (later-than msecs))))
|
||||
|
||||
(define-syntax-rule (stop-when-timeout relative-msecs body ...)
|
||||
(let ((timer-id (gensym 'timeout)))
|
||||
(on-start (send! (set-timer timer-id relative-msecs 'relative)))
|
||||
(stop-when (message (timer-expired timer-id _)) body ...)))
|
|
@ -0,0 +1,15 @@
|
|||
#lang syndicate/actor
|
||||
|
||||
(require/activate syndicate/drivers/timestate)
|
||||
|
||||
(actor #:name 'demo-timeout
|
||||
(on-start (printf "Starting demo-timeout\n"))
|
||||
(on-stop (printf "Stopping demo-timeout\n"))
|
||||
(stop-when-timeout 3000 (printf "Three second timeout fired\n")))
|
||||
|
||||
(actor #:name 'demo-later-than
|
||||
(on-start (printf "Starting demo-later-than\n"))
|
||||
(on-stop (printf "Stopping demo-later-than\n"))
|
||||
(field [deadline (+ (current-inexact-milliseconds) 5000)])
|
||||
(stop-when (asserted (later-than (deadline)))
|
||||
(printf "Deadline expired\n")))
|
Loading…
Reference in New Issue