GitLab

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC

Commits:

b3c9a5c7

by Simon Jakobi at 2026-07-11T09:19:48+02:00

UDFM: match TaggedVal eagerly instead of projecting with taggedFst

The TaggedHole commit rewrote several call sites from eager pattern
matches to taggedFst/taggedSnd projections to keep patterns exhaustive.
Where the projection is passed to an unknown, possibly-lazy function
(nonDetStrictFoldUDFM, filterUDFM, filterUDFM_Directly, alterUDFM,
alterUDFM_L, upsertUDFM), GHC must let-bind (taggedFst tv) as a thunk
rather than forcing tv up front, costing an allocation per element or
per call. Release-flavour CI showed this as T24471 ghc/alloc +3%.

Restore explicit pattern matches at those sites, with an explicit
TaggedHole -> panic alternative. The tf helpers in addToUDFM_Directly
and addToUDFM_C_Directly keep the accessor style: their projections
feed strict TaggedVal fields, so no thunk survives.

Assisted-by: Claude Fable 5

5413343a

by Simon Jakobi at 2026-07-11T13:52:13+02:00

Revert the TaggedHole placement-sort commits

This reverts b3c9a5c7c5 ("UDFM: match TaggedVal eagerly instead of
projecting with taggedFst") and a70e4b4285 ("UDFM: represent
placement-sort holes with a TaggedHole constructor"), restoring the
static unsafeCoerce () sentinel from 26f30aa1f2.

The extra constructor leaked the sentinel into every consumer of
TaggedVal: each match had to cover an impossible case or go through
partial accessors, and the accessor style regressed T24471 ghc/alloc
by 3% (release CI) via per-element thunks at lazy call sites. The
unsafeCoerce sentinel keeps the hole local to placementSort.

Assisted-by: Claude Fable 5

633b5543

by Simon Jakobi at 2026-07-11T13:53:16+02:00

UDFM: tighten the placement-sort sentinel documentation

Restructure the hole paragraphs of Note [Sorting a UDFM]: separate the
two conditions the unsafeCoerce safety argument rests on, note that the
sentinel never escapes placementSort, and list the alternative hole
representations with why each costs more.

Assisted-by: Claude Fable 5

2e96e50f

by Simon Jakobi at 2026-07-11T14:01:35+02:00

Accept perf metric decreases from the UDFM placement sort

Deterministic UDFM iteration no longer allocates the mergesort's cons
cells (#27459). All four perf-testing CI platforms report the same set
of decreases, the largest being InstanceMatching1 at -69%.

Assisted-by: Claude Fable 5

-------------------------
Metric Decrease:
    InstanceMatching
    InstanceMatching1
    ManyAlternatives
    T13719
-------------------------

1 changed file:

compiler/GHC/Types/Unique/DFM.hs

Changes:

compiler/GHC/Types/Unique/DFM.hs

@@ -74,7 +74,6 @@ import GHC.Prelude
  import GHC.Types.Unique ( Uniquable(..), Unique, getKey, mkUniqueGrimily )
  import GHC.Utils.Outputable
 -import GHC.Utils.Panic (panic)
  import qualified GHC.Data.Word64Map.Strict as MS
  import qualified GHC.Data.Word64Map as M
@@ -136,24 +135,19 @@ import qualified GHC.Data.Word64Set as W
  -- | A type of values carrying an insertion tag
  data TaggedVal val =
 -    TaggedVal
 -      !val
 -      {-# UNPACK #-} !Int -- ^ insertion tag
 -  | TaggedHole            -- ^ placement-sort gap sentinel; never stored in a map.
 -                          --   See Note [Sorting a UDFM].
 +  TaggedVal
 +    !val
 +    {-# UNPACK #-} !Int -- ^ insertion tag
    deriving stock (Data, Functor, Foldable, Traversable)
  taggedFst :: TaggedVal val -> val
  taggedFst (TaggedVal v _) = v
 -taggedFst TaggedHole      = panic "taggedFst: TaggedHole"
  taggedSnd :: TaggedVal val -> Int
  taggedSnd (TaggedVal _ i) = i
 -taggedSnd TaggedHole      = panic "taggedSnd: TaggedHole"
  instance Eq val => Eq (TaggedVal val) where
    (TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2
 -  _                == _                = panic "TaggedVal (==): TaggedHole"
  -- | Type of unique deterministic finite maps
  --
@@ -213,7 +207,7 @@ addToUDFM_Directly :: UniqDFM key elt -> Unique -> elt -> UniqDFM key elt
  addToUDFM_Directly (UDFM m i) u v
    = UDFM (MS.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
    where
 -    tf new old = TaggedVal (taggedFst new) (taggedSnd old)
 +    tf (TaggedVal new_v _) (TaggedVal _ old_i) = TaggedVal new_v old_i
        -- Keep the old tag, but insert the new value
        -- This means that udfmToList typically returns elements
        -- in the order of insertion, rather than the reverse
@@ -230,8 +224,8 @@ addToUDFM_C_Directly
  addToUDFM_C_Directly f (UDFM m i) u v
    = UDFM (MS.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
      where
 -      tf new old
 -         = TaggedVal (f (taggedFst old) (taggedFst new)) (taggedSnd old)
 +      tf (TaggedVal new_v _) (TaggedVal old_v old_i)
 +         = TaggedVal (f old_v new_v) old_i
            -- Flip the arguments, because M.insertWith uses  (new->old->result)
            --                         but f            needs (old->new->result)
            -- Like addToUDFM_Directly, keep the old tag
@@ -384,7 +378,7 @@ foldWithKeyUDFM k z m = foldr (uncurry k) z (udfmToList m)
  nonDetStrictFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a
  nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m
    where
 -    k' acc tv = k (taggedFst tv) acc
 +    k' acc (TaggedVal v _) = k v acc
  {- Note [Cost of deterministic iteration]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -446,13 +440,38 @@ folding the sorted elements with no intermediate list. foldUDFM is INLINE and
  dispatches through the out-of-line fold_elts_nonempty, where the fusion happens
  once -- so the fold is list-free without inlining the sort into every consumer.
 -Holes: slots whose tag never occurs keep the initial sentinel, the nullary
 -constructor TaggedHole. The readout distinguishes it from a real TaggedVal by
 -constructor, so it never touches a filled element's value in a hole slot.
 -TaggedHole is static (a nullary constructor is a single shared closure), so
 -newSmallArray fills every slot with the same pointer -- no per-call allocation,
 -nothing retained. TaggedHole must never be stored in a map; the accessors
 -(taggedFst, taggedSnd) panic on it to catch any invariant violation.
 +Holes: slots whose tag never occurs keep the initial sentinel, a TaggedVal
 +with tag -1. Real tags are non-negative, so the readout skips slots with
 +tag < 0 and takes the value field only from filled slots. That value field
 +is strict, so the sentinel must hold something in WHNF even though it is
 +never used: we use @unsafeCoerce () :: r@. This is safe because
++
 +  (S1) r is a lifted boxed type (it is the map's element type), so a
 +       pointer to the static () closure has the right representation and
 +       the GC can trace it; and
++
 +  (S2) the coerced value is never entered or otherwise used at type r:
 +       the sentinel is the only TaggedVal with a negative tag, and the
 +       readout takes values only from slots with tag >= 0.
++
 +Since () is a single static closure, newSmallArray fills every slot with
 +the same pointer: no per-call allocation, nothing retained.
++
 +The sentinel stays local to placementSort: it exists only in the array
 +between fill and readout, never in a map, so nothing outside this function
 +needs to know about it. Alternative hole representations all cost more:
++
 +  * a panic in the value field: forced (the field is strict) as soon as
 +    the readout inspects the first hole's tag -- a crash, not a sentinel;
 +  * borrowing a real element of the map: type-checks, but is a per-call
 +    thunk that retains the whole source map until the holes are dropped;
 +  * a dedicated hole constructor in TaggedVal: no coercion, but the
 +    sentinel leaks into the type -- every match in this module must cover
 +    a constructor that never occurs outside placementSort, and projecting
 +    via partial accessors instead allocates a thunk wherever the value is
 +    passed to an unknown function (T24471 ghc/alloc +3%);
 +  * an extra sum wrapped around the array elements (e.g. Maybe): an
 +    allocation per element in the fill.
  This sorting method loses when ub is much larger than n = M.size m: ub never
  shrinks (overwrites keep bumping it, delete/filter shrink n but not ub). We
@@ -484,10 +503,10 @@ placementSort :: forall e r. Int
                                -- consuming fold. See Note [Sorting a UDFM].
  placementSort ub mk m = build gen
    where
 -    -- Unfilled slots hold the TaggedHole sentinel; the readout skips it.
 -    -- See Note [Sorting a UDFM].
 +    -- 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 = TaggedHole
 +    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
@@ -508,17 +527,17 @@ placementSort ub mk m = build gen
          readout :: SmallArray (TaggedVal r) -> Int -> b
          readout arr j
            | j >= ub   = nil
 -          | otherwise = case indexSmallArray arr j of
 -              TaggedHole    -> readout arr (j + 1)
 -              TaggedVal v _ -> cons v (readout arr (j + 1))
 +          | t < 0     = readout arr (j + 1)
 +          | otherwise = cons v (readout arr (j + 1))
 +          where TaggedVal v t = indexSmallArray arr j
  filterUDFM :: (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
 -filterUDFM p (UDFM m i) = UDFM (M.filter (p . taggedFst) m) i
 +filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i
  filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
  filterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i
    where
 -  p' k tv = p (mkUniqueGrimily k) (taggedFst tv)
 +  p' k (TaggedVal v _) = p (mkUniqueGrimily k) v
  udfmRestrictKeys :: UniqDFM key elt -> UniqDFM key elt2 -> UniqDFM key elt
  udfmRestrictKeys (UDFM a i) (UDFM b _) = UDFM (M.restrictKeys a (M.keysSet b)) i
@@ -642,7 +661,7 @@ alterUDFM f (UDFM m i) k =
    UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)
    where
    alterf Nothing = inject $ f Nothing
 -  alterf (Just tv) = inject $ f (Just (taggedFst tv))
 +  alterf (Just (TaggedVal v _)) = inject $ f (Just v)
    inject Nothing = Nothing
    inject (Just v) = Just $ TaggedVal v i
@@ -661,7 +680,7 @@ upsertUDFM f (UDFM m i) k =
    UDFM (MS.upsert upsertf (getKey $ getUnique k) m) (i + 1)
    where
      upsertf Nothing = TaggedVal (f Nothing) i
 -    upsertf (Just tv) = TaggedVal (f (Just (taggedFst tv))) i
 +    upsertf (Just (TaggedVal v _)) = TaggedVal (f (Just v)) i
  -- | The expression (@'alterUDFM_L' f map k@) alters value @x@ at @k@, or absence
  -- thereof and returns the new element at @k@ if there is any.
@@ -684,7 +703,7 @@ alterUDFM_L f (UDFM m i) k =
    where
    alterf :: Maybe (TaggedVal elt) -> (Maybe (TaggedVal elt))
    alterf Nothing = inject $ f Nothing
 -  alterf (Just tv) = inject $ f (Just (taggedFst tv))
 +  alterf (Just (TaggedVal v _)) = inject $ f (Just v)
    inject Nothing = Nothing
    inject (Just v) = Just $ TaggedVal v i