Remove notion of endpoint pre/peri/post handlers

This commit is contained in:
Tony Garnock-Jones 2015-11-25 11:27:58 -05:00
parent 25489c0043
commit 25fd4fddb7
2 changed files with 14 additions and 36 deletions

View File

@ -8,7 +8,6 @@
spawn-endpoint-group spawn-endpoint-group
boot-endpoint-group boot-endpoint-group
endpoint-action? endpoint-action?
(struct-out endpoint)
endpoint-group-handle-event endpoint-group-handle-event
pretty-print-endpoint-group) pretty-print-endpoint-group)
@ -36,7 +35,7 @@
[(define (prospect-pretty-print g [p (current-output-port)]) [(define (prospect-pretty-print g [p (current-output-port)])
(pretty-print-endpoint-group g p))]) (pretty-print-endpoint-group g p))])
;; A Handler is a (Event State -> Transition) ;; A Endpoint is a (Event State -> Transition)
;; A Transition reuses the struct from core, but with EndpointActions instead of plain Actions. ;; A Transition reuses the struct from core, but with EndpointActions instead of plain Actions.
;; An EndpointAction is either an Action, or a ;; An EndpointAction is either an Action, or a
;; (add-endpoint (EID State -> (Values Endpoint Transition))), or a ;; (add-endpoint (EID State -> (Values Endpoint Transition))), or a
@ -70,18 +69,7 @@
(add-endpoint? a) (add-endpoint? a)
(delete-endpoint? a))) (delete-endpoint? a)))
;; An Endpoint represents the behaviour of an endpoint. (define (inert-endpoint e state) #f)
(struct endpoint (pre-handler ;; Handler
peri-handler ;; Handler
post-handler ;; Handler
) #:transparent)
(define (inert-handler e state) #f)
(define inert-endpoint
(endpoint inert-handler
inert-handler
inert-handler))
(define (endpoint-group-handle-event e g) (define (endpoint-group-handle-event e g)
(match-define (endpoint-group _ routing-table interests endpoints state) g) (match-define (endpoint-group _ routing-table interests endpoints state) g)
@ -91,20 +79,14 @@
[(? patch?) (compute-affected-pids routing-table e)] [(? patch?) (compute-affected-pids routing-table e)]
[(message body) [(message body)
(tset->list (matcher-match-value routing-table (observe body) (datum-tset)))])) (tset->list (matcher-match-value routing-table (observe body) (datum-tset)))]))
(define tasks (for/list [(eid affected-eids)] (sequence-handlers g (for/list [(eid affected-eids)]
(list (if (patch? e) (list (if (patch? e)
(view-patch e (hash-ref interests eid matcher-empty)) (view-patch e (hash-ref interests eid matcher-empty))
e) e)
eid eid
(hash-ref endpoints eid inert-endpoint)))) (hash-ref endpoints eid (lambda () inert-endpoint))))))
(define t0 (transition g '()))
(define t1 (sequence-transitions t0
(sequence-handlers tasks endpoint-pre-handler)
(sequence-handlers tasks endpoint-peri-handler)
(sequence-handlers tasks endpoint-post-handler)))
(if (eq? t1 t0) #f t1))
(define ((sequence-handlers tasks handler-getter) g) (define (sequence-handlers g tasks)
(let/ec return (let/ec return
(define-values (final-cumulative-patch final-actions final-g idle?) (define-values (final-cumulative-patch final-actions final-g idle?)
(for/fold ([cumulative-patch empty-patch] (for/fold ([cumulative-patch empty-patch]
@ -113,7 +95,7 @@
[idle? #t]) [idle? #t])
([task tasks]) ([task tasks])
(match-define (list e eid ep) task) (match-define (list e eid ep) task)
(match ((handler-getter ep) e (endpoint-group-state g)) (match (ep e (endpoint-group-state g))
[#f (values cumulative-patch actions g idle?)] [#f (values cumulative-patch actions g idle?)]
[(<quit> exn ep-acs) (return (<quit> exn (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)

View File

@ -5,8 +5,8 @@
(spawn-timer-driver) (spawn-timer-driver)
(define ((log-it eid stage) e u) (define ((log-it eid) e u)
(log-info "endpoint ~a stage ~a state ~a: ~v" eid stage u e) (log-info "endpoint ~a state ~a: ~v" eid u e)
(and e (transition (+ u 1) (and e (transition (+ u 1)
(if (equal? e (message 2)) (if (equal? e (message 2))
(if (equal? eid 0) (if (equal? eid 0)
@ -25,17 +25,13 @@
(spawn-endpoint-group 0 (spawn-endpoint-group 0
(add-endpoint (add-endpoint
(lambda (eid state) (lambda (eid state)
(values (endpoint (log-it eid "pre") (values (log-it eid)
(log-it eid "peri")
(log-it eid "post"))
(transition state (transition state
(list (sub 1) (list (sub 1)
(sub 2)))))) (sub 2))))))
(add-endpoint (add-endpoint
(lambda (eid state) (lambda (eid state)
(values (endpoint (log-it eid "pre") (values (log-it eid)
(log-it eid "peri")
(log-it eid "post"))
(transition state (transition state
(list (sub 3) (list (sub 3)
(sub 2))))))) (sub 2)))))))