From c4f8b4278720b52e0d0e599b430c7d304845af6e Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 17 Nov 2015 14:01:04 -0500 Subject: [PATCH] Allow recording of exceptions in quit structs. --- prospect/core.rkt | 30 ++++++++++++++++-------------- prospect/endpoint.rkt | 2 +- 2 files changed, 17 insertions(+), 15 deletions(-) diff --git a/prospect/core.rkt b/prospect/core.rkt index 5a366ae..a456d6f 100644 --- a/prospect/core.rkt +++ b/prospect/core.rkt @@ -86,12 +86,14 @@ ;; - a (transition Any (Constreeof Action)), a new Process state to ;; be held by its World and a sequence of Actions for the World ;; to take on the transitioning Process's behalf. -;; - a (quit (Constreeof Action)), signalling that the Process should -;; never again be handed an event, and that any queued actions -;; should be performed, followed by the sequence of Actions given, -;; and then the process should be garbage-collected. +;; - a (quit (Option Exn) (Constreeof Action)), signalling that the +;; Process should never again be handed an event, and that any +;; queued actions should be performed, followed by the sequence +;; of Actions given, and then the process should be +;; garbage-collected. The optional Exn is only used for +;; debugging purposes; #f means normal termination. (struct transition (state actions) #:transparent) -(struct quit (actions) #:prefab) +(struct quit (exn actions) #:prefab) ;; A PID is a Nat. ;; A Label is a PID or 'meta. @@ -155,7 +157,7 @@ (define (clean-transition t) (match t [#f #f] - [(quit actions) (quit (clean-actions actions))] + [(quit exn actions) (quit exn (clean-actions actions))] [(transition state actions) (transition state (clean-actions actions))])) (define (clean-actions actions) @@ -172,8 +174,8 @@ (lambda () (clean-transition (ensure-transition (behavior e old-state)))) (match-lambda [#f w] - [(and q (quit final-actions)) - (trace-process-step-result e pid behavior old-state #f q) + [(and q (quit exn final-actions)) + (trace-process-step-result e pid behavior old-state exn q) (enqueue-actions (disable-process pid #f w) pid (append final-actions (list 'quit)))] [(and t (transition new-state new-actions)) @@ -222,8 +224,8 @@ (queue-append-list (world-pending-action-queue w) (for/list [(a actions)] (cons label a)))])) -(define (make-quit . actions) - (quit actions)) +(define (make-quit #:exception [exn #f] . actions) + (quit exn actions)) (define-syntax-rule (spawn-process behavior-exp initial-state-exp initial-patch-exp ...) (spawn (lambda () @@ -261,11 +263,11 @@ (define (transition-bind k t0) (match t0 [#f (error 'transition-bind "Cannot bind from transition #f with continuation ~v" k)] - [(quit _) t0] + [(quit _ _) t0] [(transition state0 actions0) (match (k state0) [#f t0] - [(quit actions1) (quit (cons actions0 actions1))] + [(quit exn actions1) (quit exn (cons actions0 actions1))] [(transition state1 actions1) (transition state1 (cons actions0 actions1))])])) (define (sequence-transitions t0 . steps) @@ -397,8 +399,8 @@ (let loop ((w w) (actions '())) (pretty-print w) (match (world-handle-event #f w) - [#f (values w (flatten actions))] - [(quit new-actions) (values w (flatten (cons actions new-actions)))] + [#f (values w #f (flatten actions))] + [(quit exn new-actions) (values w exn (flatten (cons actions new-actions)))] [(transition new-w new-actions) (loop new-w (cons actions new-actions))]))) (step* (make-world '())) diff --git a/prospect/endpoint.rkt b/prospect/endpoint.rkt index 31ce36b..b92ac7d 100644 --- a/prospect/endpoint.rkt +++ b/prospect/endpoint.rkt @@ -115,7 +115,7 @@ (match-define (list e eid ep) task) (match ((handler-getter ep) e (endpoint-group-state g)) [#f (values cumulative-patch actions g idle?)] - [( ep-acs) (return (quit (filter action? (flatten ep-acs))))] + [( exn ep-acs) (return (quit exn (filter action? (flatten ep-acs))))] [(transition new-state ep-acs) (define-values (cp acs next-g) (interpret-endpoint-actions cumulative-patch