Move from syndicate-monolithic to syndicate/monolithic, in prep for refactoring

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")

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")
 

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)

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")

examples/netstack/idle.rkt

@@ -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)

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

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")

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 ?))))))

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)

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")

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")