GitLab

Florian Ragwitz pushed to branch wip/rafl/hpc-instances at Glasgow Haskell Compiler / GHC

Commits:

d69673b4

by Florian Ragwitz at 2026-09-25T06:20:57-07:00

hpc: Provide coverage information for class instances

After fixing #17155, we no longer create top-level boxes for the source spans
of instance heads (previously that was the source span used for
inherited/generated instance methods).

With those boxes gone, we can introduce a new top-level box for each class
instance with that instance head source span, and provide more meaningful
coverage semantics for it.

We make the use of any of the instance's methods (user-written or generated)
tick this box, providing the programmer with useful information about whether
or not the instance was exercised at run-time, and whether the instance might
be unnecessary.

99fb6e11

by Florian Ragwitz at 2026-09-25T06:20:57-07:00

hpc: Don't allocate boxes for methodless classes

With the plumbing we currently have, these could never be covered, which is not
helpful to hpc users. This could be improved upon further.

f0d26889
by Florian Ragwitz at 2026-09-25T06:20:57-07:00
```
Add a changelog entry for new HPC features
```

Changes:

changelog.d/hpc-classinsts

 +section: compiler
 +synopsis: Improve coverage reporting for class instances and their methods
 +description:
++
 +  Coverage reporting (:ghc-flag:`-fhpc`) now treats class instances more
 +  naturally.
++
 +  Compiler-generated instance methods, such as inherited default methods, no
 +  longer receive separate top-level coverage boxes. Explicitly implemented
 +  instance methods retain their own declaration coverage.
++
 +  This means that it is no longer necessary to exercise all of a class' methods
 +  in order for it to appear "covered".
++
 +  Additionally, top-level coverage boxes are now created for all instances of
 +  classes with methods, and ticked by the use of *any* of the class' methods.
 +  This indicates that an instance was in fact used at run-time.
++
 +  Note that classes without any instance methods are currently excluded from
 +  this, and won't have any coverage boxes created.
++
 +mrs: !16632
 +issues: #17155 #15932

compiler/GHC/HsToCore.hs

@@ -171,7 +171,8 @@ deSugar hsc_env
                                         (hsc_logger hsc_env)
                                         (initTicksConfig (hsc_dflags hsc_env))
                                         mod mod_loc
 -                                       export_set (typeEnvTyCons type_env) inst_meths binds
 +                                       export_set (typeEnvTyCons type_env)
 +                                       insts inst_meths binds
                                else return (binds, Nothing)
          ; let modBreaks
                  | Just (_, _, breakpointSpecs) <- m_tickInfo

compiler/GHC/HsToCore/Ticks.hs

@@ -25,6 +25,7 @@ import GHC.Unit
  import GHC.Core.Type
  import GHC.Core.TyCon
  import GHC.Core.InstEnv
 +import GHC.Core.Class
  import GHC.Data.Maybe
  import GHC.Data.FastString
@@ -49,6 +50,7 @@ import GHC.Types.CostCentre.State
  import GHC.Types.Tickish
  import GHC.Types.ProfAuto
  import GHC.Tc.Types.ErrCtxt
 +import GHC.Tc.Utils.TcType
  import Control.Monad
  import Data.List (isSuffixOf, intersperse)
@@ -57,6 +59,7 @@ import Data.Foldable (toList)
  import Trace.Hpc.Mix
  import Data.Bifunctor (second)
 +import Data.Functor
  import Data.List.NonEmpty (NonEmpty (..))
  import Data.Set (Set)
  import qualified Data.Set as Set
@@ -101,12 +104,15 @@ addTicksToBinds
                                  -- isExportedId doesn't work yet (the desugarer
                                  -- hasn't set it), so we have to work from this set.
          -> [TyCon]              -- ^ Type constructors in this module
 -        -> IdEnv DFunId
 +        -> [ClsInst]            -- ^ Class instances in this module
 +        -> IdEnv DFunId         -- ^ Mapping from class method Ids to the DFunIds
 +                                -- of the class instance they belong to. See Note
 +                                -- [Instance Method Coverage].
          -> LHsBinds GhcTc
          -> IO (LHsBinds GhcTc, Maybe (FilePath, SizedSeq Tick, SizedSeq Tick))
  addTicksToBinds logger cfg
 -                mod mod_loc exports tyCons inst_meths binds
 +                mod mod_loc exports tyCons insts inst_meths binds
    | let passes = ticks_passes cfg
    , not (null passes)
    , Just orig_file <- ml_hs_file mod_loc = do
