CLJS-2445: Reducible sequence generators

Author: mfikes

benchmark/cljs/benchmark_runner.cljs

@@ -421,4 +421,31 @@
 (simple-benchmark [x js/Infinity] (pr-str x) 1000000)
 (simple-benchmark [x js/-Infinity] (pr-str x) 1000000)
 (simple-benchmark [x (js-obj)] (pr-str x) 1000000)
-(println)
+
+(println "\n")
+(println ";; cycle")
+(simple-benchmark [] (doall (take 1000 (cycle [1 2 3]))) 1000)
+(simple-benchmark [] (into [] (take 1000) (cycle [1 2 3])) 1000)
+(simple-benchmark [] (reduce + (take 64 (cycle [1 2 3]))) 10000)
+(simple-benchmark [] (transduce (take 64) + (cycle [1 2 3])) 10000)
+
+(println "\n")
+(println ";; repeat")
+(simple-benchmark [] (doall (take 1000 (repeat 1))) 1000)
+(simple-benchmark [] (into [] (take 1000) (repeat 1)) 1000)
+(simple-benchmark [] (doall (repeat 1000 1)) 1000)
+(simple-benchmark [] (into [] (repeat 1000 1)) 1000)
+(simple-benchmark [] (reduce + 0 (repeat 1000 1)) 1000)
+(simple-benchmark [] (into [] (take 1000) (repeat 1)) 1000)
+(simple-benchmark [] (reduce + (take 64 (repeat 1))) 10000)
+(simple-benchmark [] (transduce (take 64) + (repeat 1)) 10000)
+(simple-benchmark [] (reduce + (take 64 (repeat 48 1))) 10000)
+(simple-benchmark [] (transduce (take 64) + (repeat 48 1)) 10000)
+
+(println "\n")
+(println ";; iterate")
+(simple-benchmark [] (doall (take 1000 (iterate inc 0))) 1000)
+(simple-benchmark [] (into [] (take 1000) (iterate inc 0)) 1000)
+(simple-benchmark [] (reduce + (take 64 (iterate inc 0))) 10000)
+(simple-benchmark [] (transduce (take 64) + (iterate inc 0)) 10000)
+(println)

src/main/cljs/cljs/core.cljs

@@ -1897,7 +1897,7 @@ reduces them without incurring seq initialization"
   "Returns the nth rest of coll, coll when n is 0."
   [coll n]
     (loop [n n xs coll]
-      (if (and (pos? n) (seq xs))
+      (if-let [xs (and (pos? n) (seq xs))]
         (recur (dec n) (rest xs))
         xs)))
 
@@ -4775,21 +4775,175 @@ reduces them without incurring seq initialization"
                       s)))]
        (lazy-seq (step pred coll)))))
 
+(deftype Cycle [meta all prev ^:mutable current ^:mutable _next]
+  Object
+  (toString [coll]
+    (pr-str* coll))
+  (currentval [coll]
+    (when-not ^seq current
+      (if-let [c (next prev)]
+        (set! current c)
+        (set! current all)))
+    current)
+
+  IPending
+  (-realized? [coll]
+    (some? current))
+
+  IWithMeta
+  (-with-meta [coll meta] (Cycle. meta all prev current _next))
+
+  IMeta
+  (-meta [coll] meta)
+
+  ISeq
+  (-first [coll]
+    (first (.currentval coll)))
+  (-rest [coll]
+    (when (nil? _next)
+      (set! _next (Cycle. nil all (.currentval coll) nil nil)))
+    _next)
+
+  INext
+  (-next [coll]
+    (-rest coll))
+
+  ICollection
+  (-conj [coll o] (cons o coll))
+
+  IEmptyableCollection
+  (-empty [coll] (-with-meta (.-EMPTY List) meta))
+
+  ISequential
+  ISeqable
+  (-seq [coll] coll)
+
+  IReduce
+  (-reduce [coll f]
+    (loop [s (.currentval coll) ret (first s)]
+      (let [s   (or (next s) all)
+            ret (f ret (first s))]
+        (if (reduced? ret)
+          @ret
+          (recur s ret)))))
+  (-reduce [coll f start]
+    (loop [s (.currentval coll) ret start]
+      (let [ret (f ret (first s))]
+        (if (reduced? ret)
+          @ret
+          (recur (or (next s) all) ret))))))
+
 (defn cycle
   "Returns a lazy (infinite!) sequence of repetitions of the items in coll."
-  [coll] (lazy-seq
-          (when-let [s (seq coll)]
-            (concat s (cycle s)))))
+  [coll] (if-let [vals (seq coll)]
+           (Cycle. nil vals nil vals nil)
+           (.-EMPTY List)))
 
 (defn split-at
   "Returns a vector of [(take n coll) (drop n coll)]"
   [n coll]
   [(take n coll) (drop n coll)])
 
