81 lines
2.6 KiB
Racket
81 lines
2.6 KiB
Racket
#lang typed/racket/base
|
|
|
|
(require racket/match)
|
|
(require (prefix-in core: "main.rkt"))
|
|
|
|
(provide transition
|
|
delete-endpoint
|
|
send-message
|
|
send-feedback
|
|
quit
|
|
sequence-actions
|
|
(rename-out [core:wild wild]))
|
|
|
|
(: transition : (All (State) State (core:ActionTree State) * -> (core:Transition State)))
|
|
(define (transition state . actions)
|
|
((inst core:transition State) state actions))
|
|
|
|
(define (delete-endpoint #{id : Any}
|
|
[#{reason : Any} #f])
|
|
(core:delete-endpoint (cast id core:PreEID) (cast reason core:Reason)))
|
|
|
|
(: send-message : (case-> [Any -> core:send-message]
|
|
[Any core:Orientation -> core:send-message]))
|
|
(define (send-message body [#{orientation : core:Orientation} 'publisher])
|
|
(core:send-message (cast body core:Message) orientation))
|
|
|
|
(define (send-feedback #{body : Any})
|
|
(core:send-message (cast body core:Message) 'subscriber))
|
|
|
|
(: quit : (case-> [-> core:quit]
|
|
[(Option core:PID) -> core:quit]
|
|
[(Option core:PID) Any -> core:quit]))
|
|
(define (quit [#{who : (Option core:PID)} (ann #f (Option core:PID))]
|
|
[#{reason : Any} #f])
|
|
(core:quit who (cast reason core:Reason)))
|
|
|
|
(: sequence-actions : (All (State)
|
|
(core:Transition State)
|
|
(U (core:ActionTree State) (State -> (core:Transition State))) *
|
|
-> (core:Transition State)))
|
|
(define (sequence-actions t . more-actions-and-transformers)
|
|
(match-define (core:transition initial-state initial-actions) t)
|
|
(let loop ((state initial-state)
|
|
(actions initial-actions)
|
|
(items more-actions-and-transformers))
|
|
(match items
|
|
['()
|
|
(core:transition state actions)]
|
|
[(cons item remaining-items)
|
|
(if (or (pair? item)
|
|
(eq? item #f)
|
|
(void? item)
|
|
(null? item)
|
|
(core:add-endpoint? item)
|
|
(core:delete-endpoint? item)
|
|
(core:send-message? item)
|
|
(core:spawn? item)
|
|
(core:quit? item)
|
|
(core:yield? item)
|
|
(core:at-meta-level? item))
|
|
;; ^ This is ugly, but necessary to let Typed Racket
|
|
;; correctly deduce the type of item in the expression
|
|
;; (item state) in the false branch of this conditional.
|
|
;; Because the type Action is parameterized, there's no
|
|
;; sensible way of factoring out the big or here into a
|
|
;; reusable predicate.
|
|
(loop state
|
|
((inst cons (core:ActionTree State) (core:ActionTree State))
|
|
actions
|
|
item)
|
|
remaining-items)
|
|
(match (item state)
|
|
[(core:transition new-state more-actions)
|
|
(loop new-state
|
|
(cons actions more-actions)
|
|
remaining-items)]))])))
|
|
|
|
;;; Local Variables:
|
|
;;; eval: (put 'sequence-actions 'scheme-indent-function 1)
|
|
;;; End:
|