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

Support tracing at ground-level; support display of intermediate world states

This commit is contained in:
Tony Garnock-Jones 2015-03-21 17:30:48 -04:00
parent a016a967ef
commit 0d38e11ee8
3 changed files with 25 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
prospect/ground.rkt
View File

@ -6,6 +6,7 @@
(require racket/match)
(require racket/list)
(require "core.rkt")
(require "trace.rkt")
(require "trace/stderr.rkt")
(provide (struct-out external-event)
@ -77,7 +78,10 @@
(current-ground-event-async-channel)
(if inert? never-evt idle-handler)
(extract-active-events interests))))
(match (clean-transition (world-handle-event e w))
(trace-process-step e #f world-handle-event w)
(define resulting-transition (clean-transition (world-handle-event e w)))
(trace-process-step-result e #f world-handle-event w #f resulting-transition)
(match resulting-transition
[#f ;; inert
(await-interrupt #t w interests)]
[(transition w actions)

25
prospect/trace.rkt
View File

@ -34,25 +34,30 @@
(when (log-level? trace-logger 'info)
(log-message trace-logger 'info name "" r #f)))
;; Event PID Process -> Void
(define (trace-process-step e pid beh st)
(record-trace-event 'process-step (list (cons pid (trace-pid-stack)) e beh st)))
(define (cons-pid pid)
(if pid
(cons pid (trace-pid-stack))
(trace-pid-stack)))
;; Event PID Process (Option Exception) (Option Transition) -> Void
;; Event (Option PID) Process -> Void
(define (trace-process-step e pid beh st)
(record-trace-event 'process-step (list (cons-pid pid) e beh st)))
;; Event (Option PID) Process (Option Exception) (Option Transition) -> Void
(define (trace-process-step-result e pid beh st exn t)
(when exn
(log-error "Process ~a died with exception:\n~a"
(cons pid (trace-pid-stack))
(cons-pid pid)
(exn->string exn)))
(record-trace-event 'process-step-result (list (cons pid (trace-pid-stack)) e beh st exn t)))
(record-trace-event 'process-step-result (list (cons-pid pid) e beh st exn t)))
;; PID Action World -> Void
;; (Option PID) Action World -> Void
(define (trace-internal-action pid a w)
(record-trace-event 'internal-action (list (cons pid (trace-pid-stack)) a w)))
(record-trace-event 'internal-action (list (cons-pid pid) a w)))
;; PID Action World Transition -> Void
;; (Option PID) Action World Transition -> Void
(define (trace-internal-action-result pid a w t)
(record-trace-event 'internal-action-result (list (cons pid (trace-pid-stack)) a w t)))
(record-trace-event 'internal-action-result (list (cons-pid pid) a w t)))
(define (string-indent amount s)
(define pad (make-string amount #\space))

8
prospect/trace/stderr.rkt
View File

@ -33,6 +33,7 @@
(define show-message-actions? #f)
(define show-actions? #f)
(define show-routing-table? #f)
(define world-is-boring? #t)
(define (set-stderr-trace-flags! flags-string)
(set! flags (for/set [(c flags-string)] (string->symbol (string c))))
@ -46,7 +47,8 @@
(set! show-patch-actions? (set-member? flags 'R))
(set! show-message-actions? (set-member? flags 'M))
(set! show-actions? (set-member? flags 'a))
(set! show-routing-table? (set-member? flags 'g)))
(set! show-routing-table? (set-member? flags 'g))
(set! world-is-boring? (not (set-member? flags 'W))))
(set-stderr-trace-flags! (or (getenv "MINIMART_TRACE") ""))
@ -75,11 +77,11 @@
(define (output-state state)
(cond
[(world? state) (output "#<world>\n")]
[(world? state) (pretty-print-world state)]
[else (pretty-write state (current-error-port))]))
(define (boring-state? state)
(or (world? state)
(or (and (world? state) world-is-boring?)
(void? state)))
(define (set-color! c) (when colored-output? (output "\e[0~am" c)))