diff --git a/CHANGELOG.md b/CHANGELOG.md index d3b3ff6fa..fddc50429 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed * Fix a bug where symbols and keyword containing `:` characters in the name were rejected by the reader (#1105) + * Fix a bug where records did not support reducing via `reduce-kv` (#1102) ## [v0.3.0] ### Added diff --git a/src/basilisp/core.lpy b/src/basilisp/core.lpy index 4e3f81aee..8428226ab 100644 --- a/src/basilisp/core.lpy +++ b/src/basilisp/core.lpy @@ -6842,12 +6842,12 @@ in the body of a method should not include that parameter, as it will be supplied automatically." [type-name fields & method-impls] - (let [ctor-name (with-meta - (symbol (str "->" (name type-name))) - (meta type-name)) - map-ctor (with-meta - (symbol (str "map->" (name type-name))) - (meta type-name)) + (let [ctor-name (with-meta + (symbol (str "->" (name type-name))) + (meta type-name)) + map-ctor (with-meta + (symbol (str "map->" (name type-name))) + (meta type-name)) record-fields (vec (concat fields ['^{:default nil} meta @@ -6861,6 +6861,7 @@ '[basilisp.lang.interfaces/IPersistentMap basilisp.lang.interfaces/IWithMeta basilisp.lang.interfaces/IRecord + basilisp.lang.interfaces/IReduceKV python/object]) ;; We can use these gensyms repeatedly and interpolate them in @@ -7005,6 +7006,17 @@ (str "#" ~(name *ns*) "." qual-name)) print-meta (str "^" (repr (meta ~this-gs)) " ")))) + ;; IReduceKV + (~'reduce-kv [~this-gs f# init#] + (loop [res# init# + fields# (seq ~this-gs)] + (cond + (reduced? res#) (deref res#) + (seq fields#) (let [[k# v#] (first fields#)] + (recur (f# res# k# v#) + (rest fields#))) + :else res#))) + ;; object (~'__eq__ [~this-gs ~other-gs] (or (identical? ~this-gs ~other-gs) diff --git a/tests/basilisp/test_core_fns.lpy b/tests/basilisp/test_core_fns.lpy index 9f669e1e3..289beb4fc 100644 --- a/tests/basilisp/test_core_fns.lpy +++ b/tests/basilisp/test_core_fns.lpy @@ -833,6 +833,8 @@ (is (= 6 (reduce (f) (range)))) (is (= 9 (reduce (f) 6 (range))))))) +(defrecord ReduceKVRecord [a b c]) + (deftest reduce-kv-test (testing "reduce-kv does not execute f if no elems in coll" (let [a (atom false)] @@ -864,7 +866,31 @@ (update :ks conj i) (update :vs conj v))) {:ks [] :vs []} - [:a :b :c]))))) + [:a :b :c])))) + + (testing "works on records" + (is (= :reduced (reduce-kv (fn [acc k v] + (reduced :reduced)) + {:ks #{} :vs #{}} + (->ReduceKVRecord 1 2 3)))) + + (let [rec (reduce-kv + (fn [acc k v] + (assoc acc k v)) + (->ReduceKVRecord 0 1 2) + {:d 4 :e 5})] + (is (record? rec)) + (is (instance? ReduceKVRecord rec))) + + (are [res input] (= res (reduce-kv + (fn [acc k v] + (-> acc + (update :ks conj k) + (update :vs conj v))) + {:ks #{} :vs #{}} + input)) + {:ks #{:a :b :c} :vs #{1 2 3}} (->ReduceKVRecord 1 2 3) + {:ks #{:a :b :c :d :e} :vs #{1 2 3 4 5}} (assoc (->ReduceKVRecord 1 2 3) :d 4 :e 5)))) (deftest fnil-test (let [f (fnil (fn [x] x) :yes)]