2013-03-29 03:00:29 +00:00
|
|
|
#lang typed/racket/base
|
|
|
|
|
|
|
|
(require "../sugar-typed.rkt")
|
|
|
|
|
|
|
|
(provide generic-spy)
|
|
|
|
|
|
|
|
(: generic-spy : (All (ParentState) Any -> (Spawn ParentState)))
|
|
|
|
(define (generic-spy label)
|
2013-06-03 18:57:42 +00:00
|
|
|
(name-process `(generic-spy ,label)
|
|
|
|
(spawn: #:parent : ParentState
|
|
|
|
#:child : Void
|
|
|
|
(transition: (void) : Void
|
|
|
|
(observe-publishers: Void (wild)
|
|
|
|
(match-orientation orientation
|
|
|
|
(match-conversation topic
|
|
|
|
(match-interest-type interest
|
|
|
|
(match-reason reason
|
|
|
|
(on-presence (begin (write `(,label ENTER (,orientation ,topic ,interest)))
|
2013-03-29 03:00:29 +00:00
|
|
|
(newline)
|
|
|
|
(flush-output)
|
2013-06-03 18:57:42 +00:00
|
|
|
'()))
|
|
|
|
(on-absence (begin (write `(,label EXIT (,orientation ,topic ,interest)))
|
2013-03-29 03:00:29 +00:00
|
|
|
(newline)
|
|
|
|
(display reason)
|
|
|
|
(newline)
|
|
|
|
(flush-output)
|
2013-06-03 18:57:42 +00:00
|
|
|
'()))
|
|
|
|
(on-message
|
|
|
|
[p (begin (write `(,label MSG ,p))
|
|
|
|
(newline)
|
|
|
|
(flush-output)
|
|
|
|
'())]))))))))))
|