Replace {extend,prefix}-transition{,*} with sequence-actions.

indenting2.el

@@ -1,7 +1,6 @@
 ;; Emacs indent settings
 (progn
   (mapcar #'(lambda (x) (put x 'scheme-indent-function 1))
-	  '(transition extend-transition prefix-transition
+	  '(transition sequence-actions))
-		       extend-transition* prefix-transition*))
   (mapcar #'(lambda (x) (put x 'scheme-indent-function 2))
 	  '(role role/fresh yield)))

os2-example.rkt

@@ -12,7 +12,9 @@
     (role 'sleeper (topic-subscriber (timer-expired id (wild)))
       #:state state
       [(timer-expired (== id) now)
-       (extend-transition (k state) (delete-role id))])))
+       (sequence-actions state
+	 k
+	 (delete-role id))])))
 
 (define (example-process delay)
   (write `(sleeping for ,delay milliseconds))

os2-tcp.rkt

@@ -193,7 +193,7 @@
 	       [(cons _ (? eof-object?))
 		(close-transition state #t)]
 	       [(cons _ (? bytes? bs))
-		(extend-transition (adjust-credit state -1)
+		(sequence-actions (adjust-credit state -1)
 		  (send-message (tcp-channel remote-addr local-addr bs)))])]
 	    [(bytes)
 	     (role 'inbound-relay
@@ -203,7 +203,7 @@
 		(close-transition state #t)]
 	       [(cons _ (? bytes? bs))
 		(define len (bytes-length bs))
-		(extend-transition (adjust-credit state (- len))
+		(sequence-actions (adjust-credit state (- len))
 		  (send-message (tcp-channel remote-addr local-addr bs)))])])))))
   (transition (tcp-connection-state 'bytes 0)
     (role 'explicit-eof-listener (topic-subscriber (cons (eof-evt cin) (wild)))

os2-timer.rkt

@@ -110,7 +110,9 @@
 	   [(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)]))))
+	    (sequence-actions state
+	      update-time-listener!
+	      to-send)]))))
 
 ;; Symbol -> BootK
 ;; Process for mapping this-level timer requests to meta-level timer

os2.rkt

@@ -23,10 +23,15 @@
 
 	 (except-out (struct-out transition) transition)
 	 (rename-out [make-transition transition])
-	 extend-transition
+	 transition/c
-	 extend-transition*
+	 state/c
-	 prefix-transition
+	 action/c
-	 prefix-transition*
+	 action-tree/c
+
+	 (contract-out (sequence-actions (->* (transition/c)
+					      #:rest (listof (or/c action-tree/c
+								   (state/c . -> . transition/c)))
+					      transition/c)))
 
 	 role
 	 role/fresh
@@ -154,6 +159,11 @@
 ;; QuasiQueue.
 (struct transition (state actions) #:transparent)
 
+;; Transition -> (transition ConsTreeOf<Action>)
+(define (maybe-transition->transition t)
+  (cond [(transition? t) t]
+	[else (transition t '())]))
+
 ;; Preactions.
 ;; Ks are various TrapKs or #f, signifying lack of interest.
 ;;
@@ -172,11 +182,27 @@
 ;; (kill Maybe<PID> Any)
 (struct kill (pid reason) #:prefab)
 
+(define (preaction? a)
+  (or (add-role? a)
+      (delete-role? a)
+      (send-message? a)
+      (spawn? a)
+      (kill? a)))
+
 ;; An Action is either a Preaction or a (yield InterruptK) or an
-;; (at-meta-level Preaction).
+;; (at-meta-level Preaction) or an ignored placeholder (namely #f or
+;; (void)).
 (struct yield (k) #:prefab)
 (struct at-meta-level (preaction) #:prefab)
 
+(define (action? a)
+  (or (preaction? a)
+      (yield? a)
+      (eq? a #f)
+      (void? a)
+      (and (at-meta-level? a)
+	   (preaction? (at-meta-level-preaction a)))))
+
 ;; A Monitor instance describes the presence of a whole process, as a
 ;; convention.
 ;;
@@ -233,6 +259,15 @@
 ;; Smarter constructors for transitions and preactions.
 
 (define (make-transition state . actions) (transition state actions))
+
+(define transition/c (or/c transition? any/c))
+(define state/c (not/c transition?))
+(define action/c action?)
+(define action-tree/c (flat-rec-contract action-tree/c
+					 (or action/c
+					     null?
+					     (cons/c action-tree/c action-tree/c))))
+
 (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 [role 'publisher]) (send-message body role))
@@ -250,7 +285,7 @@
 	(let ((unmonitored-main (if (procedure? raw-main) raw-main (lambda (self-pid) raw-main))))
 	  (lambda (self-pid)
 	    (define m (monitor self-pid debug-name))
-	    (prefix-transition (unmonitored-main self-pid)
+	    (sequence-actions (unmonitored-main self-pid)
 	      (role (list 'canary m) (topic-publisher m) #:state state))))
 	raw-main))
   (define final-contract
@@ -264,30 +299,6 @@
 	(boot-specification maybe-monitored-main final-contract)))
   (spawn spec k debug-name))
 
-(define (extend-transition t . more-actions)
-  (match t
-    [(transition state actions) (transition state (list actions more-actions))]
-    [state (transition state more-actions)]))
-
-(define (extend-transition* t fn)
-  (match t
-    [(transition state actions)
-     (prefix-transition (fn state) actions)]
-    [state
-     (fn state)]))
-
-(define (prefix-transition t . more-actions)
-  (match t
-    [(transition state actions) (transition state (list more-actions actions))]
-    [state (transition state more-actions)]))
-
-(define (prefix-transition* t fn)
-  (match t
-    [(transition state actions)
-     (extend-transition (fn state) actions)]
-    [state
-     (fn state)]))
-
 ;;---------------------------------------------------------------------------
 ;; Topics and roles
 
@@ -333,6 +344,28 @@
   (or (topic-virtual? local-topic)
       (not (topic-virtual? remote-topic))))
 
+;;---------------------------------------------------------------------------
+;; Composing state transitions and action emissions.
+
+(define (sequence-actions t . more-actions-and-transformers)
+  (match-define (transition initial-state initial-actions) (maybe-transition->transition t))
+  (let loop ((state initial-state)
+	     (actions initial-actions)
+	     (items more-actions-and-transformers))
+    (match items
+      ['()
+       (transition state actions)]
+      [(cons (? procedure? transformer) remaining-items)
+       (match-define (transition new-state more-actions)
+	 (maybe-transition->transition (transformer state)))
+       (loop new-state
+	     (cons actions more-actions)
+	     remaining-items)]
+      [(cons additional-action-or-actions remaining-items)
+       (loop state
+	     (cons actions additional-action-or-actions)
+	     remaining-items)])))
+
 ;;---------------------------------------------------------------------------
 ;; Core virtualizable virtual machine.
 
@@ -532,10 +565,6 @@
     (match-define (endpoint (eid pid _) _ (handlers _ _ message-handler)) e)
     (run-trapk state pid eid message-handler message-topic body)))
 
-(define (maybe-transition->transition t)
-  (cond [(transition? t) t]
-	[else (transition t '())]))
-
 (define (do-spawn spawning-pid spec k debug-name state)
   (define new-pid (vm-next-process-id state))
   (define new-name (or debug-name new-pid))
@@ -620,24 +649,11 @@
 						   [state new-state]
 						   [responsible-party new-party]))))
 
-(define (preaction? a)
-  (or (add-role? a)
-      (delete-role? a)
-      (send-message? a)
-      (spawn? a)
-      (kill? a)))
-
-(define (action? a)
-  (or (preaction? a)
-      (yield? a)
-      (and (at-meta-level? a)
-	   (preaction? (at-meta-level-preaction a)))))
-
 (define (valid-action? pid a)
   (cond
-   [(action? a)]
    [(eq? a #f) #f] ;; skip falses in action ConsTrees
    [(void? a) #f] ;; skip voids in action ConsTrees
+   [(action? a)]
    [else (log-warning (format "Illegal action ~v from pid ~v" a pid))
 	 #f]))