From 2183a933d9e1b717e9d463effff22b2aa6675f1b Mon Sep 17 00:00:00 2001
From: Huw Campbell <huw.campbell@gmail.com>
Date: Wed, 13 Aug 2025 16:38:37 +1000
Subject: [PATCH] Add lightweight union ptr equality check

---
 containers/src/Data/Set/Internal.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/containers/src/Data/Set/Internal.hs b/containers/src/Data/Set/Internal.hs
index 8b6be2e87..51009eeab 100644
--- a/containers/src/Data/Set/Internal.hs
+++ b/containers/src/Data/Set/Internal.hs
@@ -831,7 +831,8 @@ unions = Foldable.foldl' union empty
 -- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). The union of two sets, preferring the first set when
 -- equal elements are encountered.
 union :: Ord a => Set a -> Set a -> Set a
-union t1 Tip  = t1
+union t1 t2 | t1 `ptrEq` t2 = t1
+union t1 Tip = t1
 union t1 (Bin 1 x _ _) = insertR x t1
 union (Bin 1 x _ _) t2 = insert x t2
 union Tip t2  = t2