From 99e09d1df7d1dab12553bf3a54a11dc9547a6ee2 Mon Sep 17 00:00:00 2001
From: Thomas Honeyman <hello@thomashoneyman.com>
Date: Sun, 18 Oct 2026 00:17:49 +0000
Subject: [PATCH 1/5] Add correctness-checked construction and collection
 benchmarks

---
 CHANGELOG.md              |   2 +
 README.md                 |  30 +++++++++
 bench/spago.yaml          |   1 +
 bench/src/Bench/Join.js   |  10 +++
 bench/src/Bench/Join.purs | 129 ++++++++++++++++++++++++++++++++++++++
 package.json              |   1 +
 6 files changed, 173 insertions(+)
 create mode 100644 bench/src/Bench/Join.js
 create mode 100644 bench/src/Bench/Join.purs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index fb1e68a..0c33c7b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -12,6 +12,8 @@ Bugfixes:
 
 Other improvements:
 
+- Add focused Minibench workloads with correctness validation for construction, joins, ranges, and subsequent access.
+
 ## [v3.3.0](https://github.com/purescript/purescript-ordered-collections/releases/tag/v3.3.0) - 2026-10-17
 
 New features:
diff --git a/README.md b/README.md
index 647c025..da6a7f3 100644
--- a/README.md
+++ b/README.md
@@ -17,3 +17,33 @@ spago install ordered-collections
 ## Documentation
 
 Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-ordered-collections).
+
+## Performance benchmarks
+
+Run `npm run bench:join` to measure construction, ranges, bulk operations, and
+subsequent access at 1,000 and 100,000 entries. Ordinary Map/Set construction and
+updates are measured separately from singleton unions. Construction-plus-lookup
+cases also measure the combined workload.
+`npm run bench` retains the existing comparison with the historical implementation.
+
+The suite validates contents and tree invariants during five untimed warmups and
+fails on invalid results, then takes 20 timed samples with results retained.
+Fixture construction and validation are outside timing except where construction
+is the operation being measured.
+Minibench requests GC before each case; GC occurring during samples is included.
+
+To compare revisions, use the same Node version, compiler, dependency versions,
+hardware, and benchmark source in both checkouts. Build first, then alternate at
+least three fresh-process runs of each revision using:
+
+```sh
+node --expose-gc --input-type=module --eval "import('./output/Bench.Join/index.js').then(m => m.main())"
+```
+
+Record the commit IDs, `node --version`, `npx purs --version`, and complete output.
+Compare repeated runs and variation, not a single mean. These deterministic
+integer-key workloads are diagnostic, not a model of every application; include
+application-specific keys and access patterns when making performance decisions.
+For operations that take only a few microseconds, use timed batches to distinguish
+small improvements from timer and harness overhead; the suite times individual calls.
+Do not use elapsed-time thresholds as CI correctness tests on shared runners.
diff --git a/bench/spago.yaml b/bench/spago.yaml
index 7cf2e1c..b5f2a3b 100644
--- a/bench/spago.yaml
+++ b/bench/spago.yaml
@@ -7,6 +7,7 @@ package:
     - console: ">=6.0.0 <7.0.0"
     - control: ">=6.0.0 <7.0.0"
     - effect: ">=4.0.0 <5.0.0"
+    - exceptions: ">=6.0.0 <7.0.0"
     - foldable-traversable: ">=6.0.0 <7.0.0"
     - lists: ">=7.0.0 <8.0.0"
     - maybe: ">=6.0.0 <7.0.0"
