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

Allow recording of exceptions in quit structs.

This commit is contained in:
Tony Garnock-Jones 2015-11-17 14:01:04 -05:00
parent 252a09b48d
commit c4f8b42787
2 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
prospect/core.rkt
View File

@ -86,12 +86,14 @@
;; - a (transition Any (Constreeof Action)), a new Process state to ;; - a (transition Any (Constreeof Action)), a new Process state to
;; be held by its World and a sequence of Actions for the World ;; be held by its World and a sequence of Actions for the World
;; to take on the transitioning Process's behalf. ;; to take on the transitioning Process's behalf.
;; - a (quit (Constreeof Action)), signalling that the Process should ;; - a (quit (Option Exn) (Constreeof Action)), signalling that the
;; never again be handed an event, and that any queued actions ;; Process should never again be handed an event, and that any
;; should be performed, followed by the sequence of Actions given, ;; queued actions should be performed, followed by the sequence
;; and then the process should be garbage-collected. ;; 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 transition (state actions) #:transparent)
(struct quit (actions) #:prefab) (struct quit (exn actions) #:prefab)
;; A PID is a Nat. ;; A PID is a Nat.
;; A Label is a PID or 'meta. ;; A Label is a PID or 'meta.
@ -155,7 +157,7 @@
(define (clean-transition t) (define (clean-transition t)
(match t (match t
[#f #f] [#f #f]
[(quit actions) (quit (clean-actions actions))] [(quit exn actions) (quit exn (clean-actions actions))]
[(transition state actions) (transition state (clean-actions actions))])) [(transition state actions) (transition state (clean-actions actions))]))
(define (clean-actions actions) (define (clean-actions actions)
@ -172,8 +174,8 @@
(lambda () (clean-transition (ensure-transition (behavior e old-state)))) (lambda () (clean-transition (ensure-transition (behavior e old-state))))
(match-lambda (match-lambda
[#f w] [#f w]
[(and q (quit final-actions)) [(and q (quit exn final-actions))
(trace-process-step-result e pid behavior old-state #f q) (trace-process-step-result e pid behavior old-state exn q)
(enqueue-actions (disable-process pid #f w) pid (append final-actions (enqueue-actions (disable-process pid #f w) pid (append final-actions
(list 'quit)))] (list 'quit)))]
[(and t (transition new-state new-actions)) [(and t (transition new-state new-actions))
@ -222,8 +224,8 @@
(queue-append-list (world-pending-action-queue w) (queue-append-list (world-pending-action-queue w)
(for/list [(a actions)] (cons label a)))])) (for/list [(a actions)] (cons label a)))]))
(define (make-quit . actions) (define (make-quit #:exception [exn #f] . actions)
(quit actions)) (quit exn actions))
(define-syntax-rule (spawn-process behavior-exp initial-state-exp initial-patch-exp ...) (define-syntax-rule (spawn-process behavior-exp initial-state-exp initial-patch-exp ...)
(spawn (lambda () (spawn (lambda ()
@ -261,11 +263,11 @@
(define (transition-bind k t0) (define (transition-bind k t0)
(match t0 (match t0
[#f (error 'transition-bind "Cannot bind from transition #f with continuation ~v" k)] [#f (error 'transition-bind "Cannot bind from transition #f with continuation ~v" k)]
[(quit _) t0] [(quit _ _) t0]
[(transition state0 actions0) [(transition state0 actions0)
(match (k state0) (match (k state0)
[#f t0] [#f t0]
[(quit actions1) (quit (cons actions0 actions1))] [(quit exn actions1) (quit exn (cons actions0 actions1))]
[(transition state1 actions1) (transition state1 (cons actions0 actions1))])])) [(transition state1 actions1) (transition state1 (cons actions0 actions1))])]))
(define (sequence-transitions t0 . steps) (define (sequence-transitions t0 . steps)
@ -397,8 +399,8 @@
(let loop ((w w) (actions '())) (let loop ((w w) (actions '()))
(pretty-print w) (pretty-print w)
(match (world-handle-event #f w) (match (world-handle-event #f w)
[#f (values w (flatten actions))] [#f (values w #f (flatten actions))]
[(quit new-actions) (values w (flatten (cons actions new-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))]))) [(transition new-w new-actions) (loop new-w (cons actions new-actions))])))
(step* (make-world '())) (step* (make-world '()))

2
prospect/endpoint.rkt
View File

@ -115,7 +115,7 @@
(match-define (list e eid ep) task) (match-define (list e eid ep) task)
(match ((handler-getter ep) e (endpoint-group-state g)) (match ((handler-getter ep) e (endpoint-group-state g))
[#f (values cumulative-patch actions g idle?)] [#f (values cumulative-patch actions g idle?)]
[(<quit> ep-acs) (return (quit (filter action? (flatten ep-acs))))] [(<quit> exn ep-acs) (return (quit exn (filter action? (flatten ep-acs))))]
[(transition new-state ep-acs) [(transition new-state ep-acs)
(define-values (cp acs next-g) (define-values (cp acs next-g)
(interpret-endpoint-actions cumulative-patch (interpret-endpoint-actions cumulative-patch