95 lines
3.2 KiB
Racket
95 lines
3.2 KiB
Racket
#lang racket/base
|
|
|
|
(provide current-trace-procedures
|
|
trace-turn-begin
|
|
trace-turn-end
|
|
trace-actor-spawn
|
|
trace-actor-exit
|
|
trace-action-produced
|
|
trace-event-consumed
|
|
trace-causal-influence
|
|
|
|
(struct-out trace-notification))
|
|
|
|
(require "hierarchy.rkt")
|
|
(require "pretty.rkt")
|
|
(require "store.rkt")
|
|
|
|
;; A NotificationType is one of
|
|
;; -- 'turn-begin
|
|
;; -- 'turn-end
|
|
;; -- 'spawn
|
|
;; -- 'exit
|
|
;; -- 'action
|
|
;; -- 'event
|
|
;; -- 'influence
|
|
;;
|
|
;; The trace-notification-detail field is used differently for each
|
|
;; NotificationType:
|
|
;; -- '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)
|
|
;; -- 'event --> Event
|
|
;; -- 'influence --> Event
|
|
;;
|
|
;; The source and sink fields both hold values of type ActorPath. They
|
|
;; are, again, used differently for each NotificationType:
|
|
;; -- 'turn-begin --> source is dataspace; sink the process whose turn it is
|
|
;; -- '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!)
|
|
;; -- 'event --> source is dataspace; sink is receiving process
|
|
;; -- 'influence --> source is acting process; sink is receiving process
|
|
;;
|
|
;; For 'influence, when the detail event is a patch, the source field
|
|
;; is not always the true influencing party. In the case where a
|
|
;; process adds new observe assertions to a dataspace where matching
|
|
;; assertions already exist, it will appear to "influence itself".
|
|
;; Really, with patches, it's the PIDs at the leaves of each patch's
|
|
;; tries that are the influencers.
|
|
|
|
(struct trace-notification (source sink type detail) #:prefab)
|
|
|
|
(define current-trace-procedures (make-store #:default-box (box '())))
|
|
|
|
(define-syntax-rule (notify! src snk typ det)
|
|
(let ((trace-procedures (current-trace-procedures)))
|
|
(when (pair? trace-procedures)
|
|
(define n (trace-notification src snk typ det))
|
|
(for-each (lambda (procedure) (procedure n)) trace-procedures))))
|
|
|
|
(define (cons-pid pid)
|
|
(if pid
|
|
(cons pid (current-actor-path-rev))
|
|
(current-actor-path-rev)))
|
|
|
|
;; PID Process
|
|
(define (trace-turn-begin pid p)
|
|
(notify! (current-actor-path-rev) (cons-pid pid) 'turn-begin p))
|
|
|
|
;; PID Process
|
|
(define (trace-turn-end pid p)
|
|
(notify! (current-actor-path-rev) (cons-pid pid) 'turn-end p))
|
|
|
|
;; PID PID Process
|
|
(define (trace-actor-spawn parent-pid pid p)
|
|
(notify! (current-actor-path-rev) (cons-pid pid) 'spawn (list (cons-pid parent-pid) p)))
|
|
|
|
;; PID (Option Exception)
|
|
(define (trace-actor-exit pid maybe-exn)
|
|
(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))
|
|
|
|
;; PID Event
|
|
(define (trace-event-consumed pid e)
|
|
(notify! (current-actor-path-rev) (cons-pid pid) 'event e))
|
|
|
|
;; PID PID Event
|
|
(define (trace-causal-influence attribution snk-pid e)
|
|
(notify! attribution (cons-pid snk-pid) 'influence e))
|