diff --git a/bench/src/Bench/Join.js b/bench/src/Bench/Join.js
new file mode 100644
index 0000000..fc0c1a4
--- /dev/null
+++ b/bench/src/Bench/Join.js
@@ -0,0 +1,10 @@
+let lastResult;
+
+export const retainResult = (operation) => (unit) => {
+  lastResult = operation(unit);
+  return lastResult;
+};
+
+export const clearResult = () => {
+  lastResult = undefined;
+};
diff --git a/bench/src/Bench/Join.purs b/bench/src/Bench/Join.purs
new file mode 100644
index 0000000..e7599f7
--- /dev/null
+++ b/bench/src/Bench/Join.purs
@@ -0,0 +1,129 @@
+module Bench.Join (main) where
+
+import Prelude
+
+import Data.Foldable (foldl, for_, sum)
+import Data.List as L
+import Data.Map as M
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Set as S
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Effect.Console (log)
+import Effect.Exception (throw)
+import Performance.Minibench (benchWith)
+
+-- Keep the last result reachable so the runtime cannot discard the work.
+foreign import retainResult :: forall a. (Unit -> a) -> Unit -> a
+foreign import clearResult :: Effect Unit
+
+benchmark :: forall a. String -> (a -> Boolean) -> (Unit -> a) -> Effect Unit
+benchmark name valid operation = do
+  log name
+  let run = retainResult operation
+  -- Validate and warm up outside the timed samples. Minibench then requests GC.
+  for_ (L.range 1 5) \_ ->
+    unless (valid (run unit)) $ throw ("Invalid benchmark result: " <> name)
+  clearResult
+  benchWith 20 run
+  clearResult
+
+main :: Effect Unit
+main = for_ [ 1000, 100000 ] \n -> do
+  log $ "\nJoin workloads, entries = " <> show n
+  let
+    keys = L.range 0 (n - 1)
+    reverseKeys = L.reverse keys
+    permutedKeys = map (\k -> (k * 7919) `mod` n) keys
+    duplicateKeys = map (_ `mod` 128) keys
+    pairs = map (\k -> Tuple k k) keys
+    permutedPairs = map (\k -> Tuple k k) permutedKeys
+    reversePairs = L.reverse pairs
+    duplicatePairs = map (\k -> Tuple k k) duplicateKeys
+    arrayPairs = L.toUnfoldable permutedPairs :: Array (Tuple Int Int)
+    fromKeys = M.fromFoldable <<< map (\k -> Tuple k k)
+    byUnions = foldl (\m k -> M.union m (M.singleton k k)) M.empty
+    byLeftUnions = foldl (\m k -> M.union (M.singleton k k) m) M.empty
+    valid expected m = M.checkValid m && (M.toUnfoldable m :: L.List (Tuple Int Int)) == expected
+    mapBench name expected = benchmark name (valid expected)
+    balanced = fromKeys keys
+    ascending = byUnions keys
+    descending = byUnions reverseKeys
+    half = n / 2
+    overlap = fromKeys (L.range half (n + half - 1))
+    disjoint = fromKeys (L.range n (2 * n - 1))
+    sparseKeys = map (_ * 97) (L.range 0 ((n - 1) / 97))
+    sparse = fromKeys sparseKeys
+    queries = map (\i -> (i * 7919) `mod` n) (L.range 0 4095)
+    expectedLookup = sum queries
+    lookups m = foldl (\acc k -> acc + fromMaybe (-1) (M.lookup k m)) 0 queries
+    fullRange = M.submap (Just 0) (Just (n - 1)) balanced
+    extraKeys = L.range n (n + 127)
+    deletedKeys = L.range 0 127
+
+  mapBench "fromFoldable" pairs \_ -> M.fromFoldable pairs
+  mapBench "fromFoldable / permuted" pairs \_ -> M.fromFoldable permutedPairs
+  mapBench "fromFoldable / descending" pairs \_ -> M.fromFoldable reversePairs
+  mapBench "fromFoldable / duplicate-heavy" (L.take 128 pairs) \_ -> M.fromFoldable duplicatePairs
+  mapBench "fromFoldable / permuted array" pairs \_ -> M.fromFoldable arrayPairs
+  benchmark "Set.fromFoldable / permuted"
+    (\s -> S.checkValid s && (S.toUnfoldable s :: L.List Int) == keys)
+    \_ -> S.fromFoldable permutedKeys
+  benchmark "Set.fromFoldable / duplicate-heavy"
+    (\s -> S.checkValid s && (S.toUnfoldable s :: L.List Int) == L.take 128 keys)
+    \_ -> S.fromFoldable duplicateKeys
+  mapBench "insert / replace existing" (map (\k -> Tuple k (-k)) keys) \_ ->
+    foldl (\m k -> M.insert k (-k) m) balanced permutedKeys
+  mapBench "insertWith / replace existing" (map (\k -> Tuple k (-1)) keys) \_ ->
+    foldl (\m k -> M.insertWith (-) k (k + 1) m) balanced permutedKeys
+  mapBench "delete then reinsert" pairs \_ ->
+    foldl (\m k -> M.insert k k (M.delete k m)) balanced permutedKeys
+  mapBench "singleton unions / ascending" pairs \_ -> byUnions keys
+  mapBench "singleton unions / descending" pairs \_ -> byUnions reverseKeys
+  mapBench "singleton unions / permuted" pairs \_ -> byUnions permutedKeys
+  mapBench "singleton unions / duplicate-heavy" (L.take 128 pairs) \_ -> byUnions duplicateKeys
+  mapBench "singleton-left unions / ascending" pairs \_ -> byLeftUnions keys
+  mapBench "singleton-left unions / descending" pairs \_ -> byLeftUnions reverseKeys
+  mapBench "singleton-left unions / permuted" pairs \_ -> byLeftUnions permutedKeys
+  mapBench "submap / full" pairs \_ -> M.submap (Just 0) (Just (n - 1)) balanced
+  mapBench "submap / half" (L.take half pairs) \_ -> M.submap (Just 0) (Just (half - 1)) balanced
+  mapBench "submap / singleton" (L.singleton (Tuple half half)) \_ -> M.submap (Just half) (Just half) balanced
+  mapBench "submap / interior" (L.take half (L.drop (half / 2) pairs)) \_ ->
+    M.submap (Just (half / 2)) (Just (half / 2 + half - 1)) balanced
+  mapBench "submap / lower only" (L.drop half pairs) \_ -> M.submap (Just half) Nothing balanced
+  mapBench "submap / upper only" (L.take half pairs) \_ -> M.submap Nothing (Just (half - 1)) balanced
+  mapBench "submap / reversed bounds" L.Nil \_ -> M.submap (Just half) (Just (half - 1)) balanced
+  mapBench "submap / outside" L.Nil \_ -> M.submap (Just n) Nothing balanced
+
+  mapBench "union / identical" pairs \_ -> M.union balanced balanced
+  mapBench "union / empty left" pairs \_ -> M.union M.empty balanced
+  mapBench "union / empty right" pairs \_ -> M.union balanced M.empty
+  mapBench "difference / identical" L.Nil \_ -> M.difference balanced balanced
+
+  for_ [ Tuple "left" identity, Tuple "right" flip ] \(Tuple side order) -> do
+    mapBench ("union / overlap / " <> side) (map (\k -> Tuple k k) (L.range 0 (n + half - 1))) \_ ->
+      order M.union balanced overlap
+    mapBench ("union / disjoint / " <> side) (pairs <> map (\k -> Tuple k k) (L.range n (2 * n - 1))) \_ ->
+      order M.union balanced disjoint
+    mapBench ("union / sparse / " <> side) pairs \_ -> order M.union balanced sparse
+
+  mapBench "difference / disjoint / left" pairs \_ -> M.difference balanced disjoint
+  mapBench "difference / disjoint / right" (map (\k -> Tuple k k) (L.range n (2 * n - 1))) \_ -> M.difference disjoint balanced
+  mapBench "difference / sparse / large-small" (L.filter (\(Tuple k _) -> k `mod` 97 /= 0) pairs) \_ -> M.difference balanced sparse
+  mapBench "difference / sparse / small-large" L.Nil \_ -> M.difference sparse balanced
+  mapBench "intersection / overlap" (L.drop half pairs) \_ -> M.intersection balanced overlap
+
+  for_ [ Tuple "fromFoldable" balanced, Tuple "ascending unions" ascending, Tuple "descending unions" descending, Tuple "full submap" fullRange ] \(Tuple name tree) -> do
+    unless (valid pairs tree) $ throw ("Invalid lookup fixture: " <> name)
+    benchmark ("4096 lookups / " <> name) (_ == expectedLookup) \_ -> lookups tree
+    mapBench ("128 deletes / " <> name) (L.drop 128 pairs) \_ ->
+      foldl (flip M.delete) tree deletedKeys
+    mapBench ("128 inserts / " <> name) (pairs <> map (\k -> Tuple k k) extraKeys) \_ ->
+      foldl (\m k -> M.insert k k m) tree extraKeys
+
+  for_ [ Tuple "ascending" keys, Tuple "descending" reverseKeys ] \(Tuple name input) ->
+    benchmark ("singleton unions + 4096 lookups / " <> name)
+      (\(Tuple tree total) -> valid pairs tree && total == expectedLookup)
+      \_ -> do
+        let tree = byUnions input
+        Tuple tree (lookups tree)
diff --git a/package.json b/package.json
index 1d74be9..2fe23f9 100644
--- a/package.json
+++ b/package.json
@@ -6,6 +6,7 @@
     "bench:build": "spago build -p ordered-collections-bench",
     "bench:run": "node --expose-gc --input-type=module --eval \"import * as Bench_Main from './output/Bench.Main/index.js';Bench_Main.main()\"",
     "bench": "npm run bench:build && npm run bench:run",
