35 lines
819 B
Racket
35 lines
819 B
Racket
|
#lang imperative-syndicate
|
||
|
|
||
|
(provide turn-recorder
|
||
|
extend-turn!
|
||
|
commit-turn!
|
||
|
reset-turn!)
|
||
|
|
||
|
(require (submod "../dataspace.rkt" priorities))
|
||
|
|
||
|
(define (extend-turn! t item) (t 'extend item))
|
||
|
(define (commit-turn! t) (t 'commit))
|
||
|
(define (reset-turn! t) (t 'reset))
|
||
|
|
||
|
(define (turn-recorder on-commit)
|
||
|
(field [commit-needed #f])
|
||
|
(define items '())
|
||
|
(define t
|
||
|
(match-lambda*
|
||
|
[(list 'extend item)
|
||
|
(set! items (cons item items))
|
||
|
(commit-needed #t)]
|
||
|
[(list 'commit)
|
||
|
(when (commit-needed)
|
||
|
(on-commit (reverse items))
|
||
|
(reset-turn! t))]
|
||
|
[(list 'reset)
|
||
|
(set! items '())
|
||
|
(commit-needed #f)]
|
||
|
[(list 'debug)
|
||
|
(reverse items)]))
|
||
|
(begin/dataflow
|
||
|
#:priority *idle-priority*
|
||
|
(commit-turn! t))
|
||
|
t)
|