Integrate dataflow

This commit is contained in:
Tony Garnock-Jones 2021-05-31 13:05:37 +02:00
parent e5b87f5bb0
commit a06b9d188a
3 changed files with 67 additions and 8 deletions

View File

@ -36,6 +36,9 @@
turn-spawn!
turn-stop-actor!
turn-crash!
turn-field!
turn-dataflow!
turn-assert/dataflow!
turn-assert!
turn-assert!*
turn-retract!
@ -45,12 +48,15 @@
turn-sync!*
turn-message!)
(require (only-in preserves preserve=?))
(require racket/match)
(require (only-in racket/exn exn->string))
(require struct-defaults)
(require "rewrite.rkt")
(require "engine.rkt")
(require "dataflow.rkt")
(require "field.rkt")
(require "support/counter.rkt")
(struct entity (assert retract message sync))
@ -69,6 +75,7 @@
(struct actor (id
engine
[daemon? #:mutable]
dataflow
[root #:mutable]
[exit-reason #:mutable] ;; #f -> running, #t -> terminated OK, exn -> error
[exit-hooks #:mutable])
@ -119,6 +126,7 @@
(define ac (actor (generate-actor-id)
engine
daemon?
(make-dataflow-graph)
'uninitialized
#f
'()))
@ -213,13 +221,15 @@
;;---------------------------------------------------------------------------
(define (turn! f action [zombie-turn? #f])
(when (or zombie-turn? (and (not (actor-exit-reason (facet-actor f))) (facet-live? f)))
(define ac (facet-actor f))
(when (or zombie-turn? (and (not (actor-exit-reason ac)) (facet-live? f)))
(let ((turn (turn (generate-turn-id) f (make-hasheq))))
(with-handlers ([exn? (lambda (e)
(turn! (actor-root (facet-actor f))
(turn! (actor-root ac)
(lambda (turn)
(actor-terminate! turn (facet-actor f) e))))])
(actor-terminate! turn ac e))))])
(action turn)
(dataflow-repair-damage! (actor-dataflow ac) (lambda (action) (action turn)))
(for [((ff qq) (in-hash (turn-queues turn)))]
(queue-task! (actor-engine (facet-actor ff))
(lambda ()
@ -273,6 +283,22 @@
(define ac (facet-actor (turn-active-facet turn)))
(turn-enqueue! turn (actor-root ac) (lambda (turn) (actor-terminate! turn ac exn))))
(define (turn-field! turn name initial-value)
(field (actor-dataflow (facet-actor (turn-active-facet turn))) name initial-value))
(define (turn-dataflow! turn action)
(parameterize ((current-dataflow-subject-id action))
(action turn)))
(define (turn-assert/dataflow! turn peer assertion-action)
(define handle #f)
(define assertion (void))
(turn-dataflow! turn
(lambda (turn)
(define new-assertion (assertion-action turn))
(when (not (preserve=? assertion new-assertion))
(set! handle (turn-replace! turn peer handle new-assertion))))))
(define (turn-assert! turn peer assertion)
(define handle (generate-handle))
(turn-assert!* turn peer assertion handle)

35
syndicate/field.rkt Normal file
View File

@ -0,0 +1,35 @@
#lang racket/base
(provide field?
(rename-out [make-field field])
field-name
field-id)
(require "dataflow.rkt")
(require "support/counter.rkt")
(struct field (name ;; Symbol
id ;; Nat
dataflow ;; Dataflow
[value #:mutable] ;; Any
)
#:methods gen:custom-write
[(define (write-proc f port mode)
(fprintf f "#<field:~a:~a>" (field-id f) (field-name f)))]
#:property prop:procedure
(case-lambda
[(f)
(dataflow-record-observation! (field-dataflow f) f)
(field-value f)]
[(f new-value)
(when (not (equal? (field-value f) new-value))
(dataflow-record-damage! (field-dataflow f) f)
(set-field-value! f new-value))]))
(define generate-field-id (make-counter))
(define (make-field dataflow name initial-value)
(field name
(generate-field-id)
dataflow
initial-value))

View File

@ -9,10 +9,8 @@
(require "schemas/gen/dataspace.rkt")
(define ((box ds LIMIT REPORT_EVERY) turn)
(define value-handle #f)
(define (set-value turn value)
(set! value-handle (turn-replace! turn ds value-handle (BoxState->preserves (BoxState value)))))
(set-value turn 0)
(define value (turn-field! turn 'box-value 0))
(turn-assert/dataflow! turn ds (lambda (turn) (BoxState->preserves (BoxState (value)))))
(define start-time (current-inexact-milliseconds))
(define prev-value 0)
(turn-assert! turn ds
@ -33,7 +31,7 @@
(/ count delta)))
(when (= new-value LIMIT)
(turn-stop-actor! turn))
(set-value turn new-value))))))))
(value new-value))))))))
(define ((client ds) turn)
(turn-assert! turn ds