+    "bench:join": "npm run bench:build && node --expose-gc --input-type=module --eval \"import('./output/Bench.Join/index.js').then(m => m.main())\"",
     "format": "purs-tidy format-in-place src test bench/src && oxfmt --write .",
     "format:check": "purs-tidy check src test bench/src && oxfmt --check ."
   },

From c4a8fe6de80e6a446de3a27f68a1c958d285ef67 Mon Sep 17 00:00:00 2001
From: Thomas Honeyman <hello@thomashoneyman.com>
Date: Sun, 18 Oct 2026 00:19:56 +0000
Subject: [PATCH 2/5] Trim map range boundaries without rebuilding retained
 entries

---
 CHANGELOG.md               |  1 +
 src/Data/Map/Internal.purs | 37 ++++++++++++++++++++++++++++++++++++-
 test/Test/Data/Map.purs    | 13 ++++++++++++-
 3 files changed, 49 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 0c33c7b..cc40b7b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -13,6 +13,7 @@ Bugfixes:
 Other improvements:
 
 - Add focused Minibench workloads with correctness validation for construction, joins, ranges, and subsequent access.
+- Trim `Map.submap` and `Set.range` at their boundaries instead of rebuilding retained entries.
 
 ## [v3.3.0](https://github.com/purescript/purescript-ordered-collections/releases/tag/v3.3.0) - 2026-10-17
 