+(deftype Repeat [meta count val ^:mutable next ^:mutable __hash]
+  Object
+  (toString [coll]
+    (pr-str* coll))
+  (equiv [this other]
+    (-equiv this other))
+  (indexOf [coll x]
+    (-indexOf coll x 0))
+  (indexOf [coll x start]
+    (-indexOf coll x start))
+  (lastIndexOf [coll x]
+    (-lastIndexOf coll x count))
+  (lastIndexOf [coll x start]
+    (-lastIndexOf coll x start))
+
+  IPending
+  (-realized? [coll] false)
+  
+  IWithMeta
+  (-with-meta [coll meta] (Repeat. meta count val next nil))
+
+  IMeta
+  (-meta [coll] meta)
+
+  ISeq
+  (-first [coll]
+    val)
+  (-rest [coll]
+    (if (nil? next)
+      (if (> count 1)
+        (do
+          (set! next (Repeat. nil (dec count) val nil nil))
+          next)
+        (if (== -1 count)
+          coll
+          ()))
+      next))
+
+  INext
+  (-next [coll]
+    (if (nil? next)
+      (if (> count 1)
+        (do
+          (set! next (Repeat. nil (dec count) val nil nil))
+          next)
+        (if (== -1 count)
+          coll
+          nil))
+      next))
+
+  ICollection
+  (-conj [coll o] (cons o coll))
+
+  IEmptyableCollection
+  (-empty [coll] (-with-meta (.-EMPTY List) meta))
+
+  IHash
+  (-hash [coll] (caching-hash coll hash-ordered-coll __hash))
+
+  ISequential
+  ISeqable
+  (-seq [coll] coll)
+  
+  IEquiv
+  (-equiv [coll other] (equiv-sequential coll other))
+
+  IReduce
+  (-reduce [coll f]
+    (if (== count -1)
+      (loop [ret (f val val)]
+        (if (reduced? ret)
+          @ret
+          (recur (f ret val))))
+      (loop [i 1 ret val]
+        (if (< i count)
+          (let [ret (f ret val)]
+            (if (reduced? ret)
+              @ret
+              (recur (inc i) ret)))
+          ret))))
+  (-reduce [coll f start]
+    (if (== count -1)
+      (loop [ret (f start val)]
+        (if (reduced? ret)
+          @ret
+          (recur (f ret val))))
+      (loop [i 0 ret start]
+        (if (< i count)
+          (let [ret (f ret val)]
+            (if (reduced? ret)
+              @ret
+              (recur (inc i) ret)))
+          ret)))))
+
 (defn repeat
   "Returns a lazy (infinite!, or length n if supplied) sequence of xs."
-  ([x] (lazy-seq (cons x (repeat x))))
-  ([n x] (take n (repeat x))))
+  ([x] (Repeat. nil -1 x nil nil))
+  ([n x] (if (pos? n)
+           (Repeat. nil n x nil nil)
+           (.-EMPTY List))))
 
 (defn replicate
   "DEPRECATED: Use 'repeat' instead.
@@ -4803,10 +4957,68 @@ reduces them without incurring seq initialization"
   ([f] (lazy-seq (cons (f) (repeatedly f))))
   ([n f] (take n (repeatedly f))))
 
