Split out keeping track of actor paths to hierarchy.rkt

racket/syndicate/core.rkt

@@ -71,6 +71,7 @@
 (require "functional-queue.rkt")
 (require "trie.rkt")
 (require "patch.rkt")
+(require "hierarchy.rkt")
 (require "trace.rkt")
 (require "mux.rkt")
 (require "pretty.rkt")
@@ -226,7 +227,7 @@
   (when exn
     (log-error "Process ~v ~a died with exception:\n~a"
                (process-info-name (hash-ref (dataspace-process-table w) pid missing-process-info))
-               (cons pid (trace-pid-stack))
+               (append (current-actor-path) (list pid))
                (exn->string exn)))
   (struct-copy dataspace w
                [process-table (hash-remove (dataspace-process-table w) pid)]
@@ -234,7 +235,7 @@
 
 (define (invoke-process pid thunk k-ok k-exn)
   (define-values (ok? result)
-    (call-in-trace-context
+    (call/extended-actor-path
      pid
      (lambda ()
        (with-handlers ([(lambda (exn) #t) (lambda (exn) (values #f exn))])
@@ -373,7 +374,7 @@
                        (create-process w behavior initial-transition name))
                      (lambda (exn)
                        (log-error "Spawned process in dataspace ~a died with exception:\n~a"
-                                  (trace-pid-stack)
+                                  (current-actor-path)
                                   (exn->string exn))
                        (transition w '())))]
     ['quit
@@ -390,7 +391,7 @@
     [(and m (message body))
      (when (observe? body)
        (log-warning "Stream ~a sent message containing query ~v"
-                    (cons label (trace-pid-stack))
+                    (append (current-actor-path) (list label))
                     body))
      (if (and (not (meta-label? label)) ;; it's from a local process, not envt
               (at-meta? body)) ;; it relates to envt, not local

racket/syndicate/hierarchy.rkt

@@ -0,0 +1,34 @@
+#lang racket/base
+;; Keep track of actor hierarchy, e.g. for
+;;  - naming specific actors in traces, or
+;;  - injecting events from the outside world to specific locations in the tree
+
+(provide current-actor-path-rev
+         current-actor-path
+         call/extended-actor-path
+         gen:actor-hierarchy-node
+         actor-hierarchy-node-deliver)
+
+(require racket/generic)
+
+;; Parameterof (Listof Any)
+;; Path to the active leaf in the process tree. The car end is the
+;; leaf; the cdr end, the root.
+(define current-actor-path-rev (make-parameter '()))
+
+;; Retrieves current-actor-path-rev, but reversed, for use with
+;; actor-hierarchy-node-deliver.
+(define (current-actor-path) (reverse (current-actor-path-rev)))
+
+;; Any (-> Any) -> Any
+;; Pushes pid on current-actor-path for the duration of the call to thunk.
+(define (call/extended-actor-path pid thunk)
+  (parameterize ((current-actor-path-rev (cons pid (current-actor-path-rev))))
+    (thunk)))
+
+;; Generic interface for non-leaf nodes in the hierarchy.
+(define-generics actor-hierarchy-node
+  ;; Deliver an event to a specific node in the hierarchy.
+  (actor-hierarchy-node-deliver actor-hierarchy-node
+                                relative-path
+                                event))

racket/syndicate/trace.rkt

@@ -1,38 +1,24 @@
 #lang racket/base
 
 (provide trace-logger
-
-	 trace-pid-stack
-	 call-in-trace-context
-
 	 trace-process-step
 	 trace-process-step-result
          trace-internal-action
 	 trace-internal-action-result)
 
+(require "hierarchy.rkt")
 (require "pretty.rkt")
 
 (define trace-logger (make-logger 'minimart-trace))
 
-;; (Parameterof (Listof PID))
-;; Path to the active leaf in the process tree. The car end is the
-;; leaf; the cdr end, the root. Used for debugging and tracing purposes.
-(define trace-pid-stack (make-parameter '()))
-
-;; PID (-> Any) -> Any
-;; Pushes pid on trace-pid-stack for the duration of the call to thunk.
-(define (call-in-trace-context pid thunk)
-  (parameterize ((trace-pid-stack (cons pid (trace-pid-stack))))
-    (thunk)))
-
 (define-syntax-rule (record-trace-event name r)
   (when (log-level? trace-logger 'info)
     (log-message trace-logger 'info name "" r #f)))
 
 (define (cons-pid pid)
   (if pid
-      (cons pid (trace-pid-stack))
-      (trace-pid-stack)))
+      (cons pid (current-actor-path-rev))
+      (current-actor-path-rev)))
 
 ;; Event (Option PID) Process -> Void
 (define (trace-process-step e pid beh st)