Trace action production as well as interpretation
This commit is contained in:
parent
9009fb5ec7
commit
4efe18bfe0
|
@ -109,6 +109,7 @@
|
|||
(struct-copy dataspace w [runnable-pids (set-add (dataspace-runnable-pids w) pid)]))
|
||||
|
||||
(define (enqueue-actions w label actions)
|
||||
(trace-actions-produced label actions)
|
||||
(struct-copy dataspace w
|
||||
[pending-action-queue
|
||||
(queue-append-list (dataspace-pending-action-queue w)
|
||||
|
@ -153,7 +154,7 @@
|
|||
((entry (in-list (queue->list (dataspace-pending-action-queue w)))))
|
||||
#:break (quit? wt) ;; TODO: should a quit action be delayed until the end of the turn?
|
||||
(match-define [cons label a] entry)
|
||||
(when (or (event? a) (eq? a 'quit)) (trace-action-produced label a))
|
||||
(when (or (event? a) (eq? a 'quit)) (trace-action-interpreted label a))
|
||||
(define wt1 (transition-bind (perform-action label a) wt))
|
||||
wt1))
|
||||
|
||||
|
@ -202,17 +203,21 @@
|
|||
(transition (send-event/guard label (target-event remaining-path e) pid w) '())]))
|
||||
|
||||
(define (create-process parent-label w behavior initial-transition initial-assertions name)
|
||||
(define initial-assertions? (not (trie-empty? initial-assertions)))
|
||||
(define initial-patch (patch initial-assertions trie-empty))
|
||||
(define-values (postprocess initial-state initial-actions)
|
||||
(match (clean-transition initial-transition)
|
||||
[#f
|
||||
(values (lambda (w pid)
|
||||
(trace-actor-spawn parent-label pid (process name behavior (void)))
|
||||
(when initial-assertions? (trace-actions-produced pid (list initial-patch)))
|
||||
w)
|
||||
#f
|
||||
'())]
|
||||
[(and q (<quit> exn initial-actions0))
|
||||
(values (lambda (w pid)
|
||||
(trace-actor-spawn parent-label pid (process name behavior (void)))
|
||||
(when initial-assertions? (trace-actions-produced pid (list initial-patch)))
|
||||
(trace-actor-exit pid exn)
|
||||
(disable-process pid exn w))
|
||||
#f
|
||||
|
@ -220,10 +225,10 @@
|
|||
[(and t (transition initial-state initial-actions0))
|
||||
(values (lambda (w pid)
|
||||
(trace-actor-spawn parent-label pid (process name behavior initial-state))
|
||||
(when initial-assertions? (trace-actions-produced pid (list initial-patch)))
|
||||
(mark-pid-runnable w pid))
|
||||
initial-state
|
||||
initial-actions0)]))
|
||||
(define initial-patch (patch initial-assertions trie-empty))
|
||||
(define-values (new-mux new-pid delta delta-aggregate)
|
||||
(mux-add-stream (dataspace-mux w) initial-patch))
|
||||
(let* ((w (struct-copy dataspace w
|
||||
|
@ -233,7 +238,7 @@
|
|||
behavior
|
||||
initial-state))]))
|
||||
(w (enqueue-actions (postprocess w new-pid) new-pid initial-actions)))
|
||||
(trace-action-produced new-pid initial-patch)
|
||||
(when initial-assertions? (trace-action-interpreted new-pid initial-patch))
|
||||
(deliver-patches w new-mux new-pid delta delta-aggregate)))
|
||||
|
||||
(define (deliver-patches w new-mux acting-label delta delta-aggregate)
|
||||
|
|
|
@ -5,7 +5,8 @@
|
|||
trace-turn-end
|
||||
trace-actor-spawn
|
||||
trace-actor-exit
|
||||
trace-action-produced
|
||||
trace-action-interpreted
|
||||
trace-actions-produced
|
||||
trace-event-consumed
|
||||
trace-causal-influence
|
||||
|
||||
|
@ -20,7 +21,8 @@
|
|||
;; -- 'turn-end
|
||||
;; -- 'spawn
|
||||
;; -- 'exit
|
||||
;; -- 'action
|
||||
;; -- 'action-interpreted
|
||||
;; -- 'actions-produced
|
||||
;; -- 'event
|
||||
;; -- 'influence
|
||||
;;
|
||||
|
@ -29,7 +31,8 @@
|
|||
;; -- 'turn-begin and 'turn-end --> Process
|
||||
;; -- 'spawn --> (list PID Process), the parent's PID and the process' initial state
|
||||
;; -- 'exit --> Option Exception
|
||||
;; -- 'action --> (U Event 'quit) (notably, spawns are handled otherwise)
|
||||
;; -- 'action-interpreted --> (U Event 'quit) (notably, spawns are handled otherwise)
|
||||
;; -- 'actions-produced --> (Listof (U Action 'quit)) (spawns included!)
|
||||
;; -- 'event --> Event
|
||||
;; -- 'influence --> Event
|
||||
;;
|
||||
|
@ -39,7 +42,8 @@
|
|||
;; -- 'turn-end --> source is dataspace; sink the process whose turn it was
|
||||
;; -- 'spawn --> source is dataspace; sink the new process
|
||||
;; -- 'exit --> source is dataspace; sink the exiting process
|
||||
;; -- 'action --> source is acting process; sink is dataspace (NB: Flipped!)
|
||||
;; -- 'action-interpreted --> source is acting process; sink is dataspace (NB: Flipped!)
|
||||
;; -- 'actions-produced --> source is acting process; sink is dataspace (NB: Flipped!)
|
||||
;; -- 'event --> source is dataspace; sink is receiving process
|
||||
;; -- 'influence --> source is acting process; sink is receiving process
|
||||
;;
|
||||
|
@ -82,8 +86,12 @@
|
|||
(notify! (current-actor-path-rev) (cons-pid pid) 'exit maybe-exn))
|
||||
|
||||
;; PID Event
|
||||
(define (trace-action-produced pid e)
|
||||
(notify! (cons-pid pid) (current-actor-path-rev) 'action e))
|
||||
(define (trace-action-interpreted pid e)
|
||||
(notify! (cons-pid pid) (current-actor-path-rev) 'action-interpreted e))
|
||||
|
||||
;; PID (Listof Event)
|
||||
(define (trace-actions-produced pid es)
|
||||
(notify! (cons-pid pid) (current-actor-path-rev) 'actions-produced es))
|
||||
|
||||
;; PID Event
|
||||
(define (trace-event-consumed pid e)
|
||||
|
|
|
@ -152,17 +152,30 @@
|
|||
(output "~a raises an exception:\n~a\n"
|
||||
(format-pids process-names sink)
|
||||
(exn->string exn))))]
|
||||
[('action (? patch? p))
|
||||
[('actions-produced actions)
|
||||
;; (when show-actions?
|
||||
;; (for [(a actions)]
|
||||
;; (match a
|
||||
;; [(? patch? p)
|
||||
;; (output "~a enqueues a patch\n" (format-pids process-names source))]
|
||||
;; [(message body)
|
||||
;; (output "~a enqueues a message\n" (format-pids process-names source))]
|
||||
;; ['quit
|
||||
;; (output "~a schedules a cleanup\n")]
|
||||
;; [(? actor? _)
|
||||
;; (output "~a enqueues a spawn\n" (format-pids process-names source))])))
|
||||
(void)]
|
||||
[('action-interpreted (? patch? p))
|
||||
(when show-actions?
|
||||
(output "~a performs a patch:\n~a\n"
|
||||
(format-pids process-names source)
|
||||
(patch->pretty-string (label-patch p #t))))]
|
||||
[('action (message body))
|
||||
[('action-interpreted (message body))
|
||||
(when show-actions?
|
||||
(output "~a broadcasts a message:\n~a\n"
|
||||
(format-pids process-names source)
|
||||
(pretty-format body)))]
|
||||
[('action 'quit)
|
||||
[('action-interpreted 'quit)
|
||||
(when show-lifecycle?
|
||||
(with-color BRIGHT-RED
|
||||
(output "~a exits\n" (format-pids process-names source))))
|
||||
|
|
Loading…
Reference in New Issue