+(def ^:private UNREALIZED-SEED #js {})
+
+(deftype Iterate [meta f prev-seed ^:mutable seed ^:mutable next]
+  Object
+  (toString [coll]
+    (pr-str* coll))
+
+  IPending
+  (-realized? [coll]
+    (not (identical? seed UNREALIZED-SEED)))
+
+  IWithMeta
+  (-with-meta [coll meta] (Iterate. meta f prev-seed seed next))
+
+  IMeta
+  (-meta [coll] meta)
+
+  ISeq
+  (-first [coll]
+    (when (identical? UNREALIZED-SEED seed)
+      (set! seed (f prev-seed)))
+    seed)
+  (-rest [coll]
+    (when (nil? next)
+      (set! next (Iterate. nil f (-first coll) UNREALIZED-SEED nil)))
+    next)
+
+  INext
+  (-next [coll]
+    (-rest coll))
+
+  ICollection
+  (-conj [coll o] (cons o coll))
+
+  IEmptyableCollection
+  (-empty [coll] (-with-meta (.-EMPTY List) meta))
+
+  ISequential
+  ISeqable
+  (-seq [coll] coll)
+
+  IReduce
+  (-reduce [coll rf]
+    (let [first (-first coll)
+          v     (f first)]
+      (loop [ret (rf first v) v v]
+        (if (reduced? ret)
+          @ret
+          (let [v (f v)]
+            (recur (rf ret v) v))))))
+  (-reduce [coll rf start]
+    (let [v (-first coll)]
+      (loop [ret (rf start v) v v]
+        (if (reduced? ret)
+          @ret
+          (let [v (f v)]
+            (recur (rf ret v) v)))))))
+
 (defn iterate
   "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects"
   {:added "1.0"}
-  [f x] (cons x (lazy-seq (iterate f (f x)))))
+  [f x] (Iterate. nil f nil x nil))
 
 (defn interleave
   "Returns a lazy seq of the first item in each coll, then the second etc."
@@ -9507,8 +9719,8 @@ reduces them without incurring seq initialization"
   be used to force any effects. Walks through the successive nexts of
   the seq, does not retain the head and returns nil."
   ([coll]
-   (when (seq coll)
-     (recur (next coll))))
+   (when-let [s (seq coll)]
+     (recur (next s))))
   ([n coll]
    (when (and (seq coll) (pos? n))
      (recur (dec n) (next coll)))))
@@ -9960,6 +10172,15 @@ reduces them without incurring seq initialization"
   Range
   (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
 
+  Cycle
+  (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  Repeat
+  (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  Iterate
+  (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
   ES6IteratorSeq
   (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
 

src/test/cljs/cljs/collections_test.cljs

@@ -8,7 +8,7 @@
 
 (ns cljs.collections-test
   (:refer-clojure :exclude [iter])
-  (:require [cljs.test :refer-macros [deftest testing is]]
+  (:require [cljs.test :refer-macros [deftest testing is are]]
             [clojure.string :as s]
             [clojure.set :as set]))
 
@@ -165,6 +165,227 @@
     (is (= (take 3 (range 3 1 0)) (list 3 3 3)))
     ))
 
+(deftest test-cycle
+  (testing "Testing Cycle"
+
+    (is (= "(1 2 3 1 2 ...)" (binding [*print-length* 5] (pr-str (cycle [1 2 3])))))
+
+    (are [x y] (= x y)
+      (cycle []) ()
+      (cycle nil) ()
+
+      (take 3 (cycle [1])) '(1 1 1)
+      (take 5 (cycle [1 2 3])) '(1 2 3 1 2)
+
+      (take 3 (cycle [nil])) '(nil nil nil)
+
+      (transduce (take 5) + (cycle [1])) 5
+      (transduce (take 5) + 2 (cycle [1])) 7
+      (transduce (take 5) + (cycle [3 7])) 23
+      (transduce (take 5) + 2 (cycle [3 7])) 25
+
+      (take 2 (cycle (map #(/ 42 %) '(2 1 0)))) '(21 42)
+      (first (cycle [1 2 3])) 1
+      (first (rest (cycle [1 2 3]))) 2
+      (first (next (cycle [1 2 3]))) 2
+      (first (conj (cycle [1 2 3]) :hi)) :hi
+      (empty (cycle [1 2 3])) ()
+      (first (next (cycle (map #(/ 42 %) '(2 1 0))))) 42
+      (into [] (take 2) (cycle (map #(/ 42 %) '(2 1 0)))) '(21 42)
+
+      (first (seq (cycle [1 2 3]))) 1)
+
+    ; indexOf fns work on the finite cycle
+    (is (= -1 (.indexOf (cycle []) 19)))
+    (is (= -1 (.indexOf (cycle []) 19 2)))
+    (is (= -1 (.lastIndexOf (cycle []) 19)))
+    (is (= -1 (.lastIndexOf (cycle []) 19 2)))
+
+    (is (= {:a 1} (meta (with-meta (cycle [1 2 3]) {:a 1}))))
+    (is (= {:a 1} (meta (empty (with-meta (cycle [1 2 3]) {:a 1})))))
+    (is (= (take 7 (with-meta (cycle [1 2 3]) {:a 1})) (take 7 (cycle [1 2 3]))))
+
+    (is (realized? (cycle [1 2 3])))
+
+    (are [x y] (= (transduce (take x) conj (cycle [1 2 3])) y)
+      0 []
+      1 [1]
+      2 [1 2]
+      3 [1 2 3]
+      4 [1 2 3 1]
+      5 [1 2 3 1 2]
+      6 [1 2 3 1 2 3]
+      7 [1 2 3 1 2 3 1])
+
+    (are [x y] (= (transduce (take x) conj [:x] (cycle [1 2 3])) y)
+      0 [:x]
+      1 [:x 1]
+      2 [:x 1 2]
+      3 [:x 1 2 3]
+      4 [:x 1 2 3 1]
+      5 [:x 1 2 3 1 2]
+      6 [:x 1 2 3 1 2 3]
+      7 [:x 1 2 3 1 2 3 1])))
+
+(deftest test-repeat
+  (testing "Testing Repeat"
+    (is (= (repeat 5 :x) (repeat 5 :x)))
+    (is (= (repeat 5 :x) '(:x :x :x :x :x)))
+    (is (= (hash (repeat 5 :x)) (hash '(:x :x :x :x :x))))
+    (is (= (assoc (array-map (repeat 1 :x) :y) '(:x) :z) {'(:x) :z}))
+    (is (= (assoc (hash-map (repeat 1 :x) :y) '(:x) :z) {'(:x) :z}))
+
+    (is (= "(7 7 7 ...)" (binding [*print-length* 3] (pr-str (repeat 7)))))
+    (is (= "(7 7 7)" (pr-str (repeat 3 7))))
+
+    (are [x y] (= x y)
+      (take 0 (repeat 7)) ()
+      (take 1 (repeat 7)) '(7)
+      (take 2 (repeat 7)) '(7 7)
+      (take 5 (repeat 7)) '(7 7 7 7 7))
+
+    ; limited sequence
+    (are [x y] (= x y)
+      (repeat 0 7) ()
+      (repeat 1 7) '(7)
+      (repeat 2 7) '(7 7)
+      (repeat 5 7) '(7 7 7 7 7)
+
+      (repeat -1 7) ()
+      (repeat -3 7) ())
+
+    ;; counts
+    (are [x y] (= (count x) y)
+      (repeat 0 7) 0
+      (repeat 1 7) 1
+      (repeat 2 7) 2
+      (repeat 5 7) 5
+
+      (repeat -1 7) 0
+      (repeat -3 7) 0)
+
+    ; test different data types
+    (are [x] (= (repeat 3 x) (list x x x))
+      nil
+      false true
+      0 42
+      0.0 3.14
+      0M 1M
+      \c
+      "" "abc"
+      'sym
+      :kw
+      () '(1 2)
+      [] [1 2]
+      {} {:a 1 :b 2}
+      #{} #{1 2})
+
+    ; indexOf / lastIndexOf work on finite repeats
+    (is (= -1 (.indexOf (repeat 7 5) 19)))
+    (is (= -1 (.indexOf (repeat 7 5) 19 2)))
+    (is (= -1 (.lastIndexOf (repeat 7 5) 19)))
+    (is (= -1 (.lastIndexOf (repeat 7 5) 19 2)))
+    (is (= 0 (.indexOf (repeat 7 5) 5)))
+    (is (= 6 (.lastIndexOf (repeat 7 5) 5)))
+    (is (= 3 (.indexOf (repeat 7 5) 5 3)))
+    (is (= 3 (.lastIndexOf (repeat 7 5) 5 3)))
+
+    (is (= {:a 1} (meta (with-meta (repeat 5 7) {:a 1}))))
+    (is (= {:a 1} (meta (empty (with-meta (repeat 5 7) {:a 1})))))
+    (is (= (with-meta (repeat 5 7) {:a 1}) (repeat 5 7)))
+
+    (is (not (realized? (repeat 5 7))))
+
+    (is (= [1 1] (into [] (drop 98) (repeat 100 1))))
+
+    (is (= () (empty (repeat 100 1))))
+    (is (= () (empty (repeat 7))))
+
+    (are [x y] (= (transduce (take x) conj (repeat 1)) y)
+      0 []
+      1 [1]
+      2 [1 1]
+      3 [1 1 1])
+
+    (are [x y] (= (transduce (take x) conj [:x] (repeat 1)) y)
+      0 [:x]
+      1 [:x 1]
+      2 [:x 1 1]
+      3 [:x 1 1 1])
+
+    (are [x y] (= (transduce (take x) conj (repeat 2 1)) y)
+      0 []
+      1 [1]
+      2 [1 1]
+      3 [1 1])
+
+    (are [x y] (= (transduce (take x) conj [:x] (repeat 2 1)) y)
+      0 [:x]
+      1 [:x 1]
+      2 [:x 1 1]
+      3 [:x 1 1])))
+
+(deftest test-iterate
+  (testing "Testing Iterate"
+    (are [x y] (= x y)
+      (take 0 (iterate inc 0)) ()
+      (take 1 (iterate inc 0)) '(0)
+      (take 2 (iterate inc 0)) '(0 1)
+      (take 5 (iterate inc 0)) '(0 1 2 3 4))
+
+    (is (= "(0 1 2 ...)" (binding [*print-length* 3] (pr-str (iterate inc 0)))))
+
+    (is (not (realized? (rest (iterate inc 0)))))
+
+    (is (= {:a 1} (meta (with-meta (iterate inc 0) {:a 1}))))
+    (is (= {:a 1} (meta (empty (with-meta (iterate inc 0) {:a 1})))))
+    (is (= (take 20 (with-meta (iterate inc 0) {:a 1})) (take 20 (iterate inc 0))))
+
+    (is (= [:first 0 1] (take 3 (conj (iterate inc 0) :first))))
+
+    (is (= () (empty (iterate inc 0))))
+
+    (let [v (iterate inc 0)]
+      (is (identical? v (seq v))))
+
+    (is (= 0 (first (iterate inc 0))))
+    (is (= 1 (first (rest (iterate inc 0)))))
+    (is (= 1 (first (next (iterate inc 0)))))
+
+    ;; test other fns
+    (is (= '(:foo 42 :foo 42) (take 4 (iterate #(if (= % :foo) 42 :foo) :foo))))
+    (is (= '(1 false true true) (take 4 (iterate boolean? 1))))
+    (is (= '(256 128 64 32 16 8 4 2 1 0) (take 10 (iterate #(quot % 2) 256))))
+
+    ;; reduce via transduce
+    (is (= (transduce (take 5) + (iterate #(* 2 %) 2)) 62))
+    (is (= (transduce (take 5) + 1 (iterate #(* 2 %) 2)) 63))
+
+    (are [x y] (= (transduce (take x) conj (iterate inc 0)) y)
+      0 []
+      1 [0]
+      2 [0 1]
+      3 [0 1 2])
+
+    (are [x y] (= (transduce (take x) conj [:x] (iterate inc 0)) y)
+      0 [:x]
+      1 [:x 0]
+      2 [:x 0 1]
+      3 [:x 0 1 2])))
+
+(deftest test-split-at
+  (is (vector? (split-at 2 [])))
+  (is (vector? (split-at 2 [1 2 3])))
+
+  (are [x y] (= x y)
+    (split-at 2 []) [() ()]
+    (split-at 2 [1 2 3 4 5]) [(list 1 2) (list 3 4 5)]
+
+    (split-at 5 [1 2 3]) [(list 1 2 3) ()]
+    (split-at 0 [1 2 3]) [() (list 1 2 3)]
+    (split-at -1 [1 2 3]) [() (list 1 2 3)]
+    (split-at -5 [1 2 3]) [() (list 1 2 3)] ))
+
 (deftest test-rseq
   (testing "Testing RSeq"
     (is (= '(3 2 1) (reverse (seq (array 1 2 3)))))