Florian Ragwitz pushed to branch wip/rafl/hpc-instances at Glasgow Haskell Compiler / GHC Commits: 45019587 by Florian Ragwitz at 2026-10-07T18:54:05-07:00 Revert back to just using getOccString for DFunIds - - - - - 100074ba by Florian Ragwitz at 2026-10-07T18:54:05-07:00 Limit instance and instance method coverage to HPC only It's not useful for SourceNotes, which is the other tickishType included in TickForCoverage. - - - - - a9c4f52b by Florian Ragwitz at 2026-10-07T18:54:05-07:00 Limit record selector ticking to HPC - - - - - 3 changed files: - compiler/GHC/HsToCore/Ticks.hs - testsuite/tests/hpc/instmeths/instmeths.hs - testsuite/tests/hpc/instmeths/instmeths.stdout Changes: ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -51,7 +51,6 @@ 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) @@ -313,7 +312,7 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches exported = idName id `elemNameSet` exported_names -- See Note [Instance Method Coverage]. - let generatedInstMeth = density == TickForCoverage + let generatedInstMeth = tickishType env == HpcTicks && id `elemVarEnv` instMeths env && isGenerated (mg_origin (mg_ext matches)) @@ -1236,6 +1235,9 @@ getDensity = TM $ \env st -> (density env, noFVs, st) ifDensity :: TickDensity -> TM a -> TM a -> TM a ifDensity d th el = do d0 <- getDensity; if d == d0 then th else el +ifTickish :: TickishType -> TM a -> TM a -> TM a +ifTickish want th el = tickishType <$> getEnv >>= \got -> if want == got then th else el + getFreeVars :: TM a -> TM (FreeVars, a) getFreeVars (TM m) = TM $ \ env st -> case m env st of (a, fv, st') -> ((fv,a), fv, st') @@ -1295,13 +1297,12 @@ isBlackListed UnhelpfulSpan{} = return False -- See Note [Instance Method Coverage]. allocInstTicks :: [ClsInst] -> TM (NameEnv CoreTickish) allocInstTicks insts = - ifDensity TickForCoverage (mkNameEnv . catMaybes <$> mapM alloc insts) (pure emptyNameEnv) + ifTickish HpcTicks (mkNameEnv . catMaybes <$> mapM alloc insts) (pure emptyNameEnv) where alloc ClsInst{ is_dfun, is_cls } | null (classMethods is_cls) = pure Nothing - | otherwise = fmap (idName is_dfun,) <$> allocATickBox (TopLevelBox [s]) + | otherwise = fmap (idName is_dfun,) <$> allocATickBox (TopLevelBox [getOccString is_dfun]) False True (getSrcSpan is_dfun) noFVs - where s = showSDocOneLine defaultSDocContext (pprSigmaType (idType is_dfun)) -- See Note [Instance Method Coverage]. instMethTick :: Id -> TM (Maybe CoreTickish) @@ -1325,7 +1326,7 @@ allocTickBox boxLabel countEntries topOnly pos m return (this_loc (XExpr $ HsTick tickish $ this_loc e)) recSelTick :: Id -> TM (Maybe [CoreTickish]) -recSelTick id = ifDensity TickForCoverage maybe_tick (pure Nothing) +recSelTick id = ifTickish HpcTicks maybe_tick (pure Nothing) where maybe_tick = getEnv >>= maybe (pure Nothing) tick_all . (`lookupVarEnv` id) . recSelBinds ===================================== testsuite/tests/hpc/instmeths/instmeths.hs ===================================== @@ -27,7 +27,7 @@ instance Marker (T Bool) interesting :: (Int, MixEntry) -> Maybe (Int, HpcPos, String) interesting (n, (pos, TopLevelBox [name])) | isInteresting name = Just (n, pos, name) where isInteresting = (||) <$> isInst <*> isMeth - isInst = ("T" `isInfixOf`) + isInst = ("$f" `isPrefixOf`) isMeth = (||) <$> (`elem` ["(==)", "(/=)", "show", "showList", "showsPrec", "fmap", "(<$)"]) <*> ("Meth" `isInfixOf`) interesting _ = Nothing ===================================== testsuite/tests/hpc/instmeths/instmeths.stdout ===================================== @@ -1,10 +1,10 @@ True "Foo (T' a) instance" -(1,"Eq a => Eq (T a)","Eq") -(0,"Foo (T a)","Foo (T a)") -(1,"Foo (T' a)","Foo (T' a)") -(1,"Functor T","Functor") -(0,"Show a => Show (T a)","Show") +(1,"$fEqT","Eq") +(0,"$fFooT","Foo (T a)") +(1,"$fFooT'","Foo (T' a)") +(1,"$fFunctorT","Functor") +(0,"$fShowT","Show") (0,"defMeth","defMeth = const \"class default\"") (0,"defMeth","defMeth = const \"Foo (T' a) instance\"") (0,"defMeth'","defMeth' = const \"class default\"") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86f16aead8cc4bd2de092eac4aed68b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86f16aead8cc4bd2de092eac4aed68b... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help