drop now arg from event callback

Author: ecpeterson

src/dryad.lisp

@@ -59,7 +59,7 @@
 ;;;
 
 (define-message-handler handler-message-sow
-    ((dryad dryad) (message message-sow) now)
+    ((dryad dryad) (message message-sow))
   "Adjoin a new node to the problem graph.
 
 NOTE: In the basic implementation, these messages must be waiting for the DRYAD on launch."
@@ -72,12 +72,12 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
     (log-entry :entry-type 'handling-sow
                :address node-address
                :id node-id)
-    (schedule node-process now)
+    (schedule node-process (now))
     (setf (gethash node-address (dryad-ids       dryad)) node-id
           (gethash node-address (dryad-sprouted? dryad)) nil)))
 
 (define-message-handler handler-message-discover
-    ((dryad dryad) (message message-discover) now)
+    ((dryad dryad) (message message-discover))
   "Handles a DISCOVER message, sent by a BLOSSOM-NODE which expects a list of other BLOSSOM-NODE addresses to which it should send PINGs."
   (let ((channels
           (loop :for address :being :the :hash-keys :of (dryad-ids dryad)
@@ -91,7 +91,7 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
                                           :id (message-discover-id message)))))
 
 (define-message-handler handler-message-sprout
-    ((dryad dryad) (message message-sprout) now)
+    ((dryad dryad) (message message-sprout))
   "Handles a SPROUT message, indicating that a BLOSSOM-NODE has been matched (for the first time)."
   (with-slots (address) message
     (a:when-let ((id (gethash address (dryad-ids dryad))))
@@ -101,7 +101,7 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
       (setf (gethash address (dryad-sprouted? dryad)) t))))
 
 (define-rpc-handler handler-message-wilting
-    ((dryad dryad) (message message-wilting) now)
+    ((dryad dryad) (message message-wilting))
   "Handles a wilting message, indicating that a BLOSSOM-NODE is dying."
   (with-slots (address) message
     (let ((id (gethash address (dryad-ids dryad))))
@@ -123,11 +123,11 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
 ;;; DRYAD command definitions
 ;;;
 
-(define-process-upkeep ((dryad dryad) now) (START)
+(define-process-upkeep ((dryad dryad)) (START)
   "Start listening for ripe sprouted pairs."
   (process-continuation dryad `(SPROUTS-LOOP)))
 
-(define-process-upkeep ((dryad dryad) now) (SPROUTS-LOOP)
+(define-process-upkeep ((dryad dryad)) (SPROUTS-LOOP)
   "Loop over sprouted nodes, looking for ripe pairs."
   ;; if not everyone is sprouted, hold off
   ;; NB: the loop returns T if the hash table is empty, so we additionally
@@ -188,7 +188,7 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
                                 `(PROCESS-PAIRS ,pairs)
                                 `(WIND-DOWN)))))))
 
-(define-process-upkeep ((dryad dryad) now) (PROCESS-PAIRS pairs)
+(define-process-upkeep ((dryad dryad)) (PROCESS-PAIRS pairs)
   "Iterates through `PAIRS' of addresses and sends corresponding WILT and REAP messages."
   (dolist (address-pair pairs)
     (log-entry :entry-type 'processing-pair
@@ -199,7 +199,7 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
       (send-message (dryad-match-address dryad)
                     (make-message-reap :ids id-pair)))))
 
-(define-process-upkeep ((dryad dryad) now) (SEND-EXPAND sprout)
+(define-process-upkeep ((dryad dryad)) (SEND-EXPAND sprout)
   "Directs SPROUT to perform blossom expansion."
   (unless (process-lockable-aborting? dryad)
     ;; if we directly send the sprout a blossom-expand message, it will
@@ -225,6 +225,6 @@ NOTE: In the basic implementation, these messages must be waiting for the DRYAD
                (expand-reply topmost)
              nil)))))))
 
-(define-process-upkeep ((dryad dryad) now) (WIND-DOWN &optional (counter 50))
+(define-process-upkeep ((dryad dryad)) (WIND-DOWN &optional (counter 50))
   (unless (zerop counter)
     (process-continuation dryad `(WIND-DOWN ,(1- counter)))))

src/lock.lisp

@@ -12,7 +12,7 @@
   (mapcar #'blossom-edge-target-node (union (blossom-node-petals node)
                                             (blossom-node-children node))))
 
-(define-process-upkeep ((node blossom-node) now)
+(define-process-upkeep ((node blossom-node))
     (aether::%FINISH-UNLOCK)
   (setf (blossom-node-pingable node) ':ALL)
   (setf (blossom-node-held-by-roots node) nil)
@@ -27,7 +27,7 @@
 ;;;
 
 (define-message-handler handle-message-lock
-    ((node blossom-node) (message message-lock) now)
+    ((node blossom-node) (message message-lock))
   "Prepares a BLOSSOM-NODE to be locked."
   (when (blossom-node-wilting node)
     (send-message (message-reply-channel message)
@@ -41,7 +41,7 @@
 ;;; supervisor command definitions
 ;;;
 
-(define-process-upkeep ((supervisor supervisor) now)
+(define-process-upkeep ((supervisor supervisor))
     (BROADCAST-UNLOCK &key destroy? &allow-other-keys)
   "Cleans up after BROADCAST-LOCK."
   (with-slots (aborting? done-signal downward-rx-latches downward-tx-latches upward-tx-latch) supervisor

src/node.lisp

@@ -282,7 +282,7 @@ evalutes to
     (if (string< x y) x y)))
 
 (define-message-subordinate handle-message-id-query
-    ((node blossom-node) (message message-id-query) now)
+    ((node blossom-node) (message message-id-query))
   "Replies with the minimum ID at this macrovertex."
   (cond
     ((null (blossom-node-petals node))
@@ -306,7 +306,7 @@ evalutes to
 ;; tree to respond to a safe subset (or to all) of PING requests.
 
 (define-broadcast-handler handle-message-broadcast-pingability
-    ((node blossom-node) (message message-broadcast-pingability) now)
+    ((node blossom-node) (message message-broadcast-pingability))
   "Changes the pingability of `NODE' (and children / petals) to `PING-TYPE'."
   (with-slots (ping-type) message
     (log-entry :entry-type 'changing-pingability
@@ -325,7 +325,7 @@ evalutes to
 ;;     better to implement the micromessages after all.
 
 (define-rpc-handler handle-message-set
-    ((node blossom-node) (message message-set) now)
+    ((node blossom-node) (message message-set))
   "Handles a remote SETF request."
   (with-slots (slots values) message
     (loop :for slot :in slots
@@ -334,14 +334,14 @@ evalutes to
     (values)))
 
 (define-rpc-handler handle-message-push
-    ((node blossom-node) (message message-push) now)
+    ((node blossom-node) (message message-push))
   "Handles a remote PUSH request."
   (with-slots (slot value) message
     (push value (slot-value node slot))
     (values)))
 
 (define-rpc-handler handle-message-values
-    ((node blossom-node) (message message-values) now)
+    ((node blossom-node) (message message-values))
   "Handles a remote request for data."
   (with-slots (values) message
     (loop :for value :in values
@@ -355,7 +355,7 @@ evalutes to
 ;; and should halt its process.
 
 (define-message-handler handle-message-sprout-on-blossom
-    ((node blossom-node) (message message-sprout) now)
+    ((node blossom-node) (message message-sprout))
   "Handles a request that a root node (perhaps not a vertex) alert the DRYAD that it has sprouted."
   (cond
     ((blossom-node-petals node)
@@ -367,7 +367,7 @@ evalutes to
                    (make-message-sprout :address (process-public-address node))))))
 
 (define-message-handler handle-message-wilt
-    ((node blossom-node) (message message-wilt) now)
+    ((node blossom-node) (message message-wilt))
   ;; sanity check: are we actually allowed to wilt?
   (when (or (blossom-node-parent node)
             (blossom-node-pistil node)
@@ -443,11 +443,11 @@ evalutes to
 ;;; basic command definitions for BLOSSOM-NODE
 ;;;
 
-(define-process-upkeep ((node blossom-node) now) (START)
+(define-process-upkeep ((node blossom-node)) (START)
   "Blossom nodes represent (contracted subgraphs of) vertex(es).  The START command drops the blossom node into an infinite loop, SCAN-LOOP, which enacts the basic behavior."
   (process-continuation node `(SCAN-LOOP)))
 
-(define-process-upkeep ((node blossom-node) now) (SCAN-LOOP &optional repeat?)
+(define-process-upkeep ((node blossom-node)) (SCAN-LOOP &optional repeat?)
   "If we're out of things to do & unmatched, consider starting a SCAN.  If REPEAT? is set, then this is  _not_ our first time trying to SCAN to find something to do, and the previous attempt(s) resulted in no action."
   (unless (blossom-node-wilting node)
     (process-continuation node `(SCAN-LOOP))
@@ -466,7 +466,7 @@ evalutes to
                          :repeat? repeat?)))
       (process-continuation node `(START-SCAN ,scan-message)))))
 
-(define-process-upkeep ((node blossom-node) now) (IDLE)
+(define-process-upkeep ((node blossom-node)) (IDLE)
   (unless (blossom-node-wilting node)
     (process-continuation node `(IDLE))
     (wake-on-network)))

src/operations/augment.lisp

@@ -43,7 +43,7 @@
 ;;; supervisor command definitions
 ;;;
 
-(define-process-upkeep ((supervisor supervisor) now) (START-AUGMENT pong)
+(define-process-upkeep ((supervisor supervisor)) (START-AUGMENT pong)
   "Sets up the augmentation procedure."
   (with-slots (edges source-root target-root) pong
     (let* ((edge (first edges))
@@ -59,7 +59,7 @@
                             `(BROADCAST-UNLOCK :destroy? ,T)
                             `(HALT)))))
 
-(define-process-upkeep ((supervisor supervisor) now) (AUGMENT edge)
+(define-process-upkeep ((supervisor supervisor)) (AUGMENT edge)
   "Perform an augmentation along a given edge."
   (unless (process-lockable-aborting? supervisor)
     (log-entry :entry-type 'augment
@@ -82,7 +82,7 @@
 ;;;
 
 (define-message-handler handle-message-percolate
-    ((node blossom-node) (message message-percolate) now)
+    ((node blossom-node) (message message-percolate))
   "Performs a step in the path augmentation process."
   (with-slots (traversal-edge reply-channel) message
     ;; does the previous node expect me to link to it?

src/operations/contract.lisp

@@ -78,7 +78,7 @@ PETAL-CHILD-EDGES: The list of child edges attached to the blossoms in the subtr
 ;;; supervisor command definitions
 ;;;
 
-(define-process-upkeep ((supervisor supervisor) now) (START-CONTRACT pong)
+(define-process-upkeep ((supervisor supervisor)) (START-CONTRACT pong)
   "Begins the CONTRACT routine, sets up the stack frames."
   (with-slots (source-root) pong
     (let ((targets (list source-root)))
@@ -93,7 +93,7 @@ PETAL-CHILD-EDGES: The list of child edges attached to the blossoms in the subtr
                             `(BROADCAST-UNLOCK)
                             `(HALT)))))
 
-(define-process-upkeep ((supervisor supervisor) now) (START-INNER-CONTRACT)
+(define-process-upkeep ((supervisor supervisor)) (START-INNER-CONTRACT)
   "Begins the critical section of the CONTRACT routine."
   (unless (process-lockable-aborting? supervisor)
     (let* ((supervisor-frame (peek (process-data-stack supervisor)))
@@ -102,7 +102,7 @@ PETAL-CHILD-EDGES: The list of child edges attached to the blossoms in the subtr
                                          ;; prevent SCANs
                                          :paused? t
                                          :debug? (process-debug? supervisor))))
-      (schedule fresh-blossom now)
+      (schedule fresh-blossom (now))
       (log-entry :entry-type 'spawned-fresh-blossom
                  :fresh-blossom fresh-blossom)
       (push (make-data-frame-contract
@@ -120,20 +120,20 @@ PETAL-CHILD-EDGES: The list of child edges attached to the blossoms in the subtr
                             `(BROADCAST-UNLOCK) ; NOTE: double-calling BROADCAST-UNLOCK makes
                             `(RELEASE-STOWED-LOCK))))) ; the second one a NOP.
 
-(define-process-upkeep ((supervisor supervisor) now) (STOW-LOCK)
+(define-process-upkeep ((supervisor supervisor)) (STOW-LOCK)
   (with-slots (downward-rx-latches downward-tx-latches) supervisor
     (with-slots (stowed-rx-latch stowed-tx-latch) (peek (process-data-stack supervisor))
       (setf stowed-rx-latch (pop downward-rx-latches)
             stowed-tx-latch (pop downward-tx-latches)))))
 
-(define-process-upkeep ((supervisor supervisor) now) (RELEASE-STOWED-LOCK)
+(define-process-upkeep ((supervisor supervisor)) (RELEASE-STOWED-LOCK)
   (with-slots (downward-rx-latches downward-tx-latches) supervisor
     (with-slots (stowed-rx-latch stowed-tx-latch) (pop (process-data-stack supervisor))
       (push stowed-rx-latch downward-rx-latches)
       (push stowed-tx-latch downward-tx-latches)
       (process-continuation supervisor `(BROADCAST-UNLOCK)))))
 
-(define-process-upkeep ((supervisor supervisor) now) (COMPUTE-BLOSSOM-PATHS)
+(define-process-upkeep ((supervisor supervisor)) (COMPUTE-BLOSSOM-PATHS)
   "This command computes the cycle which will constitute the fresh blossom.
 
                    G      <--      root     -->    G
@@ -211,7 +211,7 @@ Both above tree diagrams are valid arrangments that would trigger this operation
                       (list (copy-blossom-edge edge))
                       (reverse-blossom-edges recipient-tail)))))))
 
-(define-process-upkeep ((supervisor supervisor) now) (HANDLE-PISTIL)
+(define-process-upkeep ((supervisor supervisor)) (HANDLE-PISTIL)
   "Tell the source of the peduncle edge that the fresh blossom is its child.
 
                 G      <--        root       -->    G
@@ -233,7 +233,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
             (attach-result (blossom-edge-source-node peduncle-edge))
           nil)))))
 
-(define-process-upkeep ((supervisor supervisor) now) (HANDLE-PETALS)
+(define-process-upkeep ((supervisor supervisor)) (HANDLE-PETALS)
   "Tell the blossom's petals what's up."
   (with-slots (path fresh-blossom petal-child-edges) (peek (process-data-stack supervisor))
     (let ((children (mapcar #'blossom-edge-target-node path)))
@@ -248,7 +248,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
                                      :test #'address=))
                            (apply #'append petal-child-edges petal-replies))))))))
 
-(define-process-upkeep ((supervisor supervisor) now) (HANDLE-BLOSSOM-SUB-CHILDREN)
+(define-process-upkeep ((supervisor supervisor)) (HANDLE-BLOSSOM-SUB-CHILDREN)
   "Tell all the other children what's up."
   (with-slots (fresh-blossom petal-child-edges) (peek (process-data-stack supervisor))
     (let ((petal-children (mapcar #'blossom-edge-target-node petal-child-edges)))
@@ -258,7 +258,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
                       (send-message-batch #'payload-constructor petal-children)
           nil)))))
 
-(define-process-upkeep ((supervisor supervisor) now) (HANDLE-NEW-BLOSSOM)
+(define-process-upkeep ((supervisor supervisor)) (HANDLE-NEW-BLOSSOM)
   "Tell the blossom itself what's up."
   (let ((frame (peek (process-data-stack supervisor))))
     (with-slots (fresh-blossom peduncle-edge path petal-child-edges) frame
@@ -310,7 +310,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
 ;;;
 
 (define-message-handler handle-message-root-path
-    ((node blossom-node) (message message-root-path) now)
+    ((node blossom-node) (message message-root-path))
   "Calculates the path from a blossom through to the tree root (consisting only of toplevel blossoms)."
   (with-slots (path reply-channel) message
     (cond
@@ -327,7 +327,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
                      (make-message-rpc-done :result path))))))
 
 (define-rpc-handler handle-message-attach-parent
-    ((node blossom-node) (message message-attach-parent) now)
+    ((node blossom-node) (message message-attach-parent))
   "Attaches a fresh blossom to an existing parent."
   (with-slots (peduncle-edge reply-channel fresh-blossom) message
     (assert (not (null peduncle-edge)))
@@ -346,7 +346,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
     nil))
 
 (define-rpc-handler handle-message-convert-child-to-petal
-    ((node blossom-node) (message message-convert-child-to-petal) now)
+    ((node blossom-node) (message message-convert-child-to-petal))
   "Attaches an old child to a new blossom as a petal."
   (with-slots (reply-channel fresh-blossom) message
     (prog1 (blossom-node-children node)
@@ -357,7 +357,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
             (blossom-node-children node)   nil))))
 
 (define-rpc-handler handle-message-reattach-cycle-child
-    ((node blossom-node) (message message-reattach-cycle-child) now)
+    ((node blossom-node) (message message-reattach-cycle-child))
   "Attaches an old child to a new blossom as a (non-blossom-)child."
   (with-slots (reply-channel fresh-blossom) message
     (setf (blossom-edge-target-node (blossom-node-parent node))
@@ -368,7 +368,7 @@ If we have a non-null peduncle edge (F -> C above), then we need to tell its sou
 ;;       the fresh blossom responsible for setting _itself_ up. this would also
 ;;       alleviate the obnoxious problem with locking/spawning timing.
 (define-rpc-handler handle-message-set-up-blossom
-    ((node blossom-node) (message message-set-up-blossom) now)
+    ((node blossom-node) (message message-set-up-blossom))
   "Sets up a new contracting blossom's slots."
   (with-slots (peduncle-edge petals petal-children dryad reply-channel) message
     (loop :for petal-child :in petal-children