60 lines
1.7 KiB
Racket
60 lines
1.7 KiB
Racket
#lang syndicate
|
|
|
|
(require syndicate/firewall)
|
|
|
|
(struct m (b) #:prefab)
|
|
(struct a (v) #:prefab)
|
|
|
|
(spawn (on (message (m $b))
|
|
(printf "Message: ~v\n" b))
|
|
(on (asserted (a $v))
|
|
(printf "Asserted: ~v\n" v))
|
|
(on (retracted (a $v))
|
|
(printf "Retracted: ~v\n" v)))
|
|
|
|
(firewall [(allow (observe (m 'ok1)))
|
|
(allow (observe (a 'ok1)))]
|
|
(on (asserted $x)
|
|
(printf "Observed assertion ~v\n" x))
|
|
(on (retracted $x)
|
|
(printf "Observed retraction ~v\n" x))
|
|
(on (message $x)
|
|
(printf "Observed message ~v\n" x)))
|
|
|
|
(firewall [(allow (m 'ok1))
|
|
(allow (m 'ok2))]
|
|
(on-start (send! (m 'ok1))
|
|
(send! (m 'ok2))
|
|
(send! (m 'must-not-allow))))
|
|
|
|
(firewall [(allow (m ?))
|
|
(forbid (m 'must-not-allow))]
|
|
(on-start (send! (m 'ok1))
|
|
(send! (m 'ok2))
|
|
(send! (m 'must-not-allow))))
|
|
|
|
(firewall [(allow (a 'ok1))
|
|
(allow (a (list ?)))
|
|
(forbid (a (list 'forbidden)))
|
|
(allow (a 'ok2))]
|
|
(assert (a 'ok1))
|
|
(assert (a 'ok2))
|
|
(assert (a (list 'ok3)))
|
|
(assert (a (list 'forbidden))))
|
|
|
|
(firewall [(allow (a 'ok-wild1))
|
|
(allow (a 'ok-wild2))]
|
|
(assert (a _)))
|
|
|
|
(firewall [(allow (a 'ok-kid))]
|
|
(assert (a 'forbidden-parent))
|
|
(on-start (spawn (assert (a _)))))
|
|
|
|
(firewall [(allow (a 'ok-kid2))
|
|
(allow (a 'ok-parent2))]
|
|
(assert (a 'ok-parent2))
|
|
(assert (a 'forbidden-parent2))
|
|
(on-start (firewall [(allow ?)
|
|
(forbid (a 'ok-parent2))]
|
|
(assert (a _)))))
|