diff --git a/src/Data/Map/Internal.purs b/src/Data/Map/Internal.purs
index 13d0ebb..166c517 100644
--- a/src/Data/Map/Internal.purs
+++ b/src/Data/Map/Internal.purs
@@ -452,7 +452,42 @@ foldSubmapBy appendFn memptyValue kmin kmax f = do
 -- |       not (member key m')
 -- | ```
 submap :: forall k v. Ord k => Maybe k -> Maybe k -> Map k v -> Map k v
-submap kmin kmax = foldSubmapBy union empty kmin kmax singleton
+submap kmin kmax m = case kmin, kmax of
+  Just lo, Just hi | lo > hi -> Leaf
+  _, _ -> go m
+  where
+  -- Trimming only removes entries, so unchanged size means nothing was removed.
+  go tree = case tree of
+    Leaf -> Leaf
+    Node _ _ k v l r -> case kmin, kmax of
+      Just lo, _ | k < lo -> go r
+      _, Just hi | k > hi -> go l
+      _, _ -> do
+        let
+          l' = trimLower kmin l
+          r' = trimUpper kmax r
+        if size l' == size l && size r' == size r then tree
+        else runFn4 unsafeBalancedNode k v l' r'
+
+  trimLower Nothing tree = tree
+  trimLower bound@(Just lo) tree = case tree of
+    Leaf -> Leaf
+    Node _ _ k v l r
+      | k < lo -> trimLower bound r
+      | otherwise -> do
+          let l' = trimLower bound l
+          if size l' == size l then tree
+          else runFn4 unsafeBalancedNode k v l' r
+
+  trimUpper Nothing tree = tree
+  trimUpper bound@(Just hi) tree = case tree of
+    Leaf -> Leaf
+    Node _ _ k v l r
+      | k > hi -> trimUpper bound l
+      | otherwise -> do
+          let r' = trimUpper bound r
+          if size r' == size r then tree
+          else runFn4 unsafeBalancedNode k v l r'
 
 -- | Test if a key is a member of a map
 member :: forall k v. Ord k => k -> Map k v -> Boolean
diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs
index c3994e5..80595b2 100644
--- a/test/Test/Data/Map.purs
+++ b/test/Test/Data/Map.purs
@@ -370,12 +370,23 @@ mapTests = do
   quickCheck \(TestMap m :: TestMap SmallKey Int) ->
     M.submap Nothing Nothing m === m
 
-  log "submap preserves balance across unequal subtree heights"
+  log "submap preserves a six-entry map over its full range"
   let
     rangeInput = M.fromFoldable (map (\k -> Tuple k (k * 3)) (A.range 0 5))
     bounded = M.submap (Just 0) (Just 5) rangeInput
   quickCheck' 1 (M.checkValid bounded && bounded == rangeInput)
 
+  log "submap trims asymmetric boundaries and preserves all retained entries"
+  for_ [ A.range 0 63, A.reverse (A.range 0 63) ] \keys -> do
+    let input = M.fromFoldable (map (\k -> Tuple k (3 * k + 1)) keys)
+    for_ [ Nothing, Just (-1), Just 0, Just 1, Just 17, Just 48, Just 63, Just 64 ] \lo ->
+      for_ [ Nothing, Just (-1), Just 0, Just 16, Just 31, Just 62, Just 63, Just 64 ] \hi -> do
+        let
+          result = M.submap lo hi input
+          inRange k = maybe true (\min -> min <= k) lo && maybe true (\max -> k <= max) hi
+          expected = map (\k -> Tuple k (3 * k + 1)) (A.filter inRange (A.range 0 63))
+        quickCheck' 1 (M.checkValid result && M.toUnfoldable result == expected)
+
   log "submap with lower bound"
   quickCheck' 1 $
     M.submap (Just B) Nothing (M.fromFoldable [ Tuple A 0, Tuple B 0 ])

From 5085e6044af0ea1209a6a30e91de57006f26434e Mon Sep 17 00:00:00 2001
From: Thomas Honeyman <hello@thomashoneyman.com>
Date: Sun, 18 Oct 2026 00:19:59 +0000
Subject: [PATCH 3/5] Specialize singleton unions without changing general
 insertion or joins

---
 CHANGELOG.md               |  1 +
 src/Data/Map/Internal.purs | 58 ++++++++++++++++++++++++++++++++++++--
 test/Test/Data/Map.purs    | 27 ++++++++++++++++++
 3 files changed, 84 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index cc40b7b..803a059 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -14,6 +14,7 @@ Other improvements:
 
 - Add focused Minibench workloads with correctness validation for construction, joins, ranges, and subsequent access.
 - Trim `Map.submap` and `Set.range` at their boundaries instead of rebuilding retained entries.
+- Use insertion-specific balancing and singleton-union insertion paths without changing general tree joins.
 
 ## [v3.3.0](https://github.com/purescript/purescript-ordered-collections/releases/tag/v3.3.0) - 2026-10-17
 
diff --git a/src/Data/Map/Internal.purs b/src/Data/Map/Internal.purs
index 166c517..d5f3e10 100644
--- a/src/Data/Map/Internal.purs
+++ b/src/Data/Map/Internal.purs
@@ -71,7 +71,7 @@ import Control.Plus (class Plus)
 import Data.Eq (class Eq1)
 import Data.Foldable (class Foldable, foldl, foldr)
 import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex)
-import Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn7, mkFn2, mkFn3, mkFn4, mkFn7, runFn2, runFn3, runFn4, runFn7)
+import Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn5, Fn7, mkFn2, mkFn3, mkFn4, mkFn5, mkFn7, runFn2, runFn3, runFn4, runFn5, runFn7)
 import Data.FunctorWithIndex (class FunctorWithIndex)
 import Data.List (List(..), (:))
 import Data.Maybe (Maybe(..))
@@ -615,7 +615,12 @@ values = foldr Cons Nil
 -- | Compute the union of two maps, using the specified function
 -- | to combine values for duplicate keys.
 unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v
-unionWith app m1 m2 = runFn4 unsafeUnionWith compare app m1 m2
+unionWith app m1 m2 = case m1, m2 of
+  Leaf, _ -> m2
+  _, Leaf -> m1
+  _, Node _ _ _ _ Leaf Leaf -> runFn5 unsafeUnionSingleton compare app false m2 m1
+  Node _ _ _ _ Leaf Leaf, _ -> runFn5 unsafeUnionSingleton compare app true m1 m2
+  _, _ -> runFn4 unsafeUnionWith compare app m1 m2
 
 -- | Compute the union of two maps, preferring values from the first map in the case
 -- | of duplicate keys
@@ -751,6 +756,26 @@ unsafeNode = mkFn4 \k v l r -> case l of
       Node h2 s2 _ _ _ _ ->
         Node (1 + if h1 > h2 then h1 else h2) (1 + s1 + s2) k v l r
 
+-- | Rebalance after a single insertion. Both children must be balanced and
+-- | ordered, and their heights must differ by at most two.
+unsafeInsertNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v)
+unsafeInsertNode = mkFn4 \k v l r -> case l, r of
+  Node lh _ lk lv ll lr, _ | lh > height r + 1 ->
+    case lr of
+      Node rh _ rk rv rl rr | rh > height ll ->
+        runFn4 unsafeNode rk rv (runFn4 unsafeNode lk lv ll rl) (runFn4 unsafeNode k v rr r)
+      _ -> runFn4 unsafeNode lk lv ll (runFn4 unsafeNode k v lr r)
+  _, Node rh _ rk rv rl rr | rh > height l + 1 ->
+    case rl of
+      Node lh _ lk lv ll lr | lh > height rr ->
+        runFn4 unsafeNode lk lv (runFn4 unsafeNode k v l ll) (runFn4 unsafeNode rk rv lr rr)
+      _ -> runFn4 unsafeNode rk rv (runFn4 unsafeNode k v l rl) rr
+  _, _ -> runFn4 unsafeNode k v l r
+  where
+  height = case _ of
+    Leaf -> 0
+    Node h _ _ _ _ _ -> h
+
 -- | Low-level Node constructor which maintains the balance invariants.
 -- | This is unsafe because it assumes the child Maps are ordered and balanced.
 -- | Their heights may differ arbitrarily: join along the taller tree's inner
@@ -849,6 +874,35 @@ unsafeSplit = mkFn3 \comp k m -> case m of
       EQ ->
         Split (Just mv) ml mr
 
+-- | Insert a map containing at most one entry into another map.
+-- | This is unsafe because it assumes that size bound and appropriate ordering.
+-- | `singletonLeft` identifies the singleton's original union side. Collisions
+-- | keep the original right operand's key; `app` receives left then right values.
+unsafeUnionSingleton :: forall k v. Fn5 (k -> k -> Ordering) (v -> v -> v) Boolean (Map k v) (Map k v) (Map k v)
+unsafeUnionSingleton = mkFn5 \comp app singletonLeft single tree -> case single of
+  Leaf -> tree
+  Node _ _ k v _ _ -> do
+    let
+      -- Insertion grows a child by at most one. Below the old parent height,
+      -- the parent remains balanced with the same height.
+      go = case _ of
+        Leaf -> single
+        Node h s mk mv l r -> case comp k mk of
+          LT -> do
+            let l' = go l
+            case l' of
+              Node lh ls _ _ _ _ | lh < h -> Node h (1 + ls + size r) mk mv l' r
+              _ -> runFn4 unsafeInsertNode mk mv l' r
+          GT -> do
+            let r' = go r
+            case r' of
+              Node rh rs _ _ _ _ | rh < h -> Node h (1 + size l + rs) mk mv l r'
+              _ -> runFn4 unsafeInsertNode mk mv l r'
+          EQ ->
+            if singletonLeft then Node h s mk (app v mv) l r
+            else Node h s k (app mv v) l r
+    go tree
+
 -- | Low-level unionWith implementation.
 -- | This is unsafe because it assumes the ordering function is appropriate.
 unsafeUnionWith :: forall k v. Fn4 (k -> k -> Ordering) (v -> v -> v) (Map k v) (Map k v) (Map k v)
diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs
index 80595b2..e05c653 100644
--- a/test/Test/Data/Map.purs
+++ b/test/Test/Data/Map.purs
@@ -30,6 +30,14 @@ newtype TestMap k v = TestMap (M.Map k v)
 instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (TestMap k v) where
   arbitrary = TestMap <$> genMap arbitrary arbitrary
 
+newtype TaggedKey = TaggedKey { key :: Int, tag :: String }
+
+instance eqTaggedKey :: Eq TaggedKey where
+  eq (TaggedKey a) (TaggedKey b) = a.key == b.key
+
+instance ordTaggedKey :: Ord TaggedKey where
+  compare (TaggedKey a) (TaggedKey b) = compare a.key b.key
+
 data SmallKey = A | B | C | D | E | F | G | H | I | J
 
 derive instance eqSmallKey :: Eq SmallKey
@@ -236,6 +244,25 @@ mapTests = do
       Just v -> Just v == v2
       Nothing -> not (in1 || in2)
 
+  log "Singleton unions preserve balance, persistence, and combining argument order"
+  for_ [ A.range 0 127, A.reverse (A.range 0 127), map (\k -> (k * 37) `mod` 128) (A.range 0 127) ] \ks ->
+    for_ [ false, true ] \singletonLeft -> do
+      let
+        join = if singletonLeft then flip (M.unionWith (-)) else M.unionWith (-)
+        initial = foldl (\m k -> join m (M.singleton k (3 * k + 10))) M.empty ks
+        combined = foldl (\m k -> join m (M.singleton k (k + 1))) initial ks
+        expected = map (\k -> Tuple k (if singletonLeft then -2 * k - 9 else 2 * k + 9)) (A.range 0 127)
+      quickCheck' 1 (M.checkValid combined && M.toUnfoldable combined == expected)
+      quickCheck' 1 (M.checkValid initial && M.toUnfoldable initial == map (\k -> Tuple k (3 * k + 10)) (A.range 0 127))
+
+  log "Singleton unions keep the right-hand representative key"
+  let
+    tagged = M.fromFoldable (map (\k -> Tuple (TaggedKey { key: k, tag: "tree" }) (k * 3 + 10)) (A.range 0 2))
+    taggedOne = M.singleton (TaggedKey { key: 1, tag: "singleton" }) 9
+    tags m = map (\(Tuple (TaggedKey k) v) -> Tuple k.tag v) (M.toUnfoldable m :: Array (Tuple TaggedKey Int))
+  quickCheck' 1 (tags (M.unionWith (-) tagged taggedOne) == [ Tuple "tree" 10, Tuple "singleton" 4, Tuple "tree" 16 ])
+  quickCheck' 1 (tags (M.unionWith (-) taggedOne tagged) == [ Tuple "tree" 10, Tuple "tree" (-4), Tuple "tree" 16 ])
+
   log "Lookup from intersection"
   quickCheck $ \(TestMap m1) (TestMap m2) k ->
     M.lookup (smallKey k) (M.intersection (m1 :: M.Map SmallKey Int) (m2 :: M.Map SmallKey Int)) ==

From d2dc289b717c5aa7119d7ab32a9712161862ae8f Mon Sep 17 00:00:00 2001
From: Thomas Honeyman <hello@thomashoneyman.com>
Date: Sun, 18 Oct 2026 00:57:48 +0000
Subject: [PATCH 4/5] Move benchmark instructions into the module header

---
 README.md                 | 30 ------------------------------
 bench/src/Bench/Join.purs | 26 ++++++++++++++++++++++++++
 2 files changed, 26 insertions(+), 30 deletions(-)

diff --git a/README.md b/README.md
index da6a7f3..647c025 100644
--- a/README.md
+++ b/README.md
@@ -17,33 +17,3 @@ spago install ordered-collections
 ## Documentation
 
 Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-ordered-collections).
-
-## Performance benchmarks
-
-Run `npm run bench:join` to measure construction, ranges, bulk operations, and
-subsequent access at 1,000 and 100,000 entries. Ordinary Map/Set construction and
-updates are measured separately from singleton unions. Construction-plus-lookup
-cases also measure the combined workload.
-`npm run bench` retains the existing comparison with the historical implementation.
-
-The suite validates contents and tree invariants during five untimed warmups and
-fails on invalid results, then takes 20 timed samples with results retained.
-Fixture construction and validation are outside timing except where construction
-is the operation being measured.
-Minibench requests GC before each case; GC occurring during samples is included.
-
-To compare revisions, use the same Node version, compiler, dependency versions,
-hardware, and benchmark source in both checkouts. Build first, then alternate at
-least three fresh-process runs of each revision using:
-
-```sh
-node --expose-gc --input-type=module --eval "import('./output/Bench.Join/index.js').then(m => m.main())"
-```
-
-Record the commit IDs, `node --version`, `npx purs --version`, and complete output.
-Compare repeated runs and variation, not a single mean. These deterministic
-integer-key workloads are diagnostic, not a model of every application; include
-application-specific keys and access patterns when making performance decisions.
-For operations that take only a few microseconds, use timed batches to distinguish
-small improvements from timer and harness overhead; the suite times individual calls.
-Do not use elapsed-time thresholds as CI correctness tests on shared runners.
diff --git a/bench/src/Bench/Join.purs b/bench/src/Bench/Join.purs
index e7599f7..e4bbac7 100644
--- a/bench/src/Bench/Join.purs
+++ b/bench/src/Bench/Join.purs
@@ -1,3 +1,29 @@
+-- | Run these benchmarks from the repository's root directory:
+-- |
+-- | ```sh
+-- | npm install
+-- | npm run bench:join
+-- | ```
+-- |
+-- | This builds the code and measures Map and Set operations on collections with
+-- | 1,000 and 100,000 entries. Each case checks its answers and tree balance during
+-- | five practice runs, then times 20 runs. Incorrect results stop the benchmark.
+-- | Setup and checks are not timed; building a collection is timed when that is
+-- | the operation being measured. Results stay in memory until the next run, and
+-- | any memory cleanup during a timed run counts toward its time.
+-- |
+-- | `mean` is the average time; lower is faster. `stddev`, `min`, and `max` show
+-- | how much the times vary. A small difference may just be measurement noise.
+-- | To compare two versions, run each at least three times, alternating versions.
+-- | Use the same computer, Node/compiler/dependency versions, and benchmark code.
+-- | Close other busy programs and do not run the two versions at the same time.
+-- | Save the full output, commit IDs, `node --version`, and `npx purs --version`.
+-- |
+-- | These integer-key examples do not represent every application. Ordinary
+-- | insertion and singleton unions are different workloads; compare the cases
+-- | your code actually uses. Very short operations need timed batches to measure
+-- | small differences reliably. Do not make CI fail on timing thresholds.
+-- | `npm run bench` runs the separate comparison with the historical implementation.
 module Bench.Join (main) where
 
 import Prelude

From 84b99622a77ed5bc50c0690c322e92cacde9aa52 Mon Sep 17 00:00:00 2001
From: Thomas Honeyman <hello@thomashoneyman.com>
Date: Sun, 18 Oct 2026 00:58:19 +0000
Subject: [PATCH 5/5] Reference performance PR in the changelog

---
 CHANGELOG.md | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 803a059..02a71b3 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -12,9 +12,9 @@ Bugfixes:
 
 Other improvements:
 
-- Add focused Minibench workloads with correctness validation for construction, joins, ranges, and subsequent access.
-- Trim `Map.submap` and `Set.range` at their boundaries instead of rebuilding retained entries.
-- Use insertion-specific balancing and singleton-union insertion paths without changing general tree joins.
+- Add focused Minibench workloads with correctness validation for construction, joins, ranges, and subsequent access (#79).
+- Trim `Map.submap` and `Set.range` at their boundaries instead of rebuilding retained entries (#79).
+- Use insertion-specific balancing and singleton-union insertion paths without changing general tree joins (#79).
 
 ## [v3.3.0](https://github.com/purescript/purescript-ordered-collections/releases/tag/v3.3.0) - 2026-10-17