Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC Commits: 674a1380 by Rodrigo Mesquita at 2025-06-30T18:13:57+01:00 refactor: Use BreakpointId in Core and Ifaces - - - - - 21 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Types/Breakpoint.hs - compiler/GHC/Types/Tickish.hs Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -287,7 +287,7 @@ exprs_fvs :: [CoreExpr] -> FV exprs_fvs exprs = mapUnionFV expr_fvs exprs tickish_fvs :: CoreTickish -> FV -tickish_fvs (Breakpoint _ _ ids _) = FV.mkFVs ids +tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids tickish_fvs _ = emptyFV {- ********************************************************************** @@ -759,8 +759,8 @@ freeVars = go , AnnTick tickish expr2 ) where expr2 = go expr - tickishFVs (Breakpoint _ _ ids _) = mkDVarSet ids - tickishFVs _ = emptyDVarSet + tickishFVs (Breakpoint _ _ ids) = mkDVarSet ids + tickishFVs _ = emptyDVarSet go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty) go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -897,8 +897,8 @@ lintCoreExpr (Cast expr co) lintCoreExpr (Tick tickish expr) = do { case tickish of - Breakpoint _ _ ids _ -> forM_ ids $ \id -> lintIdOcc id 0 - _ -> return () + Breakpoint _ _ ids -> forM_ ids $ \id -> lintIdOcc id 0 + _ -> return () ; markAllJoinsBadIf block_joins $ lintCoreExpr expr } where block_joins = not (tickish `tickishScopesLike` SoftScope) ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -198,11 +198,10 @@ eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where eqDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Bool eqDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where - go (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod) + go (Breakpoint lext lid lids) (Breakpoint rext rid rids) = lid == rid && D env1 lids == D env2 rids && lext == rext - && lmod == rmod go l r = l == r -- Compares for equality, modulo alpha ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2501,7 +2501,7 @@ occAnal env (Tick tickish body) -- For a non-soft tick scope, we can inline lambdas only, so we -- abandon tail calls, and do markAllInsideLam too: usage_lam - | Breakpoint _ _ ids _ <- tickish + | Breakpoint _ _ ids <- tickish = -- Never substitute for any of the Ids in a Breakpoint addManyOccs usage_lam (mkVarSet ids) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1461,8 +1461,8 @@ simplTick env tickish expr cont simplTickish env tickish - | Breakpoint ext n ids modl <- tickish - = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl + | Breakpoint ext bid ids <- tickish + = Breakpoint ext bid (mapMaybe (getDoneId . substId env) ids) | otherwise = tickish -- Push type application and coercion inside a tick ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Prelude import GHC.Core import GHC.Core.Stats (exprStats) +import GHC.Types.Breakpoint import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Literal( pprLiteral ) import GHC.Types.Name( pprInfixName, pprPrefixName ) @@ -694,10 +695,10 @@ instance Outputable (XTickishId pass) => Outputable (GenTickish pass) where ppr modl, comma, ppr ix, text ">"] - ppr (Breakpoint _ext ix vars modl) = + ppr (Breakpoint _ext bid vars) = hcat [text "break<", - ppr modl, comma, - ppr ix, + ppr (bi_tick_mod bid), comma, + ppr (bi_tick_index bid), text ">", parens (hcat (punctuate comma (map ppr vars)))] ppr (ProfNote { profNoteCC = cc, ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -602,8 +602,8 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ -- | Drop free vars from the breakpoint if they have a non-variable substitution. substTickish :: Subst -> CoreTickish -> CoreTickish -substTickish subst (Breakpoint ext n ids modl) - = Breakpoint ext n (mapMaybe do_one ids) modl +substTickish subst (Breakpoint ext bid ids) + = Breakpoint ext bid (mapMaybe do_one ids) where do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -235,8 +235,8 @@ tidyAlt env (Alt con vs rhs) ------------ Tickish -------------- tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish -tidyTickish env (Breakpoint ext ix ids modl) - = Breakpoint ext ix (map (tidyVarOcc env) ids) modl +tidyTickish env (Breakpoint ext bid ids) + = Breakpoint ext bid (map (tidyVarOcc env) ids) tidyTickish _ other_tickish = other_tickish ------------ Rules -------------- ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2492,11 +2492,10 @@ cheapEqExpr' ignoreTick e1 e2 -- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool -eqTickish env (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod) +eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids) = lid == rid && map (rnOccL env) lids == map (rnOccR env) rids && - lext == rext && - lmod == rmod + lext == rext eqTickish _ l r = l == r -- | Finds differences between core bindings, see @diffExpr@. ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -586,8 +586,8 @@ toIfaceTickish (ProfNote cc tick push) = IfaceSCC cc tick push toIfaceTickish (HpcTick modl ix) = IfaceHpcTick modl ix toIfaceTickish (SourceNote src (LexicalFastString names)) = IfaceSource src names -toIfaceTickish (Breakpoint _ ix fv m) = - IfaceBreakpoint ix (toIfaceVar <$> fv) m +toIfaceTickish (Breakpoint _ ix fv) = + IfaceBreakpoint ix (toIfaceVar <$> fv) --------------------- toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -643,10 +643,10 @@ coreToStgArgs (arg : args) = do -- Non-type argument coreToStgTick :: Type -- type of the ticked expression -> CoreTickish -> StgTickish -coreToStgTick _ty (HpcTick m i) = HpcTick m i -coreToStgTick _ty (SourceNote span nm) = SourceNote span nm -coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope -coreToStgTick !ty (Breakpoint _ bid fvs modl) = Breakpoint ty bid fvs modl +coreToStgTick _ty (HpcTick m i) = HpcTick m i +coreToStgTick _ty (SourceNote span nm) = SourceNote span nm +coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope +coreToStgTick !ty (Breakpoint _ bid fvs) = Breakpoint ty bid fvs -- --------------------------------------------------------------------------- -- The magic for lets: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -842,9 +842,9 @@ cpeRhsE env (Tick tickish expr) = do { body <- cpeBodyNF env expr ; return (emptyFloats, mkTick tickish' body) } where - tickish' | Breakpoint ext n fvs modl <- tickish + tickish' | Breakpoint ext bid fvs <- tickish -- See also 'substTickish' - = Breakpoint ext n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) modl + = Breakpoint ext bid (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) | otherwise = tickish ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Driver.Flags (DumpFlag(..)) import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Utils.Logger +import GHC.Types.Breakpoint import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Id @@ -1235,7 +1236,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do Breakpoints -> do i <- addMixEntry me - pure (Breakpoint noExtField i ids (this_mod env)) + pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids) SourceNotes | RealSrcSpan pos' _ <- pos -> return $ SourceNote pos' $ LexicalFastString cc_name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -56,6 +56,7 @@ import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue) import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey, constraintKindTyConKey ) +import GHC.Types.Breakpoint import GHC.Types.Unique ( hasKey ) import GHC.Iface.Type import GHC.Iface.Recomp.Binary @@ -699,7 +700,7 @@ data IfaceTickish = IfaceHpcTick Module Int -- from HpcTick x | IfaceSCC CostCentre Bool Bool -- from ProfNote | IfaceSource RealSrcSpan FastString -- from SourceNote - | IfaceBreakpoint Int [IfaceExpr] Module -- from Breakpoint + | IfaceBreakpoint BreakpointId [IfaceExpr] -- from Breakpoint data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr -- Note: IfLclName, not IfaceBndr (and same with the case binder) @@ -1848,7 +1849,7 @@ pprIfaceTickish (IfaceSCC cc tick scope) = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope) pprIfaceTickish (IfaceSource src _names) = braces (pprUserRealSpan True src) -pprIfaceTickish (IfaceBreakpoint m ix fvs) +pprIfaceTickish (IfaceBreakpoint (BreakpointId m ix) fvs) = braces (text "break" <+> ppr m <+> ppr ix <+> ppr fvs) ------------------ @@ -2198,7 +2199,7 @@ freeNamesIfaceTyConParent (IfDataInstance ax tc tys) = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys freeNamesIfTickish :: IfaceTickish -> NameSet -freeNamesIfTickish (IfaceBreakpoint _ fvs _) = +freeNamesIfTickish (IfaceBreakpoint _ fvs) = fnList freeNamesIfExpr fvs freeNamesIfTickish _ = emptyNameSet @@ -2919,7 +2920,7 @@ instance Binary IfaceTickish where put_ bh (srcSpanEndLine src) put_ bh (srcSpanEndCol src) put_ bh name - put_ bh (IfaceBreakpoint m ix fvs) = do + put_ bh (IfaceBreakpoint (BreakpointId m ix) fvs) = do putByte bh 3 put_ bh m put_ bh ix @@ -2947,7 +2948,7 @@ instance Binary IfaceTickish where 3 -> do m <- get bh ix <- get bh fvs <- get bh - return (IfaceBreakpoint m ix fvs) + return (IfaceBreakpoint (BreakpointId m ix) fvs) _ -> panic ("get IfaceTickish " ++ show h) instance Binary IfaceConAlt where @@ -3206,7 +3207,7 @@ instance NFData IfaceTickish where IfaceHpcTick m i -> rnf m `seq` rnf i IfaceSCC cc b1 b2 -> rnf cc `seq` rnf b1 `seq` rnf b2 IfaceSource src str -> rnf src `seq` rnf str - IfaceBreakpoint m i fvs -> rnf m `seq` rnf i `seq` rnf fvs + IfaceBreakpoint i fvs -> rnf i `seq` rnf fvs instance NFData IfaceConAlt where rnf = \case ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -955,7 +955,7 @@ dffvExpr :: CoreExpr -> DFFV () dffvExpr (Var v) = insert v dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2 dffvExpr (Lam v e) = extendScope v (dffvExpr e) -dffvExpr (Tick (Breakpoint _ _ ids _) e) = mapM_ insert ids >> dffvExpr e +dffvExpr (Tick (Breakpoint _ _ ids) e) = mapM_ insert ids >> dffvExpr e dffvExpr (Tick _other e) = dffvExpr e dffvExpr (Cast e _) = dffvExpr e dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1732,9 +1732,9 @@ tcIfaceTickish :: IfaceTickish -> IfL CoreTickish tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix) tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push) tcIfaceTickish (IfaceSource src name) = return (SourceNote src (LexicalFastString name)) -tcIfaceTickish (IfaceBreakpoint ix fvs modl) = do +tcIfaceTickish (IfaceBreakpoint bid fvs) = do fvs' <- mapM tcIfaceExpr fvs - return (Breakpoint NoExtField ix [f | Var f <- fvs'] modl) + return (Breakpoint NoExtField bid [f | Var f <- fvs']) ------------------------- tcIfaceLit :: Literal -> IfL Literal ===================================== compiler/GHC/Stg/BcPrep.hs ===================================== @@ -49,7 +49,7 @@ bcPrepRHS con@StgRhsCon{} = pure con bcPrepExpr :: StgExpr -> BcPrepM StgExpr -- explicitly match all constructors so we get a warning if we miss any -bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _ _) rhs) +bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs) | isLiftedTypeKind (typeKind tick_ty) = do id <- newId tick_ty rhs' <- bcPrepExpr rhs ===================================== compiler/GHC/Stg/FVs.hs ===================================== @@ -257,8 +257,8 @@ exprFVs env = go , let lcl_fvs' = unionDVarSet (tickish tick) lcl_fvs = (StgTick tick e', imp_fvs, top_fvs, lcl_fvs') where - tickish (Breakpoint _ _ ids _) = mkDVarSet ids - tickish _ = emptyDVarSet + tickish (Breakpoint _ _ ids) = mkDVarSet ids + tickish _ = emptyDVarSet go_bind dc bind body = (dc bind' body', imp_fvs, top_fvs, lcl_fvs) where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Platform.Profile import GHC.Runtime.Interpreter import GHCi.FFI import GHC.Types.Basic +import GHC.Types.Breakpoint import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Id @@ -388,7 +389,7 @@ schemeR_wrk fvs nm original_body (args, body) -- | Introduce break instructions for ticked expressions. -- If no breakpoint information is available, the instruction is omitted. schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList -schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do +schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do code <- schemeE d 0 p rhs hsc_env <- getHscEnv current_mod <- getCurrentModule @@ -640,10 +641,9 @@ schemeE d s p (StgLet _ext binds body) = do thunk_codes <- sequence compile_binds return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code) -schemeE _d _s _p (StgTick (Breakpoint _ bp_id _ _) _rhs) - = panic ("schemeE: Breakpoint without let binding: " ++ - show bp_id ++ - " forgot to run bcPrep?") +schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs) + = pprPanic "schemeE: Breakpoint without let binding: " $ + ppr bp_id <> text " forgot to run bcPrep?" -- ignore other kinds of tick schemeE d s p (StgTick _ rhs) = schemeE d s p rhs ===================================== compiler/GHC/Types/Breakpoint.hs ===================================== @@ -8,6 +8,9 @@ where import GHC.Prelude import GHC.Unit.Module +import GHC.Utils.Outputable +import Control.DeepSeq +import Data.Data (Data) -- | Breakpoint identifier. -- @@ -16,7 +19,7 @@ data BreakpointId = BreakpointId { bi_tick_mod :: !Module -- ^ Breakpoint tick module , bi_tick_index :: !Int -- ^ Breakpoint tick index } - deriving (Eq, Ord) + deriving (Eq, Ord, Data) -- | Internal breakpoint identifier -- @@ -53,3 +56,11 @@ toBreakpointId ibi = BreakpointId -- So every breakpoint occurrence gets assigned a module-unique *info index* and -- we store it alongside the occurrence module (*info module*) in the -- InternalBreakpointId datatype. + +instance Outputable BreakpointId where + ppr BreakpointId{bi_tick_mod, bi_tick_index} = + text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index + +instance NFData BreakpointId where + rnf BreakpointId{bi_tick_mod, bi_tick_index} = + rnf bi_tick_mod `seq` rnf bi_tick_index ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Core.Type import GHC.Unit.Module +import GHC.Types.Breakpoint import GHC.Types.CostCentre import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan ) import GHC.Types.Var @@ -128,7 +129,7 @@ data GenTickish pass = -- and (b) substituting (don't substitute for them) | Breakpoint { breakpointExt :: XBreakpoint pass - , breakpointId :: !Int + , breakpointId :: !BreakpointId , breakpointFVs :: [XTickishId pass] -- ^ the order of this list is important: -- it matches the order of the lists in the @@ -136,7 +137,6 @@ data GenTickish pass = -- -- Careful about substitution! See -- Note [substTickish] in "GHC.Core.Subst". - , breakpointModule :: Module } -- | A source note. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/674a1380fa8dcc4715be6a028880cbfe... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/674a1380fa8dcc4715be6a028880cbfe... You're receiving this email because of your account on gitlab.haskell.org.