26 lines
943 B
Racket
26 lines
943 B
Racket
#lang syndicate
|
|
;; Big-bang specific timestate implementation with compatible protocol.
|
|
|
|
(provide (struct-out later-than)
|
|
stop-when-timeout
|
|
sleep)
|
|
|
|
(require syndicate/big-bang)
|
|
(require (only-in syndicate/drivers/timestate
|
|
later-than later-than? struct:later-than later-than-msecs))
|
|
|
|
(define-syntax-rule (stop-when-timeout relative-msecs body ...)
|
|
(let ((deadline (+ (current-inexact-milliseconds) relative-msecs)))
|
|
(stop-when (asserted (later-than deadline)) body ...)))
|
|
|
|
(define (sleep sec)
|
|
(let ((deadline (+ (current-inexact-milliseconds) (* sec 1000.0))))
|
|
(until (asserted (later-than deadline)))))
|
|
|
|
(spawn #:name 'big-bang-timestate-driver
|
|
(during (observe (later-than $deadline))
|
|
(field [ready? #f])
|
|
(assert #:when (ready?) (later-than deadline))
|
|
(on (message (inbound (tick-event)))
|
|
(ready? (>= (current-inexact-milliseconds) deadline)))))
|