diff options
| -rw-r--r-- | cljlib.fnl | 39 | ||||
| -rw-r--r-- | tests/core.fnl | 13 |
2 files changed, 42 insertions, 10 deletions
@@ -265,25 +265,44 @@ val and f is not called. Calls `seq` on `col`." _ (let [[a b & rest] col] (reduce f (f a b) rest))))) ([f val col] - (let [col (or (seq col) (empty []))] - (let [[x & xs] col] - (if (nil? x) - val - (reduce f (f val x) xs)))))) + (if-some [reduced (when-some [m (getmetatable val)] + (and m.cljlib/reduced + (= m.cljlib/reduced.status :ready) + m.cljlib/reduced.val))] + reduced + (let [col (or (seq col) (empty []))] + (let [[x & xs] col] + (if (nil? x) + val + (reduce f (f val x) xs))))))) + +(fn* core.reduced + "Wraps `x` in such a way so [`reduce`](#reduce) will terminate early + with this value." + [x] + (setmetatable + {} {:cljlib/reduced {:status :ready + :val x}})) (fn* core.reduce-kv "Reduces an associative table using function `f` and initial value `val`. `f` should be a function of 3 arguments. Returns the result of -applying `f` to `val`, the first key and the first value in `coll`, +applying `f` to `val`, the first key and the first value in `tbl`, then applying `f` to that result and the 2nd key and value, etc. If -`coll` contains no entries, returns `val` and `f` is not called. Note +`tbl` contains no entries, returns `val` and `f` is not called. Note that reduce-kv is supported on sequential tables and strings, where the keys will be the ordinals." - [f val col] + [f val tbl] (var res val) - (each [_ [k v] (pairs (or (seq col) (empty [])))] - (set res (f res k v))) + (each [_ [k v] (pairs (or (seq tbl) (empty [])))] + (set res (f res k v)) + (when-some [reduced (when-some [m (getmetatable res)] + (and m.cljlib/reduced + (= m.cljlib/reduced.status :ready) + m.cljlib/reduced.val))] + (set res reduced) + (lua :break))) res) (fn* core.mapv diff --git a/tests/core.fnl b/tests/core.fnl index 2481f02..3939458 100644 --- a/tests/core.fnl +++ b/tests/core.fnl @@ -315,6 +315,19 @@ (assert-not (pcall reduce-kv #(+ $1 $3))) (assert-not (pcall reduce-kv))) + (testing "reduced" + (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1]) 1) + (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2]) 3) + (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2 3 4]) 10) + (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2 3 4 5]) 15) + (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2 3 4 5 6]) -1) + (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) 10 [1]) 11) + (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) 10 [1 2]) -1) + + (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 0 {:a 1 :b 2}) 3) + (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 0 {:a 10 :b 2}) 12) + (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 1 {:a 10 :b 2}) -1)) + (testing "assoc" (assert-not (pcall assoc)) (assert-not (pcall assoc {})) |