From 8c36deafc8b9832966ebaefd8e66c24e87c6f330 Mon Sep 17 00:00:00 2001
From: Peter Karalekas <peter@karalekas.com>
Date: Wed, 8 Nov 2023 21:39:58 -0800
Subject: [PATCH 1/2] Better logging for (dryad) expansion

---
 src/dryad.lisp               |  8 ++++++--
 src/logger.lisp              | 10 ++++++++--
 src/operations/contract.lisp |  2 ++
 src/operations/expand.lisp   |  2 ++
 4 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/src/dryad.lisp b/src/dryad.lisp
index fc0e4d7..0cc370f 100644
--- a/src/dryad.lisp
+++ b/src/dryad.lisp
@@ -157,12 +157,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))))))
diff --git a/src/logger.lisp b/src/logger.lisp
index e7ca93f..78cadbe 100644
--- a/src/logger.lisp
+++ b/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))))))
diff --git a/src/operations/contract.lisp b/src/operations/contract.lisp
index c7b2b2d..06f3da0 100644
--- a/src/operations/contract.lisp
+++ b/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))
diff --git a/src/operations/expand.lisp b/src/operations/expand.lisp
index 971eb62..ced20dc 100644
--- a/src/operations/expand.lisp
+++ b/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))

From 1435907bd89d28a462d390026848634bf5f16577 Mon Sep 17 00:00:00 2001
From: Peter Karalekas <peter@karalekas.com>
Date: Thu, 9 Nov 2023 23:24:40 -0800
Subject: [PATCH 2/2] Factor out the processing of coordinate pairs from
 SPROUTS-LOOP

---
 src/dryad.lisp | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/src/dryad.lisp b/src/dryad.lisp
index 0cc370f..fce166d 100644
--- a/src/dryad.lisp
+++ b/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."