Add as-endpoint to allow performing actions as if they came from other endpoints

This commit is contained in:
Tony Garnock-Jones 2015-12-01 17:22:08 -05:00
parent 25fd4fddb7
commit 54b80cf79b
2 changed files with 12 additions and 6 deletions

View File

@ -4,6 +4,7 @@
(provide (struct-out endpoint-group)
(struct-out add-endpoint)
(struct-out delete-endpoint)
(struct-out as-endpoint)
make-endpoint-group
spawn-endpoint-group
boot-endpoint-group
@ -39,9 +40,11 @@
;; A Transition reuses the struct from core, but with EndpointActions instead of plain Actions.
;; An EndpointAction is either an Action, or a
;; (add-endpoint (EID State -> (Values Endpoint Transition))), or a
;; (delete-endpoint EID)
;; (delete-endpoint)
;; (as-endpoint EID EndpointAction)
(struct add-endpoint (function) #:prefab)
(struct delete-endpoint (eid) #:prefab)
(struct delete-endpoint () #:prefab)
(struct as-endpoint (eid action) #:prefab)
(define (make-endpoint-group initial-state)
(endpoint-group 0
@ -67,7 +70,8 @@
(define (endpoint-action? a)
(or (action? a)
(add-endpoint? a)
(delete-endpoint? a)))
(delete-endpoint? a)
(and (as-endpoint? a) (endpoint-action? (as-endpoint-action a)))))
(define (inert-endpoint e state) #f)
@ -155,14 +159,16 @@
[state (transition-state initial-transition)])
new-eid
(transition-actions initial-transition))]
[(delete-endpoint eid)
[(delete-endpoint)
(interpret-endpoint-patch cumulative-patch
actions
(struct-copy endpoint-group g
[endpoints
(hash-remove (endpoint-group-endpoints g) eid)])
eid
(patch (matcher-empty) (pattern->matcher #t ?)))]))
(patch (matcher-empty) (pattern->matcher #t ?)))]
[(as-endpoint other-eid inner-endpoint-action)
(interpret-endpoint-actions cumulative-patch actions g other-eid inner-endpoint-action)]))
(define (interpret-endpoint-actions cumulative-patch actions g eid unflattened-endpoint-actions)
(define endpoint-actions (filter endpoint-action? (flatten unflattened-endpoint-actions)))

View File

@ -10,7 +10,7 @@
(and e (transition (+ u 1)
(if (equal? e (message 2))
(if (equal? eid 0)
(list (unsub 2) (sub 5) (delete-endpoint 1))
(list (unsub 2) (sub 5) (as-endpoint 1 (delete-endpoint)))
(list (unsub 2) (sub 5)))
'()))))