simple appender / collector initial-value improvements

collectors.lisp

@@ -113,34 +113,36 @@
                (unless (null ,tail-place) (setf (cdr ,tail-place) c))
                (setf ,tail-place (last c)))))))))
 
-(defun make-simple-collector ()
-  "A fastest possible, fewest frills collector suitable to places where efficiency matters"
-  (let ( head tail )
-    (lambda (&rest values)
-      (collect-at-end head tail values)
-      head)))
-
 (defmacro make-simple-collector-to-place (place)
-  `(let ( tail )
-    (lambda (&rest values)
-      (collect-at-end ,place tail values)
-      ,place)))
+  (alexandria:with-unique-names (tail)
+    `(progn
+      (setf ,place (alexandria:ensure-list ,place))
+      (let* ((,tail (last ,place)))
+        (lambda (&rest values)
+          (collect-at-end ,place ,tail values)
+          ,place)))))
+
+(defun make-simple-collector (&optional initial-value)
+  "A fastest possible, fewest frills collector suitable to places where efficiency matters"
+  (let ((head initial-value))
+    (make-simple-collector-to-place head)))
 
-(defun make-simple-appender ()
+(defmacro make-simple-appender-to-place (place)
   "A fastest possible, fewest frills collector suitable to places where efficiency matters
    that appends any values that re lists"
-  (let ( head tail )
-    (lambda (&rest values)
-      (append-at-end head tail values)
-      head)))
-
-(defmacro make-simple-appender-to-place (place)
+  (alexandria:with-unique-names (tail)
+    `(progn
+      (setf ,place (alexandria:ensure-list ,place))
+      (let ((,tail (last ,place)))
+        (lambda (&rest values)
+          (append-at-end ,place ,tail values)
+          ,place)))))
+
+(defun make-simple-appender (&optional initial-value)
   "A fastest possible, fewest frills collector suitable to places where efficiency matters
    that appends any values that re lists"
-  `(let ( tail )
-    (lambda (&rest values)
-      (append-at-end ,place tail values)
-      ,place)))
+  (let ((head initial-value))
+    (make-simple-appender-to-place head)))
 
 ;;;; * Reducing and Collecting
 
@@ -377,16 +379,14 @@ FUNCTION and INITIAL-VALUE are passed directly to MAKE-REDUCER."
        (col 3)
        (col)) => (1 2 3)
   "
-  (alexandria:with-unique-names (collector)
-    `(let ((,collector (,(if from-end
-                             'make-pusher
-                             'make-collector)
-                        :initial-value (or ,initial-value ,place)
-                        :collect-nil ,collect-nil
-                        :place-setter ,(when place `(lambda (new) (setf ,place new))))))
-      (flet ((,name (&rest items)
-               (apply ,collector items)))
-        ,@body))))
+  `(let ((,name (,(if from-end
+                      'make-pusher
+                      'make-collector)
+                 :initial-value (or ,initial-value ,place)
+                 :collect-nil ,collect-nil
+                 :place-setter ,(when place `(lambda (new) (setf ,place new))))))
+    (flet ((,name (&rest items) (operate ,name items)))
+      ,@body)))
 
 (defmacro with-collector-output ((name &key (collect-nil t) initial-value from-end place)
                                  &body body)

tests/collectors.lisp

@@ -203,3 +203,21 @@
         (assert-equal '(2 4 2 4) (z 1 nil 2))
         (assert-equal '(1 nil 2 1 nil 2) (x 1 nil 2))
         ))))
+
+(define-test simple-collectors-init-test (:tags '(collector place initial-value))
+  (let* ((as) (bs 2) (cs '(1 2))
+         (a (collectors:make-simple-collector-to-place as))
+         (b (collectors:make-simple-collector-to-place bs))
+         (c (collectors:make-simple-collector-to-place cs)))
+    (funcall a :a :a)
+    (funcall b :b :b)
+    (funcall c :c :c)
+    (assert-equal '(:a :a) as)
+    (assert-equal '(:a :a) (funcall a))
+
+    (assert-equal '(2 :b :b) bs)
+    (assert-equal '(2 :b :b) (funcall b))
+
+    (assert-equal '(1 2 :c :c) cs)
+    (assert-equal '(1 2 :c :c) (funcall c))
+    ))