From 8722ecfe105dc29bc5c02c95cf0e0411b20e7534 Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Sun, 23 Aug 2026 11:58:32 +0200 Subject: [PATCH 1/2] Linearize merge-diff's structural short-circuit MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit diff-member compared a member's whole subtree with JSON.= before recursing, so every ancestor of a changed leaf re-walked everything below it. JSON.= is itself O(size x depth) on nested objects, because Map.vals and Map.get-maybe deep-copy the values they return, which made merge-diff O(size x depth^2). The comparison is only load-bearing where merge-diff would otherwise return @b unconditionally: two objects can recurse instead, and an empty result object means "no change". For two objects the merge patch is empty exactly when they are deep-equal — by induction, the patch is empty iff no member of a is missing from b and every member of b diffs to nothing, which for a non-object value is JSON.= and for an object value is the same property one level down. An empty object as a member *value* stays distinct from an empty result: it is only the object/object branch that reads emptiness as "unchanged", so an array or scalar becoming {} still emits {}. One changed scalar beside an untouched 5000-element array, nesting depth on the left, best of one run on a Pi 500: depth 1 3.82 ms -> 2.53 ms depth 32 676.25 ms -> 41.38 ms depth 128 11161.83 ms -> 189.34 ms depth 128 is what JSON.parse already accepts, so an 11-second one-op diff was reachable from any untrusted document that parse was willing to hand on. Output is unchanged: over every ordered pair of 42 documents the serialized patch and its round trip through merge-patch are byte-identical to before. --- json.carp | 36 +++++++++++++++++++++++------------- test/json.carp | 42 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 13 deletions(-) diff --git a/json.carp b/json.carp index 3c5a850..04c384f 100644 --- a/json.carp +++ b/json.carp @@ -1498,25 +1498,34 @@ than merged, so a patch reaches neither into an array nor a `null` value. (set! i (Int.inc i))) m)) - (register merge-diff (Fn [(Ref JSON) (Ref JSON)] JSON)) + (private diff-map) + (hidden diff-map) + (register diff-map + (Fn + [(Ref (Map String (Box JSON))) (Ref (Map String (Box JSON)))] + (Map String (Box JSON)))) (private diff-member) (hidden diff-member) - (register diff-member - (Fn - [(Ref (Map String (Box JSON))) (Ref String) (Ref JSON)] - (Maybe (Box JSON)))) (defn diff-member [am k bv] (match (Map.get-maybe am k) (Maybe.Nothing) (Maybe.Just (Box.init @bv)) (Maybe.Just av) - (if (JSON.= (Box.peek &av) bv) - (Maybe.Nothing) - (Maybe.Just (Box.init (JSON.merge-diff (Box.peek &av) bv)))))) + (match-ref (Box.peek &av) + (JSON.Obj sam) + (match-ref bv + (JSON.Obj sbm) + (let [d (JSON.diff-map sam sbm)] + (if (Map.empty? &d) + (Maybe.Nothing) + (Maybe.Just (Box.init (JSON.Obj d))))) + _ (Maybe.Just (Box.init @bv))) + _ + (if (JSON.= (Box.peek &av) bv) + (Maybe.Nothing) + (Maybe.Just (Box.init @bv)))))) - (private diff-objs) - (hidden diff-objs) - (defn diff-objs [am bm] + (defn diff-map [am bm] (let-do [m (JSON.deleted-members am bm) ks (Map.keys bm) vs (Map.vals bm) @@ -1528,7 +1537,7 @@ than merged, so a patch reaches neither into an array nor a `null` value. (set! m (match d (Maybe.Nothing) m (Maybe.Just bx) (Map.put m k &bx))))) (set! i (Int.inc i))) - (JSON.Obj m))) + m)) (doc merge-diff "builds the smallest RFC 7386 merge patch taking `a` to `b`, emitting `null` for the members `b` drops and omitting the ones it leaves @@ -1538,7 +1547,8 @@ one does not survive the round trip through `merge-patch`. (JSON.merge-patch @&a &(JSON.merge-diff &a &b))") (defn merge-diff [a b] (match-ref a - (JSON.Obj am) (match-ref b (JSON.Obj bm) (JSON.diff-objs am bm) _ @b) + (JSON.Obj am) + (match-ref b (JSON.Obj bm) (JSON.Obj (JSON.diff-map am bm)) _ @b) _ @b))) (doc to-json "converts a Carp value to its JSON representation.") diff --git a/test/json.carp b/test/json.carp index 759c16e..92f45ba 100644 --- a/test/json.carp +++ b/test/json.carp @@ -2124,6 +2124,48 @@ break")) "str string with newline") (diff-eq? "{\"a\":1}" "[1,2]" "[1,2]") "merge-diff against a non-object is that document") + (assert-true test + (diff-eq? "{\"a\":{},\"b\":1}" "{\"a\":{},\"b\":2}" "{\"b\":2}") + "merge-diff omits a member that is an empty object in both documents") + + (assert-true test + (diff-eq? "{\"a\":{\"b\":1}}" "{\"a\":{}}" "{\"a\":{\"b\":null}}") + "merge-diff empties a member with a null, not with an empty object") + + (assert-true test + (diff-eq? "{\"a\":{}}" "{\"a\":{\"b\":1}}" "{\"a\":{\"b\":1}}") + "merge-diff fills an empty object member") + + (assert-true test + (diff-eq? "{\"a\":[]}" "{\"a\":{}}" "{\"a\":{}}") + "merge-diff emits an empty object when an array becomes one") + + (assert-true test + (diff-eq? "{\"a\":{}}" "{\"a\":[]}" "{\"a\":[]}") + "merge-diff replaces an empty object member with an array") + + (assert-true test + (diff-eq? + "{\"a\":{\"b\":{\"c\":1}},\"z\":{\"y\":{\"x\":2}}}" + "{\"a\":{\"b\":{\"c\":9}},\"z\":{\"y\":{\"x\":2}}}" + "{\"a\":{\"b\":{\"c\":9}}}") + "merge-diff omits a deep object member whose whole subtree is unchanged") + + (assert-true test + (diff-eq? "{\"a\":{\"b\":null,\"c\":1}}" + "{\"a\":{\"b\":null,\"c\":2}}" + "{\"a\":{\"c\":2}}") + "merge-diff omits a null-valued member the two documents share") + + (assert-true test + (diff-eq? "{\"a\":{\"b\":null}}" "{\"a\":{\"b\":1}}" "{\"a\":{\"b\":1}}") + "merge-diff replaces a null-valued member") + + (assert-true test + (diff-roundtrips? "{\"a\":{\"b\":{}},\"c\":1}" + "{\"a\":{\"b\":{},\"d\":2},\"c\":1}") + "an untouched nested empty object round-trips") + (assert-true test (diff-roundtrips? "{\"title\":\"Goodbye!\",\"author\":{\"givenName\":\"John\",\"familyName\":\"Doe\"},\"tags\":[\"example\",\"sample\"],\"content\":\"This will be unchanged\"}" From bd482922989b40c32851876203e8839c2c621989 Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Sun, 23 Aug 2026 11:59:17 +0200 Subject: [PATCH 2/2] Walk merge-diff's member maps by reference Map.keys and Map.vals return owned copies, so diff-map deep-copied every value of b at each level and deleted-members allocated a String per key. That left a residual factor of depth in the recursion and made diffing a wide object of equal object members slower than the version this replaces. Map.kv-reduce hands the reducer both key and value as references, which is the shape both loops already wanted. Measured on a Pi 500, before this change / after, best of one run: one changed scalar beside an untouched 5000-element array depth 1 2.53 ms -> 1.45 ms depth 32 41.38 ms -> 24.16 ms depth 128 189.34 ms -> 101.54 ms two identical documents, 20000 members each an equal 2-member object 250.97 ms -> 158.90 ms (191.74 ms before either commit) the same pair with one member changed 244.99 ms -> 157.67 ms (184.97 ms before either commit) Both closures capture only a reference. A sanitizer build (clang -fsanitize=address,undefined) of the ordered-pair differential reports nothing beyond the pre-existing signed overflow in core's string hash, and its output matches the interpreter's. --- json.carp | 36 ++++++++++++++---------------------- 1 file changed, 14 insertions(+), 22 deletions(-) diff --git a/json.carp b/json.carp index 04c384f..d94aa3b 100644 --- a/json.carp +++ b/json.carp @@ -1487,16 +1487,13 @@ than merged, so a patch reaches neither into an array nor a `null` value. (private deleted-members) (hidden deleted-members) (defn deleted-members [am bm] - (let-do [m (the (Map String (Box JSON)) {}) - ks (Map.keys am) - null (Box.init (JSON.Null)) - i 0 - n (Array.length &ks)] - (while-do (Int.< i n) - (let [k (Array.unsafe-nth &ks i)] - (set! m (if (Map.contains? bm k) m (Map.put m k &null)))) - (set! i (Int.inc i))) - m)) + (Map.kv-reduce + &(fn [m k _] + (if (Map.contains? bm k) + m + (let [null (Box.init (JSON.Null))] (Map.put m k &null)))) + (the (Map String (Box JSON)) {}) + am)) (private diff-map) (hidden diff-map) @@ -1526,18 +1523,13 @@ than merged, so a patch reaches neither into an array nor a `null` value. (Maybe.Just (Box.init @bv)))))) (defn diff-map [am bm] - (let-do [m (JSON.deleted-members am bm) - ks (Map.keys bm) - vs (Map.vals bm) - i 0 - n (Array.length &ks)] - (while-do (Int.< i n) - (let [k (Array.unsafe-nth &ks i)] - (let [d (JSON.diff-member am k (Box.peek (Array.unsafe-nth &vs i)))] - (set! m - (match d (Maybe.Nothing) m (Maybe.Just bx) (Map.put m k &bx))))) - (set! i (Int.inc i))) - m)) + (Map.kv-reduce + &(fn [m k bv] + (match (JSON.diff-member am k (Box.peek bv)) + (Maybe.Nothing) m + (Maybe.Just bx) (Map.put m k &bx))) + (JSON.deleted-members am bm) + bm)) (doc merge-diff "builds the smallest RFC 7386 merge patch taking `a` to `b`, emitting `null` for the members `b` drops and omitting the ones it leaves