From c3d28e186cf54848122069d0cd3016b2845a5be8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <simendsjo@gmail.com>
Date: Thu, 11 Apr 2024 06:56:19 +0200
Subject: [PATCH 1/8] tweak: use `eq` for checking symbol equivalence

---
 transducers/transducers.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/transducers/transducers.lisp b/transducers/transducers.lisp
index 2ad504a..05492a3 100644
--- a/transducers/transducers.lisp
+++ b/transducers/transducers.lisp
@@ -372,7 +372,7 @@ not careful."
   "Transducer: Remove adjacent duplicates from the transduction."
   (let ((prev 'nothing))
     (lambda (result &optional (input nil i-p))
-      (if i-p (if (equal prev input)
+      (if i-p (if (eq prev input)
                   result
                   (progn (setf prev input)
                          (funcall reducer result input)))

From 38b6d16fa8018387a0dc3858f81828e6a7037b91 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <simendsjo@gmail.com>
Date: Thu, 11 Apr 2024 06:57:29 +0200
Subject: [PATCH 2/8] tweak: use `decf` rather than `setf`

---
 transducers/transducers.lisp | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/transducers/transducers.lisp b/transducers/transducers.lisp
index 05492a3..8499dc8 100644
--- a/transducers/transducers.lisp
+++ b/transducers/transducers.lisp
@@ -103,7 +103,7 @@ keep results that are non-nil.
     (let ((new-n (1+ n)))
       (lambda (result &optional (input nil i-p))
         (cond (i-p
-               (setf new-n (1- new-n))
+               (decf new-n)
                (if (> new-n 0)
                    result
                    (funcall reducer result input)))
@@ -136,7 +136,7 @@ keep results that are non-nil.
         (if i-p (let ((result (if (> new-n 0)
                                   (funcall reducer result input)
                                   result)))
-                  (setf new-n (1- new-n))
+                  (decf new-n)
                   (if (<= new-n 0)
                       (ensure-reduced result)
                       result))
@@ -407,7 +407,7 @@ of the transduction is always included.
             (if i-p (if (= 1 curr)
                         (progn (setf curr n)
                                (funcall reducer result input))
-                        (progn (setf curr (1- curr))
+                        (progn (decf curr)
                                result))
                 (funcall reducer result)))))))
 

From bb7406bd8a2a8c41e642639cf9b58f52bfe246d4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <simendsjo@gmail.com>
Date: Thu, 11 Apr 2024 07:01:27 +0200
Subject: [PATCH 3/8] tweak: use `incf` rather than `setf`

---
 transducers/sources.lisp     | 2 +-
 transducers/transducers.lisp | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/transducers/sources.lisp b/transducers/sources.lisp
index d8ce6dd..5fcbeeb 100644
--- a/transducers/sources.lisp
+++ b/transducers/sources.lisp
@@ -101,7 +101,7 @@ strings are vectors too, so:
                             (setf ix 1)
                             (aref seq 0))
                            (t (let ((next (aref seq ix)))
-                                (setf ix (1+ ix))
+                                (incf ix)
                                 next))))))
         (make-generator :func func))))
 
diff --git a/transducers/transducers.lisp b/transducers/transducers.lisp
index 8499dc8..093f76b 100644
--- a/transducers/transducers.lisp
+++ b/transducers/transducers.lisp
@@ -222,7 +222,7 @@ any accumulated state, which may be shorter than N.
           (lambda (result &optional (input nil i-p))
             (cond (i-p
                    (setf collect (cl:cons input collect))
-                   (setf i (1+ i))
+                   (incf i)
                    (if (< i n)
                        result
                        (let ((next-input (reverse collect)))
@@ -298,7 +298,7 @@ Starts at 0."
   (let ((n 0))
     (lambda (result &optional (input nil i-p))
       (if i-p (let ((input (cl:cons n input)))
-                (setf n (1+ n))
+                (incf n)
                 (funcall reducer result input))
           (funcall reducer result)))))
 
@@ -341,7 +341,7 @@ input than N, then this yields nothing.
           (lambda (result &optional (input nil i-p))
             (cond (i-p
                    (setf q (q:amortized-enqueue q input))
-                   (setf i (1+ i))
+                   (incf i)
                    (cond ((< i n) result)
                          ((= i n) (funcall reducer result (q:amortized-queue-list q)))
                          (t (setf q (q:amortized-dequeue q))

From 8db2cd19a6be7822bd87e986b2809440da1133fd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <simendsjo@gmail.com>
Date: Thu, 11 Apr 2024 12:20:13 +0200
Subject: [PATCH 4/8] tweak: convert `comp` to a macro

---
 transducers/utils.lisp | 29 ++++++++++++++++++++---------
 1 file changed, 20 insertions(+), 9 deletions(-)

diff --git a/transducers/utils.lisp b/transducers/utils.lisp
index 4ad60ff..3c25179 100644
--- a/transducers/utils.lisp
+++ b/transducers/utils.lisp
@@ -5,19 +5,30 @@
         ((symbolp arg) (ensure-function (symbol-function arg)))
         (t (error "Argument is not a function: ~a" arg))))
 
-;; TODO Make this a macro.
-(defun comp (function &rest functions)
+(defmacro comp (function &rest functions)
   "Function composition.
 
 (funcall (comp #'1+ #'length) \"foo\") == (1+ (length \"foo\"))"
-  (reduce (lambda (f g)
-            (let ((f (ensure-function f))
-                  (g (ensure-function g)))
-              (lambda (&rest arguments)
-                (funcall f (apply g arguments)))))
-          functions
-          :initial-value function))
+  (let ((args (gensym "COMP-ARGS-"))
+        (reversed (reverse (cl:cons function functions))))
+    `(lambda (&rest ,args)
+       ,(reduce (lambda (data fn)
+                 `(funcall ,fn ,data))
+               (cdr reversed)
+               :initial-value `(apply ,(car reversed) ,args)))))
 
+#+nil
+(macroexpand-1 '(comp (f)))
+#+nil
+(macroexpand-1 '(comp (f x)))
+#+nil
+(macroexpand-1 '(comp (f) (g)))
+#+nil
+(macroexpand-1 '(comp (f x) (g)))
+#+nil
+(macroexpand-1 '(comp (f x) (g x)))
+#+nil
+(macroexpand-1 '(comp (const 1337) (lambda (n) (* 2 n)) #'1+))
 #+nil
 (funcall (comp (const 1337) (lambda (n) (* 2 n)) #'1+) 1)
 

From bb146b95d5f9375ec23a0998c929a793387cc9c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <simendsjo@gmail.com>
Date: Thu, 11 Apr 2024 08:16:11 +0200
Subject: [PATCH 5/8] feat: add `pipe` as an alternative to `transduce`

---
 README.org                   | 27 +++++++++++++++++++++++++++
 tests/main.lisp              | 15 +++++++++++++++
 transducers/entry.lisp       | 29 +++++++++++++++++++++++++++++
 transducers/transducers.lisp |  3 ++-
 4 files changed, 73 insertions(+), 1 deletion(-)

diff --git a/README.org b/README.org
index 4c3cb65..02c2e63 100644
--- a/README.org
+++ b/README.org
@@ -149,6 +149,33 @@ Two things of note here:
 Explore the other transducers and reducers to see what's possible! You'll never
 write a =loop= again.
 
+*** Pipeline
+An alternative syntax to =transduce= is supported by the =pipe= macro. The
+argument order is different, and it automatically combines several transducers
+with =comp=. It constructs a call to =transduce=.
+
+The =pipe= form will lower into the =transduce= form below.
+
+#+begin_src lisp :exports code
+(in-package :transducers)
+
+(pipe (ints 1)
+  (filter #'oddp)
+  (take 1000)
+  (map (lambda (n) (* n n)))
+  #'+)
+
+(transduce
+ (comp (filter #'oddp)
+       (take 1000)
+       (map (lambda (n) (* n n))))
+ #'+
+ (ints 1))
+#+end_src
+
+#+RESULTS:
+: 1333333000
+
 ** Processing JSON Data
 
 The system =transducers/jzon= provides automatic JSON streaming support via the
diff --git a/tests/main.lisp b/tests/main.lisp
index e7d7baa..f57ba40 100644
--- a/tests/main.lisp
+++ b/tests/main.lisp
@@ -178,6 +178,21 @@
       (handler-bind ((error #'(lambda (c) (declare (ignore c)) (invoke-restart 't:next-item))))
         (t:transduce (t:map (lambda (item) (if (= 1 item) (error "無念") item))) #'t:cons (j:read "[0,1,2,3]")))))
 
+(define-test "Pipeline composition"
+  :parent transduction
+  :depends-on (reduction
+               "Taking and Dropping"
+               "Filtering"
+               "Other")
+  (is equal '(12 20 30)
+      (t:pipe '(1 2 3 4 5 6 7 8 9 10)
+        #'t:enumerate
+        (t:map (lambda (pair) (* (car pair) (cdr pair))))
+        (t:filter #'evenp)
+        (t:drop 3)
+        (t:take 3)
+        #'t:cons)))
+
 (define-test "Sources"
   :depends-on (reduction transduction)
   (is equal '() (t:transduce (t:take 0) #'t:cons (t:ints 0)))
diff --git a/transducers/entry.lisp b/transducers/entry.lisp
index 9a62240..3d76ba2 100644
--- a/transducers/entry.lisp
+++ b/transducers/entry.lisp
@@ -51,6 +51,35 @@ sources. See `sources.lisp' and `entry.lisp' for examples of how to do this.
 
 "))
 
+(defmacro pipe* (fn source &rest transducers-and-reducer)
+  (let ((transducers (butlast transducers-and-reducer))
+        (reducer (car (cl:last transducers-and-reducer))))
+    (if (cdr transducers)
+        `(,fn (comp ,@transducers) ,reducer ,source)
+        `(,fn ,(car transducers) ,reducer ,source))))
+
+(defmacro pipe (source &rest transducers-and-reducer)
+  "Structure `transduce' as a pipeline.
+
+The second up to (but not including) the last argument is used as the
+transducers, and the last argument is used as the reducer. If there are more
+than one transducer, they are wrapped in `comp'.
+
+(macroexpand-1 '(pipe source t1 reducer))
+;; => (TRANSDUCE T1 REDUCER SOURCE), T
+
+(macroexpand-1 '(pipe source t1 t2 reducer))
+;; => (TRANSDUCE (COMP T1 T2) REDUCER SOURCE), T
+"
+  (assert (>= (length transducers-and-reducer) 2) nil
+          "Missing transducer or reducer.")
+  `(pipe* transduce ,source ,@transducers-and-reducer))
+
+#+nil
+(pipe '(1 2 3) (take 1) #'*)
+#+nil
+(pipe (cycle '(1 2 3)) (filter #'oddp) (map #'1+) (take 10) #'*)
+
 (defmethod transduce (xform f (source cl:string))
   (string-transduce xform f source))
 
diff --git a/transducers/transducers.lisp b/transducers/transducers.lisp
index 093f76b..c397552 100644
--- a/transducers/transducers.lisp
+++ b/transducers/transducers.lisp
@@ -5,7 +5,8 @@
            #:cons #:count #:first #:last #:max #:min #:find #:string #:vector #:hash-table
            #:random)
   ;; --- Entry Points --- ;;
-  (:export #:transduce)
+  (:export #:transduce
+           #:pipe)
   ;; --- Transducers -- ;;
   (:export #:pass #:map
            #:filter #:filter-map #:unique #:dedup

From c1803581242d3559205a72432a7e1872668aeb70 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <contact@simendsjo.me>
Date: Sun, 4 Aug 2024 19:52:34 +0200
Subject: [PATCH 6/8] feat: add `pass-reducer` which does nothing

---
 transducers/reducers.lisp | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/transducers/reducers.lisp b/transducers/reducers.lisp
index 7d3f17e..31d96d9 100644
--- a/transducers/reducers.lisp
+++ b/transducers/reducers.lisp
@@ -1,5 +1,10 @@
 (in-package :transducers)
 
+(defun pass-reducer (&optional (acc nil a-p) (input nil i-p))
+  (cond ((and a-p i-p) input)
+        ((and a-p (not i-p)) acc)
+        (t nil)))
+
 (declaim (ftype (function (&optional list t) list) cons))
 (defun cons (&optional (acc nil a-p) (input nil i-p))
   "Reducer: Collect all results as a list."

From 8fd5c8c7e027dc7506cc04faa4021cecd7e247a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <contact@simendsjo.me>
Date: Sun, 4 Aug 2024 19:55:21 +0200
Subject: [PATCH 7/8] refactor: extract transducer iteration into `source-iter`

---
 README.org                   |   2 -
 transducers/entry.lisp       | 214 ++++++++---------------------------
 transducers/sources.lisp     | 170 ++++++++++++++++++++++++++++
 transducers/transducers.lisp |   4 +-
 transducers/utils.lisp       |  10 +-
 5 files changed, 227 insertions(+), 173 deletions(-)

diff --git a/README.org b/README.org
index 02c2e63..f78e544 100644
--- a/README.org
+++ b/README.org
@@ -959,8 +959,6 @@ An ancient method of calculating Prime Numbers.
 
 1. This library is generally portable, but assumes your CL implementation
    supports tail-call elimination within ~labels~.
-2. A way to model the common =zip= function has not yet been found, but I suspect
-   the answer lies in being able to pass multiple sources as ~&rest~ arguments.
 
 * Resources
 
diff --git a/transducers/entry.lisp b/transducers/entry.lisp
index 3d76ba2..a48f03b 100644
--- a/transducers/entry.lisp
+++ b/transducers/entry.lisp
@@ -80,29 +80,36 @@ than one transducer, they are wrapped in `comp'.
 #+nil
 (pipe (cycle '(1 2 3)) (filter #'oddp) (map #'1+) (take 10) #'*)
 
-(defmethod transduce (xform f (source cl:string))
-  (string-transduce xform f source))
+(defun make-transducer (xform f)
+  (lambda (source)
+    (source-iter-transduce xform f (ensure-source-iter source))))
+
+(defmethod transduce (xform f (source source-iter))
+  (funcall (make-transducer xform f) source))
 
 (defmethod transduce (xform f (source list))
   "Transducing over an alist works automatically via this method, and the pairs are
 streamed as-is as cons cells."
-  (list-transduce xform f source))
+  (funcall (make-transducer xform f) (list-iter source)))
 
-(defmethod transduce (xform f (source cl:vector))
-  (vector-transduce xform f source))
+(defmethod transduce (xform f (source cl:string))
+  (funcall (make-transducer xform f) (string-iter source)))
 
-(defmethod transduce (xform f (source cl:hash-table))
-  "Yields key-value pairs as cons cells."
-  (hash-table-transduce xform f source))
+(defmethod transduce (xform f (source cl:vector))
+  (funcall (make-transducer xform f) (vector-iter source)))
 
 (defmethod transduce (xform f (source pathname))
-  (file-transduce xform f source))
-
-(defmethod transduce (xform f (source generator))
-  (generator-transduce xform f source))
+  "Transduce over the lines of the file named by a FILENAME."
+  (funcall (make-transducer xform f) (file-line-iter source)))
 
 (defmethod transduce (xform f (source stream))
-  (stream-transduce xform f source))
+  "Transduce over the lines of a given STREAM. Note: Closing the stream is the
+responsiblity of the caller!"
+  (funcall (make-transducer xform f) (stream-line-iter source)))
+
+(defmethod transduce (xform f (source cl:hash-table))
+  "Yields key-value pairs as cons cells."
+  (hash-table-transduce xform f source))
 
 (defmethod transduce (xform f (source plist))
   "Yields key-value pairs as cons cells.
@@ -110,80 +117,15 @@ streamed as-is as cons cells."
 # Conditions
 
 - `imbalanced-pist': if the number of keys and values do not match."
-  (plist-transduce xform f source))
+  (funcall (make-transducer xform f) (plist-iter (plist-list source))))
 
-(defmethod transduce (xform f fallback)
+(defmethod transduce (xform f source)
   "Fallback for types which don't implement this. Always errors.
 
 # Conditions
 
 - `no-transduce-implementation': an unsupported type was transduced over."
-  (error 'no-transduce-implementation :type (type-of fallback)))
-
-#+nil
-(transduce (map #'char-upcase) #'string "hello")
-#+nil
-(transduce (map #'1+) #'vector '(1 2 3 4))
-#+nil
-(transduce (map #'1+) #'+ #(1 2 3 4))
-#+nil
-(let ((hm (make-hash-table :test #'equal)))
-  (setf (gethash 'a hm) 1)
-  (setf (gethash 'b hm) 2)
-  (setf (gethash 'c hm) 3)
-  (transduce (filter #'evenp) (max 0) hm))
-#+nil
-(transduce (map #'1+) #'+ 1)  ;; Expected to fail.
-
-(declaim (ftype (function (t t list) *) list-transduce))
-(defun list-transduce (xform f coll)
-  (let* ((init   (funcall f))
-         (xf     (funcall xform f))
-         (result (list-reduce xf init coll)))
-    (funcall xf result)))
-
-(declaim (ftype (function ((function (&optional t t) *) t list) *) list-reduce))
-(defun list-reduce (f identity lst)
-  (labels ((recurse (acc items)
-             (if (null items)
-                 acc
-                 (let ((v (safe-call f acc (car items))))
-                   (if (reduced-p v)
-                       (reduced-val v)
-                       (recurse v (cdr items)))))))
-    (recurse identity lst)))
-
-#+nil
-(transduce (map (lambda (item) (if (= item 1) (error "無念") item)))
-           #'cons '(0 1 2 3))
-
-(declaim (ftype (function (t t cl:vector) *) vector-transduce))
-(defun vector-transduce (xform f coll)
-  (let* ((init   (funcall f))
-         (xf     (funcall xform f))
-         (result (vector-reduce xf init coll)))
-    (funcall xf result)))
-
-(defun vector-reduce (f identity vec)
-  (let ((len (length vec)))
-    (labels ((recurse (acc i)
-               (if (= i len)
-                   acc
-                   (let ((acc (safe-call f acc (aref vec i))))
-                     (if (reduced-p acc)
-                         (reduced-val acc)
-                         (recurse acc (1+ i)))))))
-      (recurse identity 0))))
-
-#+nil
-(vector-transduce (map #'1+) #'cons #(1 2 3 4 5))
-
-(declaim (ftype (function (t t cl:string) *) string-transduce))
-(defun string-transduce (xform f coll)
-  (vector-transduce xform f coll))
-
-#+nil
-(string-transduce (map #'char-upcase) #'cons "hello")
+  (funcall (make-transducer xform f) (source->source-iter source)))
 
 (declaim (ftype (function (t t cl:hash-table) *) hash-table-transduce))
 (defun hash-table-transduce (xform f coll)
@@ -206,89 +148,7 @@ streamed as-is as cons cells."
       (recurse identity))))
 
 #+nil
-(let ((hm (make-hash-table :test #'equal)))
-  (setf (gethash 'a hm) 1)
-  (setf (gethash 'b hm) 2)
-  (setf (gethash 'c hm) 3)
-  (hash-table-transduce (comp (map #'cdr) (filter #'evenp)) (fold #'cl:max 0) hm))
-
-(defun file-transduce (xform f filename)
-  "Transduce over the lines of the file named by a FILENAME."
-  (let* ((init   (funcall f))
-         (xf     (funcall xform f))
-         (result (file-reduce xf init filename)))
-    (funcall xf result)))
-
-(defun file-reduce (f identity filename)
-  (with-open-file (stream filename)
-    (stream-reduce f identity stream)))
-
-#+nil
-(file-transduce #'pass #'count #p"/home/colin/history.txt")
-
-(defun stream-transduce (xform f stream)
-  "Transduce over the lines of a given STREAM. Note: Closing the stream is the
-responsiblity of the caller!"
-  (let* ((init   (funcall f))
-         (xf     (funcall xform f))
-         (result (stream-reduce xf init stream)))
-    (funcall xf result)))
-
-(defun stream-reduce (f identity stream)
-  (labels ((recurse (acc)
-             (let ((line (read-line stream nil)))
-               (if (not line)
-                   acc
-                   (let ((acc (safe-call f acc line)))
-                     (if (reduced-p acc)
-                         (reduced-val acc)
-                         (recurse acc)))))))
-    (recurse identity)))
-
-#+nil
-(with-open-file (stream #p"/home/colin/.sbclrc")
-  (transduce #'pass #'count stream))
-
-(defun generator-transduce (xform f gen)
-  "Transduce over a potentially endless stream of values from a generator GEN."
-  (let* ((init   (funcall f))
-         (xf     (funcall xform f))
-         (result (generator-reduce xf init gen)))
-    (funcall xf result)))
-
-(defun generator-reduce (f identity gen)
-  (labels ((recurse (acc)
-             (let ((val (funcall (generator-func gen))))
-               (cond ((eq *done* val) acc)
-                     (t (let ((acc (safe-call f acc val)))
-                          (if (reduced-p acc)
-                              (reduced-val acc)
-                              (recurse acc))))))))
-    (recurse identity)))
-
-(declaim (ftype (function (t t plist) *) plist-transduce))
-(defun plist-transduce (xform f coll)
-  (let* ((init   (funcall f))
-         (xf     (funcall xform f))
-         (result (plist-reduce xf init coll)))
-    (funcall xf result)))
-
-(declaim (ftype (function ((function (&optional t t) *) t plist) *) plist-reduce))
-(defun plist-reduce (f identity lst)
-  (labels ((recurse (acc items)
-             (cond ((null items) acc)
-                   ((null (cdr items))
-                    (let ((key (car items)))
-                      (restart-case (error 'imbalanced-plist :key key)
-                        (use-value (value)
-                          :report "Supply a value for the final key."
-                          :interactive (lambda () (prompt-new-value (format nil "Value for key ~a: " key)))
-                          (recurse acc (list key value))))))
-                   (t (let ((v (safe-call f acc (cl:cons (car items) (second items)))))
-                        (if (reduced-p v)
-                            (reduced-val v)
-                            (recurse v (cdr (cdr items)))))))))
-    (recurse identity (plist-list lst))))
+(transduce (map #'1+) #'cons #(1 2 3 4 5))
 
 #+nil
 (transduce #'pass #'cons (plist `(:a 1 :b 2 :c 3)))
@@ -298,3 +158,29 @@ responsiblity of the caller!"
 (transduce (map #'cdr) #'+ (plist `(:a 1 :b 2 :c)))  ;; Imbalanced plist for testing.
 #+nil
 (transduce #'pass #'cons '((:a . 1) (:b . 2) (:c . 3)))
+#+nil
+(transduce (map #'char-upcase) #'string "hello")
+#+nil
+(transduce (map #'1+) #'vector '(1 2 3 4))
+#+nil
+(vector-transduce (map #'1+) #'cons #(1 2 3 4 5))
+#+nil
+(transduce (map #'1+) #'+ #(1 2 3 4))
+#+nil
+(let ((hm (make-hash-table :test #'equal)))
+  (setf (gethash 'a hm) 1)
+  (setf (gethash 'b hm) 2)
+  (setf (gethash 'c hm) 3)
+  (transduce (filter #'evenp) (max 0) hm))
+#+nil
+(transduce (map #'1+) #'+ 1)  ;; Expected to fail.
+#+nil
+(transduce (map (lambda (item) (if (= item 1) (error "無念") item)))
+           #'cons '(0 1 2 3))
+#+nil
+(transduce #'pass #'count #p"/home/colin/history.txt")
+#+nil
+(vector-transduce (map #'1+) #'cons #(1 2 3 4 5))
+#+nil
+(with-open-file (stream #p"/home/colin/.sbclrc")
+  (transduce #'pass #'count stream))
diff --git a/transducers/sources.lisp b/transducers/sources.lisp
index 5fcbeeb..fe77635 100644
--- a/transducers/sources.lisp
+++ b/transducers/sources.lisp
@@ -107,3 +107,173 @@ strings are vectors too, so:
 
 #+nil
 (transduce (take 10) #'cons (cycle '(1 2 3)))
+
+(defstruct source-iter (:documentation "An iterator over a source of values.
+
+`source-iter-next' should return the next element in the source, or `*done*'
+when finished.  After `source-iter-next' returns `*done*' it should continue to
+return `*done*' for each subsequent call without doing any work or fail. Each
+value, other than `*done*' must be returned once and only once in the same order
+as in the source.
+
+`source-iter-initialize' must be called before `source-iter-next' is called the
+first time. This should do required setup of the source, e.g. opening a file.
+The function should be idempontent to avoid problems if called more than once.
+
+`source-iter-finalize' must be called after `source-iter-next' returns `*done*'
+the first time, or when choosing to abort iteration. This should clean up any
+resources allocated by `source-iter-initialize'. The function should be
+idempotent to avoid problems if called more than once. `source-iter-next' must
+not be called after finalizing.")
+  (next (lambda () *done*) :type (function () t))
+  (initialize (lambda ()) :type (function () t))
+  (finalize (lambda ()) :type (function () t)))
+
+(declaim (ftype (function (list) source-iter) list-iter))
+(defun list-iter (list)
+  (let ((rest list))
+    (make-source-iter :next (lambda ()
+                              (if (null rest)
+                                  *done*
+                                  (pop rest))))))
+
+(declaim (ftype (function (list) source-iter) plist-iter))
+(defun plist-iter (lst)
+  (let ((items lst))
+    (make-source-iter
+     :next (lambda ()
+             (cond ((null items) *done*)
+                   ((null (cdr items))
+                    (let ((key (pop items)))
+                      (restart-case (error 'imbalanced-plist :key key)
+                        (use-value (value)
+                          :report "Supply a value for the final key."
+                          :interactive (lambda () (prompt-new-value (format nil "Value for key ~a: " key)))
+                          (list key value)))))
+                   (t (cl:cons (pop items) (pop items))))))))
+
+(declaim (ftype (function (cl:vector) source-iter) vector-iter))
+(defun vector-iter (vector)
+  (let ((len (length vector))
+        (i 0))
+    (make-source-iter :next (lambda ()
+                              (if (eql i len)
+                                  *done*
+                                  (prog1 (aref vector i)
+                                    (incf i)))))))
+
+(declaim (ftype (function (cl:string) source-iter) string-iter))
+(defun string-iter (string)
+  (vector-iter string))
+
+(declaim (ftype (function (pathname) source-iter) file-line-iter))
+(defun file-line-iter (pathname)
+  (let ((file nil))
+    (make-source-iter :next (lambda ()
+                              (or (read-line file nil) *done*))
+                      :initialize (lambda ()
+                                    (unless file
+                                      (setf file (open pathname))))
+                      :finalize (lambda ()
+                                  (when (and file (open-stream-p file))
+                                    (close file)
+                                    (setf file nil))))))
+
+(declaim (ftype (function (stream) source-iter) stream-line-iter))
+(defun stream-line-iter (stream)
+  (make-source-iter :next (lambda ()
+                            (or (read-line stream nil) *done*))))
+
+(declaim (ftype (function (generator) source-iter) generator-iter))
+(defun generator-iter (generator)
+  (make-source-iter :next (lambda ()
+                            (funcall (generator-func generator)))))
+
+(defgeneric source->source-iter (source)
+  (:documentation "Constructing a `source-iter' from SOURCE."))
+
+(declaim (ftype (function (t) source-iter) ensure-source-iter))
+(defun ensure-source-iter (thing)
+  "Calls `source->source-iter' iff THING is not `source-iter-p'"
+  (if (source-iter-p thing)
+      thing
+      (values (source->source-iter thing))))
+
+(defmethod source->source-iter (fallback)
+  (error 'no-transduce-implementation :type (type-of fallback)))
+
+(defmethod source->source-iter ((source list))
+  (list-iter source))
+
+(defmethod source->source-iter ((source cl:vector))
+  (vector-iter source))
+
+(defmethod source->source-iter ((source pathname))
+  (file-line-iter source))
+
+(defmethod source->source-iter ((source stream))
+  (stream-line-iter source))
+
+(defmethod source->source-iter ((source generator))
+  (generator-iter source))
+
+(declaim (ftype (function ((function (t t) t) t (function () t)) (values t t t)) source-next-1))
+(defun source-next-1 (f acc next)
+  "Fetch and process the next value, i.e. (F ACC (NEXT))
+
+NEXT should be a function as described by `source-iter-next'.
+F is a \"reducer\" function for ACC. It can return `reduced' to tell that the
+iteration is done.
+
+Returns three values:
+1. The result of calling the reducer, F on ACC and the next item. Only called
+when the next item is not `*done*'.
+2. The item produced by NEXT (see `source-iter-next' for semantics).
+3. `*done*' if no item was produced or F decided to stop."
+  (let* ((item (funcall next))
+         (done (eq item *done*))
+         (new-acc (if done
+                      acc
+                      (safe-call f acc item))))
+    (if (reduced-p new-acc)
+        (values (reduced-val new-acc) item *done*)
+        (values new-acc item (if done *done* nil)))))
+
+(declaim (ftype (function (t t source-iter) *) source-iter-transduce))
+(defun source-iter-transduce (xform f source)
+  (let* ((init (funcall f))
+         (xf (funcall xform f))
+         (result (source-iter-reduce xf init source)))
+    (funcall xf result)))
+
+(defun source-iter-reduce (xf init source)
+  (prog2
+      (funcall (source-iter-initialize source))
+      (unwind-protect
+           (labels ((recurse (acc)
+                      (multiple-value-bind (new-acc item done) (source-next-1 xf acc (source-iter-next source))
+                        (declare (ignore item))
+                        (if done
+                            new-acc
+                            (recurse new-acc)))))
+             (recurse init))
+        (funcall (source-iter-finalize source)))))
+
+(declaim (ftype (function (source-iter &rest source-iter) source-iter) multi-iter))
+(defun multi-iter (source &rest more-sources)
+  (let ((sources (mapcar #'ensure-source-iter (cl:cons source more-sources))))
+    (make-source-iter
+     :initialize (lambda ()
+                   (dolist (source sources)
+                     (funcall (source-iter-initialize source))))
+     :finalize (lambda ()
+                 (dolist (source sources)
+                   (funcall (source-iter-finalize source))))
+     :next (lambda ()
+             (block next
+               (let ((result '()))
+                 (dolist (source sources (nreverse result))
+                   (let ((value (funcall (source-iter-next source))))
+                     (if (eq value *done*)
+                         (return-from next *done*)
+                         (push value result))))))))))
diff --git a/transducers/transducers.lisp b/transducers/transducers.lisp
index c397552..bd2fc8f 100644
--- a/transducers/transducers.lisp
+++ b/transducers/transducers.lisp
@@ -184,7 +184,7 @@ transduction as soon as any element fails the test."
   "Transducer: Concatenate all the sublists in the transduction."
   (let ((preserving-reducer (preserving-reduced reducer)))
     (lambda (result &optional (input nil i-p))
-      (if i-p (list-reduce preserving-reducer result input)
+      (if i-p (source-iter-reduce preserving-reducer result (source->source-iter input))
           (funcall reducer result)))))
 
 #+nil
@@ -195,7 +195,7 @@ transduction as soon as any element fails the test."
 nesting."
   (lambda (result &optional (input nil i-p))
     (if i-p (if (listp input)
-                (list-reduce (preserving-reduced (flatten reducer)) result input)
+                (source-iter-reduce (preserving-reduced (flatten reducer)) result (source->source-iter input))
                 (funcall reducer result input))
         (funcall reducer result))))
 
diff --git a/transducers/utils.lisp b/transducers/utils.lisp
index 3c25179..86d482c 100644
--- a/transducers/utils.lisp
+++ b/transducers/utils.lisp
@@ -54,12 +54,12 @@
 
 (defun preserving-reduced (reducer)
   "A helper function that wraps a reduced value twice since reducing
-functions (like list-reduce) unwraps them. tconcatenate is a good example: it
-re-uses its reducer on its input using list-reduce. If that reduction finishes
-early and returns a reduced value, list-reduce would 'unreduce' that value and
+functions (like `source-iter-reduce') unwraps them. `concatenate' is a good example: it
+re-uses its reducer on its input using `source-iter-reduce'. If that reduction finishes
+early and returns a reduced value, `suorce-iter-reduce' would 'unreduce' that value and
 try to continue the transducing process."
-  (lambda (a b)
-    (let ((result (funcall reducer a b)))
+  (lambda (&rest args)
+    (let ((result (apply reducer args)))
       (if (reduced-p result)
           (make-reduced :val result)
           result))))

From a9692a747732b2bedabded1f0cbfd64b91e3af8f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Endsj=C3=B8?= <contact@simendsjo.me>
Date: Sun, 4 Aug 2024 19:55:32 +0200
Subject: [PATCH 8/8] feat: add iterator

---
 transducers.asd              |   1 +
 transducers/iterator.lisp    | 150 +++++++++++++++++++++++++++++++++++
 transducers/transducers.lisp |   3 +-
 3 files changed, 153 insertions(+), 1 deletion(-)
 create mode 100644 transducers/iterator.lisp

diff --git a/transducers.asd b/transducers.asd
index c5f9e94..47ed2f1 100644
--- a/transducers.asd
+++ b/transducers.asd
@@ -8,6 +8,7 @@
                 ((:file "transducers")
                  (:file "reducers")
                  (:file "sources")
+                 (:file "iterator")
                  (:file "entry")
                  (:file "conditions")
                  (:file "utils"))))
diff --git a/transducers/iterator.lisp b/transducers/iterator.lisp
new file mode 100644
index 0000000..1078afd
--- /dev/null
+++ b/transducers/iterator.lisp
@@ -0,0 +1,150 @@
+(in-package :transducers)
+
+(defstruct iter-acc
+  (:documentation "Accumulator/state for the `iterator' reducer.
+
+  `iter-acc-i-p' is true if the iterator reducer got an input.
+
+  `iter-acc-input' is one of three possible values; 'UNINITIALIZED if the iterator has not
+  yet started, `*done*' if the iterator has finished, or the previous input value
+  for the iterator reducer if `iter-acc-i-p' is true.
+
+  `iter-acc-acc' is the accumulator for the wrapped reducer.")
+  (i-p nil :type boolean)
+  (input nil :type t)
+  (acc nil :type t))
+
+(defstruct (iterator (:constructor %make-iterator)
+                     (:print-function (lambda (iterator stream depth)
+                                        (declare (ignore depth))
+                                        (print-unreadable-object (iterator stream :type t :identity t)
+                                          (with-slots (input acc) (iterator-acc iterator)
+                                            (format stream "acc: ~a, input: ~a" acc input))))))
+  (:documentation "Iterating over `iterator-iter' using `iterator-f' as the reducer, keeping state
+  in `iterator-acc'.
+
+`initialize-iterator' must be called before the first call to `next' or `next-1'.
+`finalize-iterator' must be called after the last call to `next' or `next-1'.
+See `with-iterator' for a convenient macro that does this.")
+  (acc nil :type iter-acc)
+  (f nil :type (function (&optional iter-acc t) iter-acc))
+  (iter nil :type source-iter))
+
+(declaim (ftype (function (iterator) t) initialize-iterator))
+(defun initialize-iterator (iterator)
+  "Initialize the itererators source. See `source-iter-initialize'."
+  (funcall (source-iter-initialize (iterator-iter iterator))))
+
+(declaim (ftype (function (iterator) t) finalize-iterator))
+(defun finalize-iterator (iterator)
+  "Finalize the iteranors source. See `source-iter-finalize'."
+  (funcall (source-iter-finalize (iterator-iter iterator))))
+
+(declaim (ftype (function (t t) (function (source-iter) iterator)) make-iterator))
+(defun make-iterator (xform f)
+  "Create blueprint for an `iterator'.
+
+Returns a function that accepts a `source-iter' and creates an `iterator'."
+  (lambda (source)
+    (let ((iter-f (lambda (&optional (acc nil a-p) (input nil i-p))
+                    (cond ((and a-p i-p) (make-iter-acc :acc (funcall f (iter-acc-acc acc) input)
+                                                        :input input
+                                                        :i-p i-p))
+                          ((and a-p (not i-p)) (make-iter-acc :acc (funcall f (iter-acc-acc acc))
+                                                              :input *done*
+                                                              :i-p i-p))
+                          (t (make-iter-acc :acc (funcall f)
+                                            :input 'uninitialized
+                                            :i-p i-p))))))
+      (%make-iterator :acc (funcall iter-f)
+                      :f (funcall xform iter-f)
+                      :iter (ensure-source-iter source)))))
+
+(declaim (ftype (function (iterator) (values iter-acc t t)) next-1))
+(defun next-1 (iterator)
+  "Step one source value for ITERATOR.
+
+If ITERATOR is already marked as done, `*done*' is used as the source value, and
+the function returns.
+
+Note that this function does not handle `reduced', so it might be returned
+as-is. This is done to allow the caller, e.g. `next' to know the reducer was not
+called, i.e. the value was skipped.
+
+Returns three values:
+1. The new accumulator after applying `iterator-f' to the previous accumulator
+and the source value.
+2. The source value as produced by `source-next-1'
+3. `*done*' when the source is exhausted"
+  (with-slots (acc (source-iter iter)) iterator
+    ;; Explicitly handle done. If the iterator has been told to stop, we don't
+    ;; want to keep calling the underlying source-iter and keep doing work.
+    (let ((input (iter-acc-input acc)))
+      (when (eq input *done*)
+        (return-from next-1 (values acc *done* *done*))))
+    (multiple-value-bind (new-acc source-value done) (source-next-1 (iterator-f iterator)
+                                                                    acc
+                                                                    (source-iter-next source-iter))
+      (declare (ignore source-value))
+      (when done
+        (setf new-acc (funcall (iterator-f iterator) new-acc)))
+      (setf acc new-acc)
+      (values acc (iter-acc-input acc) done))))
+
+(declaim (ftype (function (iterator) (values t t t)) next))
+(defun next (iterator)
+  "Step one value for ITERATOR.
+
+Calls `next-1' until a value is produced (or the source is exhausted).
+
+For each step, returns the following three values:
+1. The new accumulator (the underlying accumulator, not the iterators internal state)
+2. The source value as produced by `source-next-1'
+3. `*done*' when the source is exhausted"
+  (let ((acc-before (iterator-acc iterator)))
+    (multiple-value-bind (acc-after source-value done) (next-1 iterator)
+      (cond
+        ;; Done
+        (done (values (iter-acc-acc acc-after) source-value done))
+        ;; Never called the reducer, so the value never got through
+        ((eq acc-before acc-after) (next iterator))
+        ;; Got value
+        ((iter-acc-i-p acc-after) (values (iter-acc-acc acc-after) source-value done))
+        ;; Didn't get value
+        (t (next iterator))))))
+
+(defmacro with-iterator (iterator &body body)
+  "Initialize and finalize ITERATOR around BODY."
+  (let ((it (gensym "WITH-ITERATOR-")))
+    `(let ((,it ,iterator))
+       (initialize-iterator ,it)
+       (unwind-protect (progn ,@body)
+         (finalize-iterator ,it)))))
+
+(declaim (ftype (function (iterator) iter-acc) iterator-reduce))
+(defun iterator-reduce (iterator)
+  "Reduce ITERATOR.
+
+Exhausts the iterator in an `with-iterator' block and returns the final
+accumulator."
+  (with-iterator iterator
+    (labels ((recurse ()
+               (multiple-value-bind (acc value done) (next iterator)
+                 (declare (ignore value))
+                 (if done
+                     acc
+                     (recurse)))))
+      (recurse))))
+
+(defmacro iter* (source &rest transducers-and-reducer)
+  `(pipe* iterator ,source ,@transducers-and-reducer))
+
+(defmacro iter (source &rest transducers)
+  (if transducers
+      `(pipe* iterator ,source ,@transducers #'pass-reducer)
+      `(pipe* iterator ,source #'pass #'pass-reducer)))
+
+(defgeneric iterator (xform f source))
+
+(defmethod iterator (xform f source)
+  (funcall (make-iterator xform f) source))
diff --git a/transducers/transducers.lisp b/transducers/transducers.lisp
index bd2fc8f..2817f87 100644
--- a/transducers/transducers.lisp
+++ b/transducers/transducers.lisp
@@ -6,7 +6,8 @@
            #:random)
   ;; --- Entry Points --- ;;
   (:export #:transduce
-           #:pipe)
+           #:pipe
+           #:iterator #:make-iterator #:with-iterator #:iter #:iter* #:next)
   ;; --- Transducers -- ;;
   (:export #:pass #:map
            #:filter #:filter-map #:unique #:dedup