Factor out processing of coordinate pairs from SPROUTS-LOOP

src/dryad.lisp

@@ -140,11 +140,15 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
                  (push ids pairs))
                 (t
                  (error "Two distinct match edges laid claim to the same vertex.")))))
-          (assert (= (length pairs) (/ (length addresses) 2)))
-          (dolist (pair pairs)
-            (send-message (dryad-match-address dryad)
-                          (make-message-reap :ids pair)))
-          (process-continuation dryad `(WIND-DOWN)))))))
+          (process-continuation dryad
+                                `(PROCESS-PAIRS ,pairs)
+                                `(WIND-DOWN)))))))
+
+(define-process-upkeep ((dryad dryad) now) (PROCESS-PAIRS pairs)
+  "Iterates through `PAIRS' and sends corresponding REAP messages."
+  (dolist (pair pairs)
+    (send-message (dryad-match-address dryad)
+                  (make-message-reap :ids pair))))
 
 (define-process-upkeep ((dryad dryad) now) (SEND-EXPAND sprout)
   "Directs SPROUT to perform blossom expansion."
@@ -157,12 +161,16 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
     ;; and directly expand it if appropriate.
     (sync-rpc (make-message-blossom-parent)
         (topmost sprout)
-      (sync-rpc (make-message-values :values '(children parent))
-          ((children parent) topmost)
+      (sync-rpc (make-message-values :values '(children parent match-edge))
+          ((children parent match-edge) topmost)
         (when (or children parent)
           (log-entry :entry-type 'aborting-dryad-expansion
                      :reason 'tree-structure))
         (unless (or children parent)
+          (log-entry :entry-type 'dryad-sending-expand
+               :sprout sprout
+               :topmost topmost
+               :match-edge match-edge)
           (sync-rpc (make-message-expand)
               (expand-reply topmost)
             nil))))))

src/logger.lisp

@@ -100,6 +100,12 @@
                   (eql 'REWINDING (getf entry ':entry-type)))
              (and (eql 'SUPERVISOR (getf entry ':source-type))
                   (eql 'MULTIREWEIGHTING (getf entry ':entry-type)))
-             (and (eql 'message-wilt (type-of (getf entry ':payload))))
-             (and (eql 'HANDLING-SOW (getf entry ':entry-type))))
+             (and (eql 'MESSAGE-WILT (type-of (getf entry ':payload))))
+             (and (eql 'HANDLING-SOW (getf entry ':entry-type)))
+             ;; dryad expansion
+             (and (eql 'COMMAND (getf entry ':entry-type))
+                  (eql 'SEND-EXPAND (getf entry ':command)))
+             (and (eql 'DRYAD-SENDING-EXPAND (getf entry ':entry-type)))
+             (and (eql 'SPAWNED-FRESH-BLOSSOM (getf entry ':entry-type)))
+             (and (eql 'BLOSSOM-EXTINGUISHED (getf entry ':entry-type))))
          (push entry entries))))))

src/operations/contract.lisp

@@ -103,6 +103,8 @@ PETAL-CHILD-EDGES: The list of child edges attached to the blossoms in the subtr
                                          :paused? t
                                          :debug? (process-debug? supervisor))))
       (schedule fresh-blossom now)
+      (log-entry :entry-type 'spawned-fresh-blossom
+                 :fresh-blossom fresh-blossom)
       (push (make-data-frame-contract
              :fresh-blossom (process-public-address fresh-blossom)
              :pong (data-frame-supervisor-pong supervisor-frame))

src/operations/expand.lisp

@@ -388,4 +388,6 @@ In the right diagram, b0 is both the `root-node' and the `matched-node', because
   ;; NOTE: There's no data frame to pop.
   (when reply-channel
     (send-message reply-channel (make-message-rpc-done)))
+  (log-entry :entry-type 'blossom-extinguished
+             :blossom node)
   (setf (blossom-node-wilting node) t))