Trace action production as well as interpretation

racket/syndicate/dataspace.rkt

@@ -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)

racket/syndicate/trace.rkt

@@ -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)

racket/syndicate/trace/stderr.rkt

@@ -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))))