2021-06-04 13:56:03 +00:00
|
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
|
|
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
2021-06-01 15:19:24 +00:00
|
|
|
|
2020-04-27 18:27:48 +00:00
|
|
|
#lang syndicate
|
2019-06-11 17:33:37 +00:00
|
|
|
|
|
|
|
(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)
|