Add as-endpoint to allow performing actions as if they came from other endpoints
This commit is contained in:
parent
25fd4fddb7
commit
54b80cf79b
|
@ -4,6 +4,7 @@
|
||||||
(provide (struct-out endpoint-group)
|
(provide (struct-out endpoint-group)
|
||||||
(struct-out add-endpoint)
|
(struct-out add-endpoint)
|
||||||
(struct-out delete-endpoint)
|
(struct-out delete-endpoint)
|
||||||
|
(struct-out as-endpoint)
|
||||||
make-endpoint-group
|
make-endpoint-group
|
||||||
spawn-endpoint-group
|
spawn-endpoint-group
|
||||||
boot-endpoint-group
|
boot-endpoint-group
|
||||||
|
@ -39,9 +40,11 @@
|
||||||
;; 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
|
||||||
;; (delete-endpoint EID)
|
;; (delete-endpoint)
|
||||||
|
;; (as-endpoint EID EndpointAction)
|
||||||
(struct add-endpoint (function) #:prefab)
|
(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)
|
(define (make-endpoint-group initial-state)
|
||||||
(endpoint-group 0
|
(endpoint-group 0
|
||||||
|
@ -67,7 +70,8 @@
|
||||||
(define (endpoint-action? a)
|
(define (endpoint-action? a)
|
||||||
(or (action? a)
|
(or (action? a)
|
||||||
(add-endpoint? 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)
|
(define (inert-endpoint e state) #f)
|
||||||
|
|
||||||
|
@ -155,14 +159,16 @@
|
||||||
[state (transition-state initial-transition)])
|
[state (transition-state initial-transition)])
|
||||||
new-eid
|
new-eid
|
||||||
(transition-actions initial-transition))]
|
(transition-actions initial-transition))]
|
||||||
[(delete-endpoint eid)
|
[(delete-endpoint)
|
||||||
(interpret-endpoint-patch cumulative-patch
|
(interpret-endpoint-patch cumulative-patch
|
||||||
actions
|
actions
|
||||||
(struct-copy endpoint-group g
|
(struct-copy endpoint-group g
|
||||||
[endpoints
|
[endpoints
|
||||||
(hash-remove (endpoint-group-endpoints g) eid)])
|
(hash-remove (endpoint-group-endpoints g) eid)])
|
||||||
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 (interpret-endpoint-actions cumulative-patch actions g eid unflattened-endpoint-actions)
|
||||||
(define endpoint-actions (filter endpoint-action? (flatten unflattened-endpoint-actions)))
|
(define endpoint-actions (filter endpoint-action? (flatten unflattened-endpoint-actions)))
|
||||||
|
|
|
@ -10,7 +10,7 @@
|
||||||
(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)
|
||||||
(list (unsub 2) (sub 5) (delete-endpoint 1))
|
(list (unsub 2) (sub 5) (as-endpoint 1 (delete-endpoint)))
|
||||||
(list (unsub 2) (sub 5)))
|
(list (unsub 2) (sub 5)))
|
||||||
'()))))
|
'()))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue