CLJS-2034: Sequence and Eduction produce infinite loop in transducer that appends to the reduction

The implementation of transducers in ClojureScript tracked an old counterpart in
the Clojure codebase. This patch addresses the change introduced in the
following commit to Clojure, which replaced `LazyTransformer` with
`TransformerIterator`, effectively making the transducer behavior akin to the
one in Clojure.

clojure/clojure@c47e1bb

Author: anmonteiro

src/main/cljs/cljs/core.cljs

@@ -3409,7 +3409,7 @@ reduces them without incurring seq initialization"
     (-lastIndexOf coll x (count coll)))
   (lastIndexOf [coll x start]
     (-lastIndexOf coll x start))
-  
+
   IWithMeta
   (-with-meta [coll m]
     (ChunkedCons. chunk more m __hash))
@@ -3868,41 +3868,53 @@ reduces them without incurring seq initialization"
     (seqable? coll) (seq-iter coll)
     :else (throw (js/Error. (str "Cannot create iterator from " coll)))))
 
-(declare LazyTransformer)
+(deftype Many [vals]
+  Object
+  (add [this o]
+    (.push vals o)
+    this)
+  (remove [this]
+    (.shift vals))
+  (isEmpty [this]
+    (zero? (.-length vals)))
+  (toString [this]
+    (str "Many: " vals)))
 
-(defn lazy-transformer [stepper]
-  (LazyTransformer. stepper nil nil nil))
+(def ^:private NONE #js {})
 
-(deftype Stepper [xform iter]
+(deftype Single [^:mutable val]
   Object
-  (step [this lt]
-    (loop []
-      (if (and (not (nil? (.-stepper lt)))
-               (.hasNext iter))
-        (if (reduced? (xform lt (.next iter)))
-          (when-not (nil? (.-rest lt))
-            (set! (.. lt -rest -stepper) nil))
-          (recur))))
-    (when-not (nil? (.-stepper lt))
-      (xform lt))))
-
-(defn stepper [xform iter]
-  (letfn [(stepfn
-            ([result]
-               (let [lt (if (reduced? result)
-                          @result
-                          result)]
-                 (set! (.-stepper lt) nil)
-                 result))
-            ([result input]
-               (let [lt result]
-                 (set! (.-first lt) input)
-                 (set! (.-rest lt) (lazy-transformer (.-stepper lt)))
-                 (set! (.-stepper lt) nil)
-                 (.-rest lt))))]
-   (Stepper. (xform stepfn) iter)))
-
-(deftype MultiStepper [xform iters nexts]
+  (add [this o]
+    (if (identical? val NONE)
+      (do
+        (set! val o)
+        this)
+      (Many. #js [val o])))
+  (remove [this]
+    (if (identical? val NONE)
+      (throw (js/Error. (str "Removing object from empty buffer")))
+      (let [ret val]
+        (set! val NONE)
+        ret)))
+  (isEmpty [this]
+    (identical? val NONE))
+  (toString [this]
+    (str "Single: " val)))
+
+(deftype Empty []
+  Object
+  (add [this o]
+    (Single. o))
+  (remove [this]
+    (throw (js/Error. (str "Removing object from empty buffer"))))
+  (isEmpty [this]
+    true)
+  (toString [this]
+    "Empty"))
+
+(def ^:private EMPTY (Empty.))
+
+(deftype MultiIterator [iters]
   Object
   (hasNext [_]
     (loop [iters (seq iters)]
@@ -3913,128 +3925,83 @@ reduces them without incurring seq initialization"
             (recur (next iters))))
         true)))
   (next [_]
-    (dotimes [i (alength iters)]
-      (aset nexts i (.next (aget iters i))))
-    (prim-seq nexts 0))
-  (step [this lt]
-    (loop []
-      (if (and (not (nil? (.-stepper lt)))
-               (.hasNext this))
-        (if (reduced? (apply xform (cons lt (.next this))))
-          (when-not (nil? (.-rest lt))
-            (set! (.. lt -rest -stepper) nil))
-          (recur))))
-    (when-not (nil? (.-stepper lt))
-      (xform lt))))
-
-(defn multi-stepper
-  ([xform iters]
-     (multi-stepper xform iters
-       (make-array (alength iters))))
-  ([xform iters nexts]
-     (letfn [(stepfn
-               ([result]
-                  (let [lt (if (reduced? result)
-                             @result
-                             result)]
-                    (set! (.-stepper lt) nil)
-                    lt))
-               ([result input]
-                  (let [lt result]
-                    (set! (.-first lt) input)
-                    (set! (.-rest lt) (lazy-transformer (.-stepper lt)))
-                    (set! (.-stepper lt) nil)
-                    (.-rest lt))))]
-       (MultiStepper. (xform stepfn) iters nexts))))
-
-(deftype LazyTransformer [^:mutable stepper ^:mutable first ^:mutable rest meta]
+    (let [nexts (array)]
+      (dotimes [i (alength iters)]
+        (aset nexts i (.next (aget iters i))))
+      (prim-seq nexts 0))))
+
+(defn- chunkIteratorSeq [iter]
+  (lazy-seq
+    (when ^boolean (.hasNext iter)
+      (let [arr (array)]
+        (loop [n 0]
+          (if (and (.hasNext iter) (< n 32))
+            (do
+              (aset arr n (.next iter))
+              (recur (inc n)))
+            (chunk-cons (array-chunk arr 0 n) (chunkIteratorSeq iter))))))))
+
+(deftype TransformerIterator [^:mutable buffer ^:mutable _next ^:mutable completed ^:mutable xf sourceIter multi]
   Object
-  (indexOf [coll x]
-    (-indexOf coll x 0))
-  (indexOf [coll x start]
-    (-indexOf coll x start))
-  (lastIndexOf [coll x]
-    (-lastIndexOf coll x (count coll)))
-  (lastIndexOf [coll x start]
-    (-lastIndexOf coll x start))
-
-  IWithMeta
-  (-with-meta [this new-meta]
-    (LazyTransformer. stepper first rest new-meta))
-
-  IMeta
-  (-meta [this] meta)
-
-  ICollection
-  (-conj [this o]
-    (cons o (-seq this)))
-
-  IEmptyableCollection
-  (-empty [this]
-    ())
-
-  ISequential
-  IEquiv
-  (-equiv [this other]
-    (let [s (-seq this)]
-      (if-not (nil? s)
-        (equiv-sequential this other)
-        (and (sequential? other)
-             (nil? (seq other))))))
-
-  IHash
-  (-hash [this]
-    (hash-ordered-coll this))
-
-  ISeqable
-  (-seq [this]
-    (when-not (nil? stepper)
-      (.step stepper this))
-    (if (nil? rest)
-      nil
-      this))
-
-  ISeq
-  (-first [this]
-    (when-not (nil? stepper)
-      (-seq this))
-    (if (nil? rest)
-      nil
-      first))
-
-  (-rest [this]
-    (when-not (nil? stepper)
-      (-seq this))
-    (if (nil? rest)
-      ()
-      rest))
-
-  INext
-  (-next [this]
-    (when-not (nil? stepper)
-      (-seq this))
-    (if (nil? rest)
-      nil
-      (-seq rest)))
-
-  IPending
-  (-realized? [_]
-    (nil? stepper)))
-
-(es6-iterable LazyTransformer)
-
-(set! (.-create LazyTransformer)
+  (step [this]
+    (if-not (identical? _next NONE)
+      true
+      (loop []
+        (if (identical? _next NONE)
+          (if ^boolean (.isEmpty buffer)
+            (if ^boolean completed
+              false
+              (if ^boolean (.hasNext sourceIter)
+                (let [iter (if ^boolean multi
+                             (apply xf (cons nil (.next sourceIter)))
+                             (xf nil (.next sourceIter)))]
+                  (when (reduced? iter)
+                    (xf nil)
+                    (set! completed true))
+                  (recur))
+                (do
+                  (xf nil)
+                  (set! completed true)
+                  (recur))))
+            (do
+              (set! _next (.remove buffer))
+              (recur)))
+          true))))
+  (hasNext [this]
+    (.step this))
+  (next [this]
+    (if ^boolean (.hasNext this)
+      (let [ret _next]
+        (set! _next NONE)
+        ret)
+      (throw (js/Error. "No such element"))))
+  (remove [_]
+    (js/Error. "Unsupported operation")))
+
+(es6-iterable TransformerIterator)
+
+(defn transformer-iterator
+  [xform sourceIter multi]
+  (let [iterator (TransformerIterator. EMPTY NONE false nil sourceIter multi)]
+    (set! (.-xf iterator)
+      (xform (fn
+               ([] nil)
+               ([acc] acc)
+               ([acc o]
+                (set! (.-buffer iterator) (.add (.-buffer iterator) o))
+                acc))))
+    iterator))
+
+(set! (.-create TransformerIterator)
   (fn [xform coll]
-    (LazyTransformer. (stepper xform (iter coll)) nil nil nil)))
+    (transformer-iterator xform (iter coll) false)))
 
-(set! (.-createMulti LazyTransformer)
+(set! (.-createMulti TransformerIterator)
   (fn [xform colls]
     (let [iters (array)]
       (doseq [coll colls]
         (.push iters (iter coll)))
-      (LazyTransformer.
-        (multi-stepper xform iters (make-array (alength iters)))
-        nil nil nil))))
+      (transformer-iterator xform (MultiIterator. iters) true))))
 
 (defn sequence
   "Coerces coll to a (possibly empty) sequence, if it is not already
@@ -4050,9 +4017,13 @@ reduces them without incurring seq initialization"
        coll
        (or (seq coll) ())))
   ([xform coll]
-     (.create LazyTransformer xform coll))
+   (or (chunkIteratorSeq
+         (.create TransformerIterator xform coll))
+       ()))
   ([xform coll & colls]
-     (.createMulti LazyTransformer xform (to-array (cons coll colls)))))
+   (or (chunkIteratorSeq
+         (.createMulti TransformerIterator xform (to-array (cons coll colls))))
+       ())))
 
 (defn ^boolean every?
   "Returns true if (pred x) is logical true for every x in coll, else
@@ -4257,7 +4228,7 @@ reduces them without incurring seq initialization"
     (-equiv this other))
 
   IAtom
-  
+
   IEquiv
   (-equiv [o other] (identical? o other))
 
@@ -9645,7 +9616,7 @@ reduces them without incurring seq initialization"
   LazySeq
   (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
 
-  LazyTransformer
+  TransformerIterator
   (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
 
   IndexedSeq
@@ -9955,6 +9926,10 @@ reduces them without incurring seq initialization"
 
   ISequential
 
+  IIterable
+  (-iterator [coll]
+    (.create TransformerIterator xform coll))
+
   ISeqable
   (-seq [_] (seq (sequence xform coll)))
 

src/test/cljs/cljs/core_test.cljs

@@ -348,7 +348,13 @@
       (is (= (sequence xf [0 0] [1 2]) [1 2])))
     (is (= (-> (sequence (map inc) [1 2 3])
              (with-meta {:a 1})
-             meta) {:a 1}))))
+             meta) {:a 1}))
+    (let [xf (fn [rf]
+               (fn
+                 ([] (rf))
+                 ([result] (rf result :foo))
+                 ([result input] (rf result input))))]
+      (is (= (sequence xf [1 2 3]) [1 2 3 :foo])))))
 
 (deftest test-obj-equiv
   (testing "Object equiv method"