From 062aa9f1e324c7708fe8656d853faf344e29b7a4 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Thu, 26 Apr 2012 13:05:19 -0400
Subject: [PATCH] Remove poorly-thought-out distinction between message topic
 and message body

---
 os2-timer.rkt |  5 +++--
 os2.rkt       | 40 ++++++++++++++++++++++++----------------
 2 files changed, 27 insertions(+), 18 deletions(-)

diff --git a/os2-timer.rkt b/os2-timer.rkt
index 83cc72d..c26c014 100644
--- a/os2-timer.rkt
+++ b/os2-timer.rkt
@@ -102,9 +102,10 @@
   (transition state
     (delete-role 'time-listener)
     (and next
-	 (role 'time-listener (topic-subscriber (timer-evt (pending-timer-deadline next)))
+	 (role 'time-listener (topic-subscriber (cons (timer-evt (pending-timer-deadline next))
+						      (wild)))
 	   #:state state
-	   [now
+	   [(cons (? evt?) now)
 	    (define to-send (fire-timers! (driver-state-heap state) now))
 	    ;; Note: compute to-send before recursing, because of side-effects on heap
 	    (extend-transition (update-time-listener! state) to-send)]))))
diff --git a/os2.rkt b/os2.rkt
index 1cd0ff9..5c7b67e 100644
--- a/os2.rkt
+++ b/os2.rkt
@@ -71,6 +71,11 @@
 ;; A Flow is a Topic that comes from the intersection of two dual
 ;; topics.
 
+;; A sent message includes a "body" and a "role", and is equivalent to
+;; a non-virtual topic with that role and with the given "body" as a
+;; pattern. In a sense, topics quite literally are patterns over
+;; entire messages.
+
 ;; A QuasiQueue<X> is a list of Xs in *reversed* order.
 
 (struct vm (processes ;; Hash<PID, Process>
@@ -114,8 +119,8 @@
 ;; (delete-role PreEID Any)
 (struct delete-role (pre-eid reason) #:prefab)
 ;;
-;; (send-message Any Topic)
-(struct send-message (body topic) #:prefab)
+;; (send-message Any Role)
+(struct send-message (body role) #:prefab)
 ;;
 ;; (spawn BootK Maybe<TrapK<PID>>)
 (struct spawn (main k) #:prefab)
@@ -167,7 +172,7 @@
 (define (make-transition state . actions) (transition state actions))
 (define make-add-role add-role) ;; no special treatment required at present
 (define (make-delete-role pre-eid [reason #f]) (delete-role pre-eid reason))
-(define (make-send-message body [topic (topic-publisher body)]) (send-message body topic))
+(define (make-send-message body [role 'publisher]) (send-message body role))
 (define (make-spawn main [k #f]) (spawn main k))
 (define (make-kill [pid #f] [reason #f]) (kill pid reason))
 
@@ -267,7 +272,7 @@
   (match preaction
     [(add-role pre-eid topics hs) (do-subscribe pid pre-eid (ensure-topic-union topics) hs state)]
     [(delete-role pre-eid reason) (do-unsubscribe pid pre-eid reason state)]
-    [(send-message body topic) (route-and-deliver topic body state)]
+    [(send-message body role) (route-and-deliver role body state)]
     [(spawn main k) (do-spawn pid main k state)]
     [(kill pid-to-kill reason) (do-kill (or pid-to-kill pid) reason state)]))
 
@@ -345,7 +350,8 @@
     (define absence-handler (handlers-absence (endpoint-handlers e)))
     (run-trapk state matching-pid absence-handler outbound-flow reason)))
 
-(define (route-and-deliver message-topic body state)
+(define (route-and-deliver role body state)
+  (define message-topic (topic role body #f))
   (define endpoints
     (for*/set ([(matching-pid p) (in-hash (vm-processes state))]
 	       [matching-eid (in-set (process-endpoints p))]
@@ -454,17 +460,19 @@
        (when (not (null? actions))
 	 (error 'ground-vm "No meta-actions available in ground-vm: ~v" actions))
        (define waiting? (null? (vm-pending-actions state)))
-       (define active-events (for*/list ([(eid e) (in-hash (vm-endpoints state))]
-					 [topic (in-set (endpoint-topics e))]
-					 #:when (and (evt? (topic-pattern topic))
-						     (eq? (topic-role topic)
-							  'subscriber)))
-			       (define evt (topic-pattern topic))
-			       (wrap-evt evt (lambda (message)
-					       (lambda (state)
-						 (route-and-deliver (topic-publisher evt)
-								    message
-								    state))))))
+       (define active-events
+	 (for*/fold ([acc '()])
+	     ([(eid e) (in-hash (vm-endpoints state))]
+	      [active-topic (in-set (endpoint-topics e))])
+	   (match active-topic
+	     [(topic 'subscriber (cons (? evt? evt) _) #f)
+	      (cons (wrap-evt evt (lambda (message)
+				    (lambda (state)
+				      (route-and-deliver 'publisher
+							 (cons evt message)
+							 state))))
+		    acc)]
+	     [_ acc])))
        (if (and waiting? (null? active-events))
 	   'done ;; About to block, and nothing can wake us
 	   (let ((interruptk (apply sync