@@ -132,8 +138,12 @@ addTicksToBinds logger cfg
                        , tickishType  = tickish
                        , recSelBinds  = emptyVarEnv
                        , instMeths    = inst_meths
 +                      , instTicks    = emptyVarEnv
+                       }
 -                (binds',_,st') = unTM (addTickLHsBinds binds) env st
 +                addTick = do
 +                  instTicks <- allocInstTicks insts
 +                  withEnv (\e -> e{ instTicks }) $ addTickLHsBinds binds
 +                (binds',_,st') = unTM addTick env st
              in (binds', st')
            (binds1,st) = foldr tickPass (binds, initTTState) passes
@@ -315,9 +325,13 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches
               else
                  return Nothing
 +  -- See Note [Instance Method Coverage].
 +  instTick <- instMethTick id
++
    let mbCons = maybe Prelude.id (:)
    return $ L pos $ funBind { fun_matches = mg
 -                           , fun_ext = second (tick `mbCons`) (fun_ext funBind) }
 +                           , fun_ext = second ((instTick `mbCons`) . (tick `mbCons`))
 +                                              (fun_ext funBind) }
    } }
    where
      -- See Note [Record-selector ticks]
@@ -366,6 +380,17 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches
  -- creating tick boxes for top-level bindings, we can then decide if a given
  -- 'FunBind' corresponds to an inherited/generated instance method of a class
  -- and skip creating the tick box for it.
 +--
 +-- Additionally, we also want to inform the user whether or not their class
 +-- instance as a whole has been used at run-time. To do so, we create a single
 +-- tick box at the instance head and tick that box when any method of that
 +-- instance is evaluated.
 +--
 +-- As marker/tag-like class instances without any methods would always appear
 +-- as uncovered using the above mechanism, we exclude them when creating
 +-- instance tick boxes. This could potentially be improved in the future by
 +-- tracking if any functions requiring an instance of an empty class have been
 +-- evaluated.
  -- TODO: Revisit this
  addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
@@ -1128,6 +1153,7 @@ data TickTransEnv = TTE { fileName     :: FastString
                          , tickishType  :: TickishType
                          , recSelBinds  :: IdEnv DVarSet
                          , instMeths    :: IdEnv DFunId
 +                        , instTicks    :: IdEnv CoreTickish
+                         }
  --      deriving Show
@@ -1268,6 +1294,21 @@ isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList
  isBlackListed GeneratedSrcSpan{} = return False
  isBlackListed UnhelpfulSpan{} = return False
 +-- See Note [Instance Method Coverage].
 +allocInstTicks :: [ClsInst] -> TM (IdEnv CoreTickish)
 +allocInstTicks insts =
 +    ifDensity TickForCoverage (mkVarEnv . catMaybes <$> mapM alloc insts) (pure emptyVarEnv)
 +  where
 +    alloc ClsInst{ is_dfun, is_cls }
 +      | null (classMethods is_cls) = pure Nothing
 +      | otherwise = fmap (is_dfun,) <$> allocATickBox (TopLevelBox [s])
 +                                                      False True (getSrcSpan is_dfun) noFVs
 +      where s = showSDocOneLine defaultSDocContext (pprSigmaType (idType is_dfun))
++
 +-- See Note [Instance Method Coverage].
 +instMethTick :: Id -> TM (Maybe CoreTickish)
 +instMethTick id = getEnv <&> \e -> lookupVarEnv (instMeths e) id >>= lookupVarEnv (instTicks e)
++
  -- the tick application inherits the source position of its
  -- expression argument to support nested box allocations
  allocTickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> TM (HsExpr GhcTc)