syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Introduce action-groups

This commit is contained in:
Tony Garnock-Jones 2018-04-22 21:02:40 +01:00
parent 634b114afc
commit 4be935a160
1 changed files with 26 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
syndicate/dataspace.rkt
View File

@ -85,7 +85,7 @@
assertions ;; (Bagof Assertion)
dataflow ;; DataflowGraph
[runnable #:mutable] ;; (Listof Actor)
[pending-actions #:mutable] ;; (Queueof Action)
[pending-actions #:mutable] ;; (Queueof ActionGroup)
) #:transparent)
(struct actor (id ;; ActorID
@ -101,6 +101,11 @@
[(define (write-proc a p mode)
(fprintf p "#<actor ~a ~v>" (actor-id a) (actor-name a)))])
(struct action-group (actor ;; (U Actor 'meta)
actions ;; (Listof Action)
)
#:transparent)
(struct facet (id ;; FID
[live? #:mutable] ;; Boolean
actor ;; Actor
@ -210,7 +215,7 @@
(make-bag)
(make-dataflow-graph)
'()
(enqueue (make-queue) (spawn name boot-proc (set)))))
(enqueue (make-queue) (action-group 'meta (list (spawn name boot-proc (set)))))))
(define (generate-id! ds)
(let ((id (dataspace-next-id ds)))
@ -306,7 +311,8 @@
(define (commit-actions! ds ac)
(define pending (actor-pending-actions ac))
;; (log-info "commit-actions!: ~a actions ~a" ac (queue->list pending))
(set-dataspace-pending-actions! ds (queue-append (dataspace-pending-actions ds) pending))
(set-dataspace-pending-actions! ds (enqueue (dataspace-pending-actions ds)
(action-group ac (queue->list pending))))
(set-actor-pending-actions! ac (make-queue)))
(define (run-all-pending-scripts! ds)
@ -318,22 +324,24 @@
(commit-actions! ds ac)))
(define (perform-pending-actions! ds)
(define actions (queue->list (dataspace-pending-actions ds)))
(define groups (queue->list (dataspace-pending-actions ds)))
(set-dataspace-pending-actions! ds (make-queue))
(for [(action actions)]
;; (log-info "performing ~a" action)
(match action
[(patch delta)
(for [((a count) (in-bag/count delta))]
(match (bag-change! (dataspace-assertions ds) a count)
['present->absent (remove-assertion! (dataspace-routing-table ds) a)]
['absent->present (add-assertion! (dataspace-routing-table ds) a)]
;; 'absent->absent absurd
['present->present (void)]))] ;; i.e. no visible change
[(message body)
(send-assertion! (dataspace-routing-table ds) body)]
[(spawn name boot-proc initial-assertions)
(add-actor! ds name boot-proc initial-assertions)])))
(for [(group (in-list groups))]
(match-define (action-group ac actions) group)
(for [(action (in-list actions))]
;; (log-info "~a performing ~a" ac action)
(match action
[(patch delta)
(for [((a count) (in-bag/count delta))]
(match (bag-change! (dataspace-assertions ds) a count)
['present->absent (remove-assertion! (dataspace-routing-table ds) a)]
['absent->present (add-assertion! (dataspace-routing-table ds) a)]
;; 'absent->absent absurd
['present->present (void)]))] ;; i.e. no visible change
[(message body)
(send-assertion! (dataspace-routing-table ds) body)]
[(spawn name boot-proc initial-assertions)
(add-actor! ds name boot-proc initial-assertions)]))))
(define (run-scripts! ds)
(run-all-pending-scripts! ds)