From e8d33d4135f0582fa60a0efc0ae320602ee15f0c Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 12 Jul 2016 13:55:59 -0400 Subject: [PATCH] Move from syndicate-monolithic to syndicate/monolithic, in prep for refactoring --- examples/netstack/arp.rkt | 6 ++-- examples/netstack/demo-config.rkt | 2 +- examples/netstack/ethernet.rkt | 5 +-- examples/netstack/fetchurl.rkt | 5 ++- examples/netstack/idle.rkt | 20 ------------ examples/netstack/ip.rkt | 7 +++-- examples/netstack/main.rkt | 6 ++-- examples/netstack/on-claim.rkt | 47 ++++++++++++++++++++++++++++ examples/netstack/port-allocator.rkt | 2 +- examples/netstack/tcp.rkt | 6 ++-- examples/netstack/udp.rkt | 4 +-- 11 files changed, 69 insertions(+), 41 deletions(-) delete mode 100644 examples/netstack/idle.rkt create mode 100644 examples/netstack/on-claim.rkt diff --git a/examples/netstack/arp.rkt b/examples/netstack/arp.rkt index f092adf..97cf773 100644 --- a/examples/netstack/arp.rkt +++ b/examples/netstack/arp.rkt @@ -9,9 +9,9 @@ (require racket/set) (require racket/match) -(require syndicate-monolithic) -(require syndicate-monolithic/drivers/timer) -(require syndicate-monolithic/demand-matcher) +(require syndicate/monolithic) +(require syndicate/drivers/timer) +(require syndicate/demand-matcher) (require bitsyntax) (require "dump-bytes.rkt") diff --git a/examples/netstack/demo-config.rkt b/examples/netstack/demo-config.rkt index faaf221..329a1aa 100644 --- a/examples/netstack/demo-config.rkt +++ b/examples/netstack/demo-config.rkt @@ -2,7 +2,7 @@ ;; Demonstration stack configuration for various hosts. (require racket/match) -(require syndicate-monolithic) +(require syndicate/monolithic) (require (only-in mzlib/os gethostname)) (require "configuration.rkt") diff --git a/examples/netstack/ethernet.rkt b/examples/netstack/ethernet.rkt index d913ba8..c5ecef9 100644 --- a/examples/netstack/ethernet.rkt +++ b/examples/netstack/ethernet.rkt @@ -13,8 +13,9 @@ (require racket/match) (require racket/async-channel) -(require syndicate-monolithic) -(require syndicate-monolithic/demand-matcher) +(require syndicate/monolithic) +(require syndicate/demand-matcher) +(require "on-claim.rkt") (require packet-socket) (require bitsyntax) diff --git a/examples/netstack/fetchurl.rkt b/examples/netstack/fetchurl.rkt index aeaabc8..a88c12f 100644 --- a/examples/netstack/fetchurl.rkt +++ b/examples/netstack/fetchurl.rkt @@ -1,7 +1,6 @@ -#lang syndicate-monolithic +#lang syndicate/monolithic -(require syndicate-monolithic/demand-matcher) -(require syndicate-monolithic/drivers/timer) +(require syndicate/drivers/timer) (require "demo-config.rkt") (require "ethernet.rkt") (require "arp.rkt") diff --git a/examples/netstack/idle.rkt b/examples/netstack/idle.rkt deleted file mode 100644 index f356329..0000000 --- a/examples/netstack/idle.rkt +++ /dev/null @@ -1,20 +0,0 @@ -#lang minimart - -(require minimart/demand-matcher) -(require minimart/drivers/timer) -(require "demo-config.rkt") -(require "ethernet.rkt") -(require "arp.rkt") -(require "ip.rkt") -(require "tcp.rkt") -(require "udp.rkt") - -;;(log-events-and-actions? #t) - -(spawn-timer-driver) -(spawn-ethernet-driver) -(spawn-arp-driver) -(spawn-ip-driver) -(spawn-tcp-driver) -(spawn-udp-driver) -(spawn-demo-config) diff --git a/examples/netstack/ip.rkt b/examples/netstack/ip.rkt index 3191649..6f2e0b3 100644 --- a/examples/netstack/ip.rkt +++ b/examples/netstack/ip.rkt @@ -13,9 +13,9 @@ (require racket/set) (require racket/match) (require (only-in racket/string string-split)) -(require syndicate-monolithic) -(require syndicate-monolithic/drivers/timer) -(require syndicate-monolithic/demand-matcher) +(require syndicate/monolithic) +(require syndicate/drivers/timer) +(require syndicate/demand-matcher) (require bitsyntax) (require "dump-bytes.rkt") @@ -23,6 +23,7 @@ (require "checksum.rkt") (require "ethernet.rkt") (require "arp.rkt") +(require "on-claim.rkt") (struct ip-packet (source-interface ;; string for an ethernet interface, or #f for local interfaces source diff --git a/examples/netstack/main.rkt b/examples/netstack/main.rkt index 980f106..9d694ac 100644 --- a/examples/netstack/main.rkt +++ b/examples/netstack/main.rkt @@ -1,7 +1,7 @@ -#lang syndicate-monolithic +#lang syndicate/monolithic -(require syndicate-monolithic/demand-matcher) -(require syndicate-monolithic/drivers/timer) +(require syndicate/demand-matcher) +(require syndicate/drivers/timer) (require "demo-config.rkt") (require "ethernet.rkt") (require "arp.rkt") diff --git a/examples/netstack/on-claim.rkt b/examples/netstack/on-claim.rkt new file mode 100644 index 0000000..d517518 --- /dev/null +++ b/examples/netstack/on-claim.rkt @@ -0,0 +1,47 @@ +#lang racket/base + +(provide on-claim) + +(require syndicate/monolithic) +(require syndicate/drivers/timer) + +;; (Trie (Option (Setof (Listof Value))) ... -> (Option (Constreeof Action))) +;; Trie Projection ... +;; -> Action +;; Spawns a process that observes the given projections. Any time the +;; environment's interests change in a relevant way, calls +;; check-and-maybe-spawn-fn with the aggregate interests and the +;; projection results. If check-and-maybe-spawn-fn returns #f, +;; continues to wait; otherwise, takes the action(s) returned, and +;; quits. +(define (on-claim #:timeout-msec [timeout-msec #f] + #:on-timeout [timeout-handler (lambda () '())] + #:name [name #f] + check-and-maybe-spawn-fn + base-interests + . projections) + (define timer-id (gensym 'on-claim)) + (define (on-claim-handler e state) + (match e + [(scn new-aggregate) + (define projection-results + (map (lambda (p) (trie-project/set #:take (projection-arity p) new-aggregate p)) + projections)) + (define maybe-spawn (apply check-and-maybe-spawn-fn + new-aggregate + projection-results)) + (if maybe-spawn + (quit maybe-spawn) + #f)] + [(message (timer-expired (== timer-id) _)) + (quit (timeout-handler))] + [_ #f])) + (list + (when timeout-msec (message (set-timer timer-id timeout-msec 'relative))) + (spawn #:name name + on-claim-handler + (void) + (scn/union base-interests + (assertion-set-union* + (map (lambda (p) (subscription (projection->pattern p))) projections)) + (subscription (timer-expired timer-id ?)))))) diff --git a/examples/netstack/port-allocator.rkt b/examples/netstack/port-allocator.rkt index 10daec5..5dc7229 100644 --- a/examples/netstack/port-allocator.rkt +++ b/examples/netstack/port-allocator.rkt @@ -6,7 +6,7 @@ (require racket/set) (require racket/match) -(require syndicate-monolithic) +(require syndicate/monolithic) (require "ip.rkt") (struct port-allocation-request (type k) #:prefab) diff --git a/examples/netstack/tcp.rkt b/examples/netstack/tcp.rkt index b82a942..66ee0ea 100644 --- a/examples/netstack/tcp.rkt +++ b/examples/netstack/tcp.rkt @@ -8,9 +8,9 @@ (require racket/set) (require racket/match) -(require syndicate-monolithic) -(require syndicate-monolithic/drivers/timer) -(require syndicate-monolithic/demand-matcher) +(require syndicate/monolithic) +(require syndicate/drivers/timer) +(require syndicate/demand-matcher) (require bitsyntax) (require "dump-bytes.rkt") diff --git a/examples/netstack/udp.rkt b/examples/netstack/udp.rkt index 7c5c3f0..7cc2726 100644 --- a/examples/netstack/udp.rkt +++ b/examples/netstack/udp.rkt @@ -10,8 +10,8 @@ (require racket/set) (require racket/match) -(require syndicate-monolithic) -(require syndicate-monolithic/demand-matcher) +(require syndicate/monolithic) +(require syndicate/demand-matcher) (require bitsyntax) (require "dump-bytes.rkt")