collecting: collector-pop, collector-empty-p

Author: tfeb

README.md

@@ -403,6 +403,10 @@ is equivalent to
 
 except that no new list structure is created.  See `collector-contents` for a function which does not update the tail pointer.
 
+**`collector-empty-p`** returns true if its argument is a collector which is empty (note it doesn't perform any check that the argument actually is a valid collector object).
+
+**`pop-collector`** returns the first element of a collector, and alters it so that the second element is now the first element.  It can be used to use collectors like queues.
+
 ### Notes on explicit collectors
 Surprising things can happen if you share a single list between more than one collector without copying it:
 

VERSION

@@ -1 +1 @@
-10.4.0
+10.5.0

collecting.lisp

@@ -38,7 +38,9 @@
           #:collector-contents
           #:collect-into
           #:nconc-collectors
-          #:nconc-collector-onto))
+          #:nconc-collector-onto
+          #:pop-collector
+          #:collector-empty-p))
 
 (in-package :org.tfeb.hax.collecting)
 
@@ -305,14 +307,13 @@ This is the closest equivalent to Interlisp's TCONC."
   ;; Note unlike APPEND it makes no sense to call this with no
   ;; collectors at all: what should it return in that case (perhaps a
   ;; new collector)?
-  (declare (dynamic-extent collectors))
-
   "Destructively concatenate one or more collectors, returning the first
 
 All the collectors share a tail pointer after this is done, while
 their head pointers point at appropriate points on the NCONCed list.
 You can then collect more into any one of them but this will make the tail
 pointers of all the others junk."
+  (declare (dynamic-extent collectors))
   (if (null collectors)
       collector
     (labels ((ncc (c a more)
@@ -341,3 +342,15 @@ Return the collector."
     (setf (cdr (cdr collector)) onto
           (cdr collector) (last onto)))
   collector)
+
+(defun pop-collector (c)
+  "Pop the first value from C
+
+If C is empty, then this will return NI"L
+  (prog1 (pop (car c))
+    (when (null (car c))
+      (setf (cdr c) nil))))
+
+(defun collector-empty-p (c)
+  "Return true if the collector C is empty"
+  (null (car c)))

test/test-collecting.lisp

@@ -71,6 +71,19 @@
     (collect-into c 0)
     (collect-into (nconc-collector-onto c l) 4)
     (is equal '(0 1 2 3 4) (collector-contents c))
-    (is equal '(1 2 3 4) l)))
+    (is equal '(1 2 3 4) l))
+  (let ((c (make-collector)))
+    (true (collector-empty-p c))
+    (collect-into c 1)
+    (false (collector-empty-p c))
+    (collect-into c 2)
+    (is equal '(1 2) (collector-contents c))
+    (is eql 1 (pop-collector c))
+    (false (collector-empty-p c))
+    (collect-into c 3)
+    (is equal '(2 3) (collector-contents c))
+    (is eql 2 (pop-collector c))
+    (is eql 3 (pop-collector c))
+    (true (collector-empty-p c))))
 
 (test "org.tfeb.hax.collecting" :report 'summary)