From df3d76ae260cd785bd3292bb148921c203917e13 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sat, 24 Mar 2012 19:23:27 -0400
Subject: [PATCH] Cosmetic (and remove quasi-queue definitions)

---
 os2.rkt | 53 +++++++++++++++--------------------------------------
 1 file changed, 15 insertions(+), 38 deletions(-)

diff --git a/os2.rkt b/os2.rkt
index 4f098e4..8f4f950 100644
--- a/os2.rkt
+++ b/os2.rkt
@@ -103,6 +103,7 @@
 (struct at-meta-level (preaction) #:prefab)
 
 ;;---------------------------------------------------------------------------
+;; role macro
 
 (require (for-syntax syntax/parse))
 (require (for-syntax racket/base))
@@ -152,6 +153,9 @@
 		       (handlers presence-handler absence-handler message-handler)
 		       ready-handler)))])))
 
+;;---------------------------------------------------------------------------
+;; Smarter constructors for transitions and preactions.
+
 (define (make-transition state . actions) (transition state actions))
 (define (make-add-role topic handlers [k #f]) (add-role topic handlers k))
 (define (make-delete-role eid [reason #f]) (delete-role eid reason))
@@ -202,48 +206,25 @@
       (not (topic-virtual? remote-topic))))
 
 ;;---------------------------------------------------------------------------
-
-;; QuasiQueue<X>
-(define empty-quasi-queue '())
-
-;; QuasiQueue<X> -> Boolean
-(define quasi-queue-empty? null?)
-
-;; X QuasiQueue<X> -> QuasiQueue<X>
-(define (quasi-enqueue-one thing existing-quasi-queue)
-  (cons thing existing-quasi-queue))
-
-;; List<X> QuasiQueue<X> -> QuasiQueue<X>
-(define (quasi-enqueue-many many-things-in-order existing-quasi-queue)
-  (append (reverse many-things-in-order) existing-quasi-queue))
-
-;; QuasiQueue<X> -> List<X>
-(define (quasi-queue->list quasi-queue)
-  (reverse quasi-queue))
-
-;; List<X> -> QuasiQueue<X>
-(define (list->quasi-queue xs)
-  (reverse xs))
-
-;;---------------------------------------------------------------------------
+;; Core virtualizable virtual machine.
 
 (define (make-vm boot)
   (vm (hash)
       (hash)
       0
-      (list->quasi-queue (list (cons -1 (spawn boot #f))))))
+      (list (cons -1 (spawn boot #f)))))
 
 (define (run-vm state)
-  (let loop ((remaining-actions (quasi-queue->list (vm-pending-actions state)))
-	     (state (struct-copy vm state [pending-actions empty-quasi-queue]))
-	     (outbound-actions empty-quasi-queue))
+  (let loop ((remaining-actions (reverse (vm-pending-actions state)))
+	     (state (struct-copy vm state [pending-actions '()]))
+	     (outbound-actions '()))
     (match remaining-actions
-      ['() (transition state (quasi-queue->list outbound-actions))]
+      ['() (transition state (reverse outbound-actions))]
       [(cons (cons pid action) rest)
        (match action
 	 [(at-meta-level preaction)
 	  (define transformed-preaction (transform-meta-action pid preaction))
-	  (loop rest state (quasi-enqueue-one transformed-preaction outbound-actions))]
+	  (loop rest state (cons transformed-preaction outbound-actions))]
 	 [preaction
 	  (loop rest (perform-action pid preaction state) outbound-actions)])])))
 
@@ -394,8 +375,8 @@
 
 (define (enqueue-actions state pid actions)
   (struct-copy vm state
-	       [pending-actions (quasi-enqueue-many (for/list ([a (flatten actions)]) (cons pid a))
-						    (vm-pending-actions state))]))
+	       [pending-actions (append (reverse (for/list ([a (flatten actions)]) (cons pid a)))
+					(vm-pending-actions state))]))
 
 (define (wrap-trapk pid trapk)
   (lambda args
@@ -425,7 +406,7 @@
       [(transition state actions)
        (when (not (null? actions))
 	 (error 'ground-vm "No meta-actions available in ground-vm: ~v" actions))
-       (define waiting? (quasi-queue-empty? (vm-pending-actions state)))
+       (define waiting? (null? (vm-pending-actions state)))
        (define active-events (for/list ([(eid e) (in-hash (vm-endpoints state))]
 					#:when (and (evt? (topic-pattern (endpoint-topic e)))
 						    (eq? (topic-role (endpoint-topic e))
@@ -437,14 +418,10 @@
 								    message
 								    state))))))
        (if (and waiting? (null? active-events))
-	   ;; About to block, and nothing can wake us
-	   'done
+	   'done ;; About to block, and nothing can wake us
 	   (let ((interruptk (apply sync
 				    (if waiting?
 					never-evt
 					(wrap-evt always-evt (lambda (dummy) values)))
 				    active-events)))
 	     (loop (interruptk state))))])))
-
-;;(require racket/trace)
-;;(trace perform-action)
\ No newline at end of file