Support reducing Records by reduce-kv

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

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)

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)]