Clean up contract-like transition-checking.

This commit is contained in:
Tony Garnock-Jones 2014-06-21 07:33:12 -04:00
parent b4e2e28027
commit d17f7bdeb4
1 changed files with 12 additions and 9 deletions

View File

@ -213,7 +213,7 @@
(define (trigger-guard-handle e s0) (define (trigger-guard-handle e s0)
(match-define (trigger-guard old-gestalt handler old-state) s0) (match-define (trigger-guard old-gestalt handler old-state) s0)
(define (deliver s) (define (deliver s)
(match (handler e old-state) (match (ensure-transition (handler e old-state))
[#f [#f
(if (eq? s s0) #f (transition s '()))] (if (eq? s s0) #f (transition s '()))]
[(transition new-state actions) [(transition new-state actions)
@ -301,14 +301,17 @@
(pid-stack) (pid-stack)
(exn->string exn)) (exn->string exn))
(transition (process-state p) (list (quit))))]) (transition (process-state p) (list (quit))))])
(match (with-continuation-mark 'minimart-process (ensure-transition (with-continuation-mark 'minimart-process
pid ;; TODO: debug-name, other user annotation pid ;; TODO: debug-name, other user annotation
((process-behavior p) e (process-state p))) ((process-behavior p) e (process-state p)))))))
[#f #f] ;; inert.
[(? transition? t) t] ;; potentially runnable. ;; Any -> (Option Transition)
[x ;; If its argument is non-#f, non-transition, raises an exception.
(log-error "Process ~a returned non-#f, non-transition: ~v" (pid-stack) x) (define (ensure-transition v)
(transition (process-state p) (list (quit)))])))) (if (or (not v) (transition? v))
v
(raise (exn:fail:contract (format "Expected transition (or #f); got ~v" v)
(current-continuation-marks)))))
;; World PID -> World ;; World PID -> World
;; Marks the given PID as not-provably-inert. ;; Marks the given PID as not-provably-inert.