+    , traverseWithKey_

+-- | \(O(n)\). Visit each key\/value pair in ascending key order, discarding

+-- the results.

+traverseWithKey_ :: Applicative t => (Key -> a -> t ()) -> Word64Map a -> t ()

+traverseWithKey_ f = go

+  where

+    go Nil = pure ()

+    go (Tip k v) = f k v

+    go (Bin _ _ l r) = go l *> go r

+{-# INLINE traverseWithKey_ #-}

+

+    , traverseWithKey_

+    , traverseWithKey_

+    , traverseWithKey_

+  , traverseWithKey_

+{-# LANGUAGE MagicHash #-}

+{-# LANGUAGE UnboxedTuples #-}

+

+import GHC.Data.SmallArray

+import GHC.Exts (State#, build)

+import GHC.ST (ST(..), runST)

+-- There is an implementation cost: each element is given an insertion tag

+-- as it is added, and functions like `udfmToList` or `eltsUDFM` order their

+-- results by this tag (see Note [Cost of deterministic iteration]). So you

+-- should only use `UniqDFM` if you need the deterministic property.

+-- every value with its insertion tag that can later be used to sort the

+--   data UniqDFM ele = UDFM (Word64Map ele) [ele]

+-- | A type of values carrying an insertion tag

+    {-# UNPACK #-} !Int -- ^ insertion tag

+                                   -- values carry an insertion tag.

+    {-# UNPACK #-} !Int            -- Upper bound on the values' insertion

+                                   -- tags. See Note [Overflow on plusUDFM]

+  -- See Note [UDFM invariants]

+{- Note [UDFM invariants]

+~~~~~~~~~~~~~~~~~~~~~~~~~

+In a map (UDFM m ub):

+

+ (a) The insertion tags of the elements of m are distinct.

+ (b) Every tag lies in [0, ub).

+

+Consequently ub >= size m.

+

+The tags determine the order of deterministic iteration (eltsUDFM,

+udfmToList). See Note [Sorting a UDFM].

+-}

+

+-- | Deterministic. See Note [Cost of deterministic iteration].

+-- | Deterministic. See Note [Cost of deterministic iteration].

+-- The main problem that needs to be solved is overlap on insertion

+-- tags between different keys in two maps.

+--

+-- O(n) in the common case, with an O(n log n) fallback.

+--

+-- See Note [Cost of deterministic iteration].

+-- Specialises k and z into M.foldr on the small-map path.

+foldUDFM k z (UDFM m ub)

+  | M.compareSize m 1 /= GT = M.foldr (k . taggedFst) z m

+  | otherwise               = fold_udfm k z m ub

+

+fold_udfm :: (elt -> a -> a) -> a -> M.Word64Map (TaggedVal elt) -> Int -> a

+{-# NOINLINE fold_udfm #-}

+-- Kept out of line so that foldUDFM's consumers don't inline the sort machinery.

+fold_udfm k z m ub

+  | usePigeonholeSort m ub = foldr k z (pigeonholeSort ub (\_ tv -> tv) m)

+  | otherwise              = foldr k z (map taggedFst (sort_it m))

+

+-- | Like 'foldUDFM' but the function also receives a key.

+--

+-- See Note [Cost of deterministic iteration].

+{- Note [Cost of deterministic iteration]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+Deterministic iteration -- foldUDFM, eltsUDFM, udfmToList, and everything

+built on them -- orders elements by insertion tag. The element with the

+smallest tag can sit anywhere in the map, so every tag must be inspected,

+and, given a @UDFM m ub@ on the pigeonhole-sort path, an array with ub slots

+must be filled, before the first element can be emitted (see

+Note [Sorting a UDFM]). So beyond maps of a single element, deterministic

+iteration cannot stream: demanding any of the result processes the whole

+map. #27459 shows that cost hitting a consumer that only needed to know

+whether the result was non-empty.

+

+So: to test for emptiness, use isNullUDFM rather than null on eltsUDFM;

+for order-oblivious queries, prefer short-circuiting anyUDFM/allUDFM; and

+if you don't need the deterministic order at all, use nonDetStrictFoldUDFM.

+-}

+

+-- | Deterministic, in order of insertion.

+--

+-- See Note [Sorting a UDFM] and Note [Cost of deterministic iteration].

+{-# INLINE eltsUDFM #-}  -- so the small case is a good producer

+                         -- This matters for T13719.

+eltsUDFM (UDFM m ub)

+  | M.compareSize m 1 /= GT = build (\c n -> M.foldr (c . taggedFst) n m)

+  | otherwise               = elts_udfm m ub

+

+elts_udfm :: M.Word64Map (TaggedVal elt) -> Int -> [elt]

+{-# NOINLINE elts_udfm #-}

+-- Kept out of line so that eltsUDFM's consumers don't inline the sort machinery.

+elts_udfm m ub

+  | usePigeonholeSort m ub = pigeonholeSort ub (\_ tv -> tv) m

+  | otherwise              = map taggedFst (sort_it m)

+

+{- Note [Sorting a UDFM]

+~~~~~~~~~~~~~~~~~~~~~~~~

+Deterministic iteration must yield a map's elements in order of their

+insertion tags. The obvious way is to sort on the tags, but we can do better:

+in (UDFM m ub) the tags are distinct indices into [0, ub) (see

+Note [UDFM invariants]), so each element can simply be placed at its own

+tag in an ub-slot array, which is then read back in index order. This is

+pigeonhole sort, with one element per hole.

+

+Cost: writing the elements is O(n) for n = M.size m, while allocating the

+array and reading it back are O(ub). Since n <= ub the total is O(ub). No

+comparisons are made.

+

+So the method wins only while the array stays dense, and ub never shrinks

+(overwrites keep bumping it, delete/filter shrink n but not ub).

+usePigeonholeSort therefore takes this path only when ub <= 4 * n, which

+bounds its cost at O(n), and falls back to the O(n log n) comparison sort

+otherwise.

+

+Unfilled slots contain a TaggedVal with tag -1 and value

+@unsafeCoerce () :: r@. This is safe because the value is never used: only

+slots with non-negative tags are read.

+

+pigeonholeSort also avoids intermediate lists: it fills the array by

+traversing the map directly, and emits its readout with 'build', so the foldr

+in fold_udfm fuses with it. This contributes significantly to the allocation

+reductions in InstanceMatching1 in !16292.

+-}

+

+-- | @ub <= 4 * size m@, computed without a full 'M.size' traversal.

+usePigeonholeSort :: M.Word64Map a -> Int -> Bool

+usePigeonholeSort m ub = M.compareSize m ceil_ub_div_4 /= LT

+  where

+    ceil_ub_div_4 = (ub + 3) `div` 4  -- ceil(ub/4): ub <= 4*n iff n >= ceil(ub/4)

+

+-- | Order the map's elements by tag. The tags must be distinct and in

+-- @[0, ub)@, and @mk@ must preserve them. See Note [Sorting a UDFM].

+pigeonholeSort :: forall e r. Int

+              -> (M.Key -> TaggedVal e -> TaggedVal r)

+              -> M.Word64Map (TaggedVal e)

+              -> [r]

+{-# INLINE pigeonholeSort #-}  -- Specialise mk and enable foldr/build fusion.

+pigeonholeSort ub mk m = build gen

+  where

+    -- The tag -1 marks unfilled slots; the value field is never read, but it

+    -- is strict, so it needs a WHNF value of type r. See Note [Sorting a UDFM].

+    hole :: TaggedVal r

+    hole = TaggedVal (unsafeCoerce ()) (-1)

+

+    fill :: SmallMutableArray s (TaggedVal r) -> State# s -> (# State# s, () #)

+    fill marr s = case M.traverseWithKey_ write m of ST st -> st s

+      where

+        write k tv = ST (\s' ->

+          (# writeSmallArray marr (taggedSnd tv) (mk k tv) s', () #))

+

+    gen :: forall b. (r -> b -> b) -> b -> b

+    gen cons nil = runST (ST (\s0 ->

+      case newSmallArray ub hole s0 of

+        (# s1, marr #) -> case fill marr s1 of

+          (# s2, () #) -> case unsafeFreezeSmallArray marr s2 of

+            (# s3, arr #) -> (# s3, readout arr 0 #)))

+      where

+        readout :: SmallArray (TaggedVal r) -> Int -> b

+        readout arr j

+          | j >= ub   = nil

+          | t < 0     = readout arr (j + 1)

+          | otherwise = cons v (readout arr (j + 1))

+          where TaggedVal v t = indexSmallArray arr j

+

+--

+-- O(n) in the common case, with an O(n log n) fallback.

+--

+-- See Note [Cost of deterministic iteration].

+-- NB: no INLINE, unlike eltsUDFM. udfmToList's one hot consumer is

+-- traverseUSDFM in the pattern-match checker, which doesn't fuse. Inlining

+-- the size dispatch into it regresses T17836.

+udfmToList (UDFM m ub)

+  | M.compareSize m 1 /= GT =

+      M.foldrWithKey (\k tv r -> (mkUniqueGrimily k, taggedFst tv) : r) [] m

+  | usePigeonholeSort m ub = pigeonholeSort ub

+      (\k tv -> TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv)) m

+  | otherwise =

+      [ (mkUniqueGrimily k, taggedFst v)

+      | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ]