Wrap queue items in a queue object
ci/woodpecker/push/woodpecker Pipeline failed Details

WIP-cache
Hugo Thunnissen 10 months ago
parent ce995f2bc4
commit 2d2f9912c1

@ -1,4 +1,20 @@
(cl-defstruct (phpinspect-queue
(:constructor phpinspect-make-queue-generated))
(-first nil
:type phpinspect-queue-item
:documentation
"The first item in the queue")
(-last nil
:type phpinspect-queue-item
:documentation
"The last item in the queue")
(subscription nil
:type function
:read-only t
:documentation
"A function that should be called when items are
enqueued."))
(cl-defstruct (phpinspect-queue-item
(:constructor phpinspect-make-queue-item))
@ -6,72 +22,56 @@
:type phpinspect-queue-item
:documentation
"The next item in the queue")
(thing nil
(value nil
:type any
:documentation
"The thing stored in the queue")
"The value stored in the queue")
(previous nil
:type phpinspect-queue-item
:documentation
"The previous item in the queue")
(subscription nil
:type function
:read-only t
:documentation
"A function that should be called when items are
enqueued."))
"The previous item in the queue"))
(defsubst phpinspect-make-queue (&optional subscription)
(phpinspect-make-queue-item :subscription subscription))
(define-inline phpinspect-make-queue (&optional subscription)
(inline-quote
(progn
(phpinspect-make-queue-generated :subscription ,subscription))))
;; Recursion causes max-eval-depth error here for long queues. Hence the loop
;; implementation for these two functions.
(cl-defmethod phpinspect-queue-last ((item phpinspect-queue-item))
"Get the last item in the queue that ITEM is part of."
(while (phpinspect-queue-item-next item)
(setq item (phpinspect-queue-item-next item)))
item)
(cl-defmethod phpinspect-queue-first ((queue phpinspect-queue))
(phpinspect-queue--first queue))
(cl-defmethod phpinspect-queue-first ((item phpinspect-queue-item))
"Get the first item in the queue that ITEM is part of."
(while (phpinspect-queue-item-previous item)
(setq item (phpinspect-queue-item-previous item)))
item)
(cl-defmethod phpinspect-queue-last ((queue phpinspect-queue))
(or (phpinspect-queue--last queue) (phpinspect-queue--first queue)))
(cl-defmethod phpinspect-queue-enqueue ((item phpinspect-queue-item) thing)
"Add THING to the end of the queue that ITEM is part of."
(let ((last (phpinspect-queue-last item)))
(if (not (phpinspect-queue-item-thing last))
(setf (phpinspect-queue-item-thing last) thing)
(setf (phpinspect-queue-item-next last)
(phpinspect-make-queue-item
:previous last
:thing thing
:subscription (phpinspect-queue-item-subscription item)))))
(when (phpinspect-queue-item-subscription item)
(funcall (phpinspect-queue-item-subscription item))))
(cl-defmethod phpinspect-queue-enqueue ((queue phpinspect-queue) value)
"Add VALUE to the end of the queue that ITEM is part of."
(let ((last (phpinspect-queue-last queue))
(new-item (phpinspect-make-queue-item :value value)))
(if (not last)
(setf (phpinspect-queue--first queue) new-item)
(setf (phpinspect-queue-item-next last) new-item)
(setf (phpinspect-queue-item-previous new-item) last))
(setf (phpinspect-queue--last queue) new-item))
(when (phpinspect-queue-subscription queue)
(funcall (phpinspect-queue-subscription queue))))
(cl-defmethod phpinspect-queue-dequeue ((item phpinspect-queue-item))
"Remove the thing at the front of the queue that ITEM is part of and return it."
(let* ((first (phpinspect-queue-first item))
(thing (phpinspect-queue-item-thing first))
(next (phpinspect-queue-item-next first)))
(when next (setf (phpinspect-queue-item-previous next) nil))
(cond ((and (eq item first) (not next))
(setf (phpinspect-queue-item-thing item)
nil))
((eq item first)
(setf (phpinspect-queue-item-thing item)
(phpinspect-queue-item-thing next))
(setf (phpinspect-queue-item-next item)
(phpinspect-queue-item-next next))))
thing))
(cl-defmethod phpinspect-queue-dequeue ((queue phpinspect-queue))
"Remove the value at the front of the queue that ITEM is part of and return it."
(let* ((first (phpinspect-queue-first queue))
next value)
(when first
(setq next (phpinspect-queue-item-next first))
(setq value (phpinspect-queue-item-value first)))
(if next
(setf (phpinspect-queue-item-previous next) nil)
(setf (phpinspect-queue--last queue) nil))
(setf (phpinspect-queue--first queue) next)
value))
(defmacro phpinspect-doqueue (place-and-queue &rest body)
"Loop over queue defined in PLACE-AND-QUEUE executing BODY.
PLACE-AND-QUEUE is a two-member list. The first item should be
the place that the current thing in the queue should be assigned
the place that the current value in the queue should be assigned
to upon each iteration. The second item should be a queue-item
belonging to the queue that must be iterated over.
@ -81,25 +81,25 @@ BODY can be any form."
(place (car place-and-queue))
(queue (cadr place-and-queue)))
`(let* ((,item-sym (phpinspect-queue-first ,queue))
(,place (phpinspect-queue-item-thing ,item-sym)))
(,place (when ,item-sym (phpinspect-queue-item-value ,item-sym))))
(when ,place
,@body
(while (setq ,item-sym (phpinspect-queue-item-next ,item-sym))
(setq ,place (phpinspect-queue-item-thing ,item-sym))
(setq ,place (phpinspect-queue-item-value ,item-sym))
,@body)))))
(cl-defmethod phpinspect-queue-find
((item phpinspect-queue-item) thing comparison-func)
"Find THING in the queue that ITEM is part of using COMPARISON-FUNC."
((queue phpinspect-queue) value comparison-func)
"Find VALUE in the queue that ITEM is part of using COMPARISON-FUNC."
(catch 'found
(phpinspect-doqueue (current-thing item)
(when (funcall comparison-func current-thing thing)
(throw 'found current-thing)))))
(phpinspect-doqueue (current-value queue)
(when (funcall comparison-func current-value value)
(throw 'found current-value)))))
(cl-defmethod phpinspect-queue-enqueue-noduplicate
((item phpinspect-queue-item) thing comparison-func)
((queue phpinspect-queue) value comparison-func)
(when (not (phpinspect-queue-find item thing comparison-func))
(phpinspect-queue-enqueue item thing)))
(when (not (phpinspect-queue-find queue value comparison-func))
(phpinspect-queue-enqueue queue value)))
(provide 'phpinspect-queue)

@ -35,7 +35,8 @@
(should (string= "one" (phpinspect-queue-dequeue queue)))
(should (string= "two" (phpinspect-queue-dequeue queue)))
(should (string= "three" (phpinspect-queue-dequeue queue)))))
(should (string= "three" (phpinspect-queue-dequeue queue)))
(should-not (phpinspect-queue-dequeue queue))))
(ert-deftest phpinspect-queue-subscribe ()
(let ((be-called nil))

Loading…
Cancel
Save