syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix self- and peer-signalling of observation; generalize broker protocol to permit multiple uses of leaf2 on different nodes; printf -> log-info

This commit is contained in:
Tony Garnock-Jones 2019-05-03 10:25:20 +01:00
parent 38e3894a3d
commit f847f3c049
1 changed files with 31 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
syndicate/broker/tf.rkt
View File

@ -13,9 +13,9 @@
(spawn #:name 'monitor
(on (message (router-outbound $name $body))
(printf "-> ~a : ~v\n" name body))
(log-info "-> ~a : ~v" name body))
(on (message (router-inbound $name $body))
(printf " ~a ->: ~v\n" name body)))
(log-info " ~a ->: ~v" name body)))
(define C (capture (discard)))
@ -53,18 +53,19 @@
)))
(assertion-struct to-broker (node assertion))
(assertion-struct from-broker (node assertion))
(define (leaf2 name node)
(local-require imperative-syndicate/term)
(spawn #:name (list 'leaf2 name)
(assertion-struct to-broker (assertion))
(assertion-struct from-broker (assertion))
;;----------------------------------------
(stop-when (message (terminate name)))
(field [present? #t])
(assert #:when (present?) (to-broker (present name)))
(assert #:when (present?) (to-broker node (present name)))
(on (message (change-presence name $new-presence))
(present? new-presence))
@ -74,29 +75,32 @@
;; interests generated by the way `during` is implemented,
;; only to general ones.
;;
;; (during (from-broker (present $who))
;; (on-start (printf "~a: ~a present\n" name who))
;; (on-stop (printf "~a: ~a absent\n" name who)))
;; (during (from-broker node (present $who))
;; (on-start (log-info "~a: ~a present" name who))
;; (on-stop (log-info "~a: ~a absent" name who)))
(on (asserted (from-broker (present $who))) (printf "~a: ~a present\n" name who))
(on (retracted (from-broker (present $who))) (printf "~a: ~a absent\n" name who))
(on (asserted (from-broker node (present $who))) (log-info "~a: ~a present" name who))
(on (retracted (from-broker node (present $who))) (log-info "~a: ~a absent" name who))
(on (message (from-broker (says $who $what)))
(printf "~a: ~a says ~v\n" name who what))
(on (asserted (from-broker node (observe (present _))))
(log-info "~a: someone cares about presence!" name))
(on (message (from-broker node (says $who $what)))
(log-info "~a: ~a says ~v" name who what))
;;----------------------------------------
(during (to-broker $what)
(during (to-broker node $what)
;; This takes care of the self-signalling discussed above.
(assert (from-broker what)))
(assert (from-broker node what)))
(during (router-connection node name)
(on (message (router-outbound name (Subscribe $subid $spec)))
(react
(define (update-fn)
(values (observe (to-broker spec))
(values (observe (to-broker node spec))
(term->skeleton-interest
(to-broker spec)
(to-broker node spec)
(capture-facet-context
(lambda (op . captures)
(schedule-script!
@ -105,12 +109,14 @@
(define ctor (match op ['+ Add] ['- Del] ['! Msg]))
(send! (router-inbound name (ctor subid captures))))))))))
(add-endpoint! (current-facet) "router" #f update-fn)
(assert (from-broker node (observe spec)))
(stop-when (message (router-outbound name (Unsubscribe subid))))))
(during (observe ($ pat (from-broker $spec)))
(during (observe ($ pat (from-broker node $spec)))
(define ep (gensym 'ep))
(on-start (send! (router-inbound name (Subscribe ep spec))))
(on-stop (send! (router-inbound name (Unsubscribe ep))))
(assert (from-broker node (observe spec))) ;; more self-signalling
(on (message (router-outbound name (Add ep $captures)))
(react (assert (instantiate-term->value pat captures))
(stop-when (message (router-outbound name (Del ep captures))))))
@ -149,17 +155,18 @@
(spawn* (define-syntax-rule (pause n action)
(begin (sleep n)
(newline)
(printf "********** ~v\n" 'action)
(log-info "\n********** ~v" 'action)
action))
(pause 0 (begin (leaf 'c1 'n1)
(leaf2 'c2 'n1)
(leaf 'c3 'n2)
(leaf 'c4 'n2)))
(pause 0 (begin
(leaf 'c1 'n1)
(leaf2 'c2 'n1)
(leaf 'c3 'n2)
(leaf 'c4 'n2)
))
(pause 0.5 (relay 'n1 'n2))
(pause 0.25 (leaf 'c5 'n3))
(pause 0.25 (leaf2 'c5 'n3))
(pause 0.25 (relay 'n2 'n3))
(pause 0.5 'delivery-of-the-says-messages) ;; the newline is important here