Rodrigo Mesquita pushed to branch wip/romes/step-out-8 at Glasgow Haskell Compiler / GHC Commits: 178dd899 by Rodrigo Mesquita at 2025-06-26T14:22:39+01:00 Continue refactor - - - - - f084188e by Rodrigo Mesquita at 2025-06-26T16:20:46+01:00 Lots of progress - - - - - 21 changed files: - compiler/GHC/ByteCode/Asm.hs - + compiler/GHC/ByteCode/Breakpoints.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/StgToByteCode.hs - − compiler/GHC/Types/Breakpoint.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/External.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -31,7 +31,6 @@ import GHC.ByteCode.Types import GHCi.RemoteTypes import GHC.Runtime.Heap.Layout ( fromStgWord, StgWord ) -import GHC.Types.Breakpoint import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Literal @@ -74,6 +73,7 @@ import GHC.Float (castFloatToWord32, castDoubleToWord64) import qualified Data.List as List ( any ) import GHC.Exts +import GHC.HsToCore.Breakpoints (ModBreaks(..)) -- ----------------------------------------------------------------------------- @@ -111,7 +111,7 @@ assembleBCOs -> FlatBag (ProtoBCO Name) -> [TyCon] -> [(Name, ByteString)] - -> Maybe ModBreaks + -> Maybe (InternalModBreaks, ModBreaks) -> [SptEntry] -> IO CompiledByteCode assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do ===================================== compiler/GHC/ByteCode/Breakpoints.hs ===================================== @@ -0,0 +1,210 @@ +{-# LANGUAGE RecordWildCards #-} + +-- | Breakpoint information constructed during ByteCode generation. +-- +-- Specifically, code-generation breakpoints are referred to as "internal +-- breakpoints", the internal breakpoint data for a module is stored in +-- 'InternalModBreaks', and is uniquely identified at runtime by an +-- 'InternalBreakpointId'. +-- +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers] +module GHC.ByteCode.Breakpoints + ( -- * Internal Mod Breaks + InternalModBreaks(imodBreaks_breakInfo), CgBreakInfo(..) + , mkInternalModBreaks + + -- ** Operations + , getInternalBreak, addInternalBreak + + -- ** Internal breakpoint identifier + , InternalBreakpointId(..), BreakInfoIndex + + -- * Utils + , seqInternalModBreaks + + ) + where + +import GHC.Prelude +import Control.DeepSeq +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IM + +import GHC.Iface.Syntax +import GHC.Types.Tickish + +import GHC.Unit.Module (Module) +import GHC.Utils.Outputable +import GHC.Utils.Panic + +{- +Note [ModBreaks vs InternalModBreaks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +'ModBreaks' and 'BreakpointId's must not to be confused with +'InternalModBreaks' and 'InternalBreakId's. + +'ModBreaks' is constructed once during HsToCore from the information attached +to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks' +can be queried using 'BreakpointId's, which uniquely identifies a breakpoint +within the list of breakpoint information for a given module's 'ModBreaks'. + +'InternalModBreaks' are constructed during bytecode generation and are indexed +by a 'InternalBreakpointId'. They contain all the information relevant to a +breakpoint for code generation that can be accessed during runtime execution +(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's +are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN' +instruction receives 'InternalBreakpointId' as an argument. + +We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used +to get source-level information about a breakpoint via the corresponding 'ModBreaks'. + +Notably, 'InternalModBreaks' can contain entries for so-called internal +breakpoints, which do not necessarily have a source-level location attached to +it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to +introduce breakpoints during code generation for features such as stepping-out. + +Note [Breakpoint identifiers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before optimization a breakpoint is identified uniquely with a tick module +and a tick index. See 'BreakpointId'. A tick module contains an array, indexed +with the tick indexes, which indicates breakpoint status. + +When we generate ByteCode, we collect information for every breakpoint at +their *occurrence sites* (see CgBreakInfo) and these info +are stored in the ModIface of the occurrence module. Because of inlining, we +can't reuse the tick index to uniquely identify an occurrence; because of +cross-module inlining, we can't assume that the occurrence module is the same +as the tick module (#24712). + +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. This is the index that we use at runtime to +identify a breakpoint. + +When the internal breakpoint has a matching tick-level breakpoint we can fetch +the related tick-level information by first looking up a mapping +@'InternalBreakpointId' -> 'BreakpointId'@. See `internalBreakIdToBreakId` +-} + +-------------------------------------------------------------------------------- +-- * Internal breakpoint identifiers +-------------------------------------------------------------------------------- + +-- | Internal breakpoint info index +type BreakInfoIndex = Int + +-- | Internal breakpoint identifier +-- +-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation. +-- See Note [Breakpoint identifiers] +data InternalBreakpointId = InternalBreakpointId + { ibi_info_mod :: !Module -- ^ Breakpoint tick module + , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index + } + deriving (Eq, Ord) + +-------------------------------------------------------------------------------- +-- * Internal Mod Breaks +-------------------------------------------------------------------------------- + +-- | Internal mod breaks store the runtime-relevant information of breakpoints. +-- +-- Importantly, it maps 'InternalBreakpointId's to 'CgBreakInfo'. +-- +-- 'InternalModBreaks' are constructed during bytecode generation and stored in +-- 'CompiledByteCode' afterwards. +data InternalModBreaks = InternalModBreaks + { imodBreaks_breakInfo :: IntMap CgBreakInfo + -- ^ Access code-gen time information about a breakpoint, indexed by + -- 'InternalBreakpointId'. + , imodBreaks_module :: !Module + -- ^ Cache the module corresponding to these 'InternalModBreaks' for + -- sanity checks. Don't export it! + } + +-- | Construct an 'InternalModBreaks' +mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> InternalModBreaks +mkInternalModBreaks mod im = InternalModBreaks im mod + +-- | Information about a breakpoint that we know at code-generation time +-- In order to be used, this needs to be hydrated relative to the current HscEnv by +-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for +-- preventing space leaks (see #22530) +data CgBreakInfo + = CgBreakInfo + { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint + , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] + , cgb_resty :: !IfaceType + , cgb_tick_id :: !BreakpointId + -- ^ This field records the original breakpoint tick identifier for this + -- internal breakpoint info. See Note [Breakpoint identifiers]. + } +-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval + +-- | Get an internal breakpoint info by 'InternalBreakpointId' +getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo +getInternalBreak (InternalBreakpointId mod ix) imbs = + assert_modules_match mod (imodBreaks_module imbs) $ + imodBreaks_breakInfo imbs IM.! ix + +-- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId' +addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks +addInternalBreak (InternalBreakpointId mod ix) info imbs = + assert_modules_match mod (imodBreaks_module imbs) $ + imbs{imodBreaks_breakInfo = IM.insert ix info (imodBreaks_breakInfo imbs)} + +-- | Assert that the module in the 'InternalBreakpointId' and in +-- 'InternalModBreaks' match. +assert_modules_match :: Module -> Module -> a -> a +assert_modules_match ibi_mod imbs_mod = + assertPpr (ibi_mod == imbs_mod) + (text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod + <+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod) + +-- TODO: See what Cheng has in . +-- mkCCSArray +-- :: Interp -> Module -> Int -> [Tick] +-- -> IO (Array BreakTickIndex (RemotePtr GHC.Stack.CCS.CostCentre)) +-- mkCCSArray interp modul count entries +-- | interpreterProfiled interp = do +-- let module_str = moduleNameString (moduleName modul) +-- costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries) +-- return (listArray (0,count-1) costcentres) +-- | otherwise = return (listArray (0,-1) []) +-- where +-- mk_one t = (name, src) +-- where name = concat $ intersperse "." $ tick_path t +-- src = renderWithContext defaultSDocContext $ ppr $ tick_loc t +-- , modBreaks_ccs :: !(Array BreakTickIndex (RemotePtr CostCentre)) +-- -- ^ Array pointing to cost centre for each breakpoint +-- ccs <- mkCCSArray interpProfiled mod count entries + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +-- | Fully force an 'InternalModBreaks' value +seqInternalModBreaks :: InternalModBreaks -> () +seqInternalModBreaks InternalModBreaks{..} = + rnf (fmap seqCgBreakInfo imodBreaks_breakInfo) + where + seqCgBreakInfo :: CgBreakInfo -> () + seqCgBreakInfo CgBreakInfo{..} = + rnf cgb_tyvars `seq` + rnf cgb_vars `seq` + rnf cgb_resty `seq` + rnf cgb_tick_id + +instance Outputable InternalBreakpointId where + ppr InternalBreakpointId{..} = + text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index + +instance NFData InternalBreakpointId where + rnf InternalBreakpointId{..} = + rnf ibi_info_mod `seq` rnf ibi_info_index + +instance Outputable CgBreakInfo where + ppr info = text "CgBreakInfo" <+> + parens (ppr (cgb_vars info) <+> + ppr (cgb_resty info) <+> + ppr (cgb_tick_id info)) ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -36,7 +36,6 @@ import GHC.Stack.CCS (CostCentre) import GHC.Stg.Syntax import GHCi.BreakArray (BreakArray) -import GHC.Types.Breakpoint -- ---------------------------------------------------------------------------- -- Bytecode instructions ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -18,15 +18,17 @@ module GHC.ByteCode.Types , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..) , ItblEnv, ItblPtr(..) , AddrEnv, AddrPtr(..) - , CgBreakInfo(..) - , ModBreaks (..) - , CCostCentre , FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag + + -- * Internal Mod Breaks + , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks + -- ** Internal breakpoint identifier + , InternalBreakpointId(..), BreakInfoIndex ) where import GHC.Prelude -import GHC.Types.Breakpoint +import GHC.ByteCode.Breakpoints import GHC.Data.FastString import GHC.Data.FlatBag import GHC.Types.Name @@ -34,7 +36,6 @@ import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Builtin.PrimOps import GHC.Types.SptEntry -import GHC.Types.SrcLoc import GHCi.BreakArray import GHCi.Message import GHCi.RemoteTypes @@ -43,14 +44,10 @@ import Control.DeepSeq import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray ) import Foreign -import Data.Array import Data.ByteString (ByteString) -import Data.IntMap (IntMap) import qualified GHC.Exts.Heap as Heap -import GHC.Stack.CCS import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) -import GHC.Iface.Syntax -import GHC.Unit.Module (Module) +import GHC.HsToCore.Breakpoints (ModBreaks) -- ----------------------------------------------------------------------------- -- Compiled Byte Code @@ -65,8 +62,12 @@ data CompiledByteCode = CompiledByteCode , bc_strs :: [(Name, ByteString)] -- ^ top-level strings (heap allocated) - , bc_breaks :: Maybe ModBreaks - -- ^ breakpoint info (Nothing if breakpoints are disabled) + , bc_breaks :: (Maybe (InternalModBreaks, ModBreaks)) + -- ^ internal breakpoint info (no tick-level 'ModBreaks' if breakpoints are disabled) + -- + -- TODO: If ModBreaks is serialized and reconstructed as part of ModDetails + -- we don't need to keep it here as it can be fetched from the + -- 'HomeModInfo' directly. , bc_spt_entries :: ![SptEntry] -- ^ Static pointer table entries which should be loaded along with the @@ -87,8 +88,8 @@ seqCompiledByteCode :: CompiledByteCode -> () seqCompiledByteCode CompiledByteCode{..} = rnf bc_bcos `seq` rnf bc_itbls `seq` - rnf bc_strs `seq` - rnf (fmap seqModBreaks bc_breaks) + rnf bc_strs + -- TODO: Add here something if new. newtype ByteOff = ByteOff Int deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable) @@ -282,82 +283,9 @@ data BCONPtr instance NFData BCONPtr where rnf x = x `seq` () --- | Information about a breakpoint that we know at code-generation time --- In order to be used, this needs to be hydrated relative to the current HscEnv by --- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for --- preventing space leaks (see #22530) -data CgBreakInfo - = CgBreakInfo - { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint - , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] - , cgb_resty :: !IfaceType - , cgb_tick_id :: !BreakpointId - -- ^ This field records the original breakpoint tick identifier for this - -- internal breakpoint info. See Note [Breakpoint identifiers]. - } --- See Note [Syncing breakpoint info] in GHC.Runtime.Eval - -seqCgBreakInfo :: CgBreakInfo -> () -seqCgBreakInfo CgBreakInfo{..} = - rnf cgb_tyvars `seq` - rnf cgb_vars `seq` - rnf cgb_resty `seq` - rnf cgb_tick_id - instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", ppr (sizeFlatBag lits), text "lits", ppr (sizeFlatBag ptrs), text "ptrs" ] -instance Outputable CgBreakInfo where - ppr info = text "CgBreakInfo" <+> - parens (ppr (cgb_vars info) <+> - ppr (cgb_resty info) <+> - ppr (cgb_tick_id info)) - --- ----------------------------------------------------------------------------- --- Breakpoints - --- | C CostCentre type -data CCostCentre - --- | All the information about the breakpoints for a module -data ModBreaks - = ModBreaks - { modBreaks_flags :: !(ForeignRef BreakArray) - -- ^ The array of flags, one per breakpoint, - -- indicating which breakpoints are enabled. - , modBreaks_locs :: !(Array BreakTickIndex SrcSpan) - -- ^ An array giving the source span of each breakpoint. - , modBreaks_vars :: !(Array BreakTickIndex [OccName]) - -- ^ An array giving the names of the free variables at each breakpoint. - , modBreaks_decls :: !(Array BreakTickIndex [String]) - -- ^ An array giving the names of the declarations enclosing each breakpoint. - -- See Note [Field modBreaks_decls] - , modBreaks_ccs :: !(Array BreakTickIndex (RemotePtr CostCentre)) - -- ^ Array pointing to cost centre for each breakpoint - , modBreaks_breakInfo :: IntMap CgBreakInfo - -- ^ info about each breakpoint from the bytecode generator - , modBreaks_module :: !Module - -- ^ info about the module in which we are setting the breakpoint - } - -seqModBreaks :: ModBreaks -> () -seqModBreaks ModBreaks{..} = - rnf modBreaks_flags `seq` - rnf modBreaks_locs `seq` - rnf modBreaks_vars `seq` - rnf modBreaks_decls `seq` - rnf modBreaks_ccs `seq` - rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq` - rnf modBreaks_module - -{- -Note [Field modBreaks_decls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means: -The breakpoint is in the function called "baz" that is declared in a `let` -or `where` clause of a declaration called "bar", which itself is declared -in a `let` or `where` clause of the top-level function called "foo". --} ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -31,7 +31,6 @@ 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 ) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -72,7 +72,6 @@ import GHC.Iface.Syntax import GHC.Data.FastString import GHC.Data.BooleanFormula qualified as BF(BooleanFormula(..)) -import GHC.Types.Breakpoint import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Id.Make ( noinlineIdName, noinlineConstraintIdName ) ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -97,7 +97,6 @@ import GHC.Unit.Module.Deps import Data.List (partition) import Data.IORef -import Data.Traversable (for) import GHC.Iface.Make (mkRecompUsageInfo) {- @@ -162,13 +161,12 @@ deSugar hsc_env mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, Nothing) - ; modBreaks <- for - [ (i, s) - | i <- hsc_interp hsc_env - , (_, s) <- m_tickInfo - , breakpointsAllowed dflags - ] - $ \(interp, specs) -> mkModBreaks interp mod specs + ; let modBreaks + | Just (_, specs) <- m_tickInfo + , breakpointsAllowed dflags + = Just $ mkModBreaks mod specs + | otherwise + = Nothing ; ds_hpc_info <- case m_tickInfo of Just (orig_file2, ticks) ===================================== compiler/GHC/HsToCore/Breakpoints.hs ===================================== @@ -1,25 +1,67 @@ +-- | Information attached to Breakpoints generated from Ticks +-- +-- The breakpoint information stored in 'ModBreaks' is generated during +-- desugaring from the ticks annotating the source expressions. +-- +-- This information can be queried per-breakpoint using the 'BreakpointId' +-- datatype, which indexes tick-level breakpoint information. +-- +-- 'ModBreaks' and 'BreakpointId's are not to be confused with +-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed +-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'. +-- +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers] module GHC.HsToCore.Breakpoints - ( mkModBreaks + ( -- * ModBreaks + mkModBreaks, ModBreaks(modBreaks_locs, modBreaks_vars, modBreaks_decls) + + -- ** Queries + , getBreakLoc, getBreakVars, getBreakDecls + + -- ** Re-exports BreakpointId + , BreakpointId(..), BreakTickIndex ) where import GHC.Prelude - -import qualified GHC.Runtime.Interpreter as GHCi -import GHC.Runtime.Interpreter.Types -import GHCi.RemoteTypes -import GHC.ByteCode.Types -import GHC.Stack.CCS -import GHC.Unit +import Data.Array import GHC.HsToCore.Ticks (Tick (..)) - import GHC.Data.SizedSeq -import GHC.Utils.Outputable as Outputable +import GHC.Types.SrcLoc (SrcSpan) +import GHC.Types.Name (OccName) +import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..)) +import GHC.Unit.Module (Module) +import GHC.Utils.Outputable +import GHC.Utils.Panic -import Data.List (intersperse) -import Data.Array -import qualified Data.IntMap as IntMap -import GHC.Types.Breakpoint +-------------------------------------------------------------------------------- +-- ModBreaks +-------------------------------------------------------------------------------- + +-- | All the information about the source-relevant breakpoints for a module +-- +-- This information is constructed once during desugaring (with `mkModBreaks`) +-- from breakpoint ticks and fixed/unchanged from there on forward. It could be +-- exported as an abstract datatype because it should never be updated after +-- construction, only queried. +-- +-- The arrays can be indexed using the int in the corresponding 'BreakpointId' +-- (i.e. the 'BreakpointId' whose 'Module' matches the 'Module' corresponding +-- to these 'ModBreaks') with the accessors 'modBreaks_locs', 'modBreaks_vars', +-- and 'modBreaks_decls'. +data ModBreaks + = ModBreaks + { modBreaks_locs :: !(Array BreakTickIndex SrcSpan) + -- ^ An array giving the source span of each breakpoint. + , modBreaks_vars :: !(Array BreakTickIndex [OccName]) + -- ^ An array giving the names of the free variables at each breakpoint. + , modBreaks_decls :: !(Array BreakTickIndex [String]) + -- ^ An array giving the names of the declarations enclosing each breakpoint. + -- See Note [Field modBreaks_decls] + , modBreaks_module :: !Module + -- ^ The module to which this ModBreaks is associated. + -- We cache this here for internal sanity checks (don't export it!). + } -- | Initialize memory for breakpoint data that is shared between the bytecode -- generator and the interpreter. @@ -28,38 +70,48 @@ import GHC.Types.Breakpoint -- generator needs to encode this information for each expression, the data is -- allocated remotely in GHCi's address space and passed to the codegen as -- foreign pointers. -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks -mkModBreaks interp mod extendedMixEntries - = do - let count = fromIntegral $ sizeSS extendedMixEntries +mkModBreaks :: Module -> SizedSeq Tick -> ModBreaks +mkModBreaks modl extendedMixEntries + = let count = fromIntegral $ sizeSS extendedMixEntries entries = ssElts extendedMixEntries - - breakArray <- GHCi.newBreakArray interp count - ccs <- mkCCSArray interp mod count entries - let - locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] - varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] - declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] - return $ ModBreaks - { modBreaks_flags = breakArray - , modBreaks_locs = locsTicks + locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] + varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] + declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] + in ModBreaks + { modBreaks_locs = locsTicks , modBreaks_vars = varsTicks , modBreaks_decls = declsTicks - , modBreaks_ccs = ccs - , modBreaks_breakInfo = IntMap.empty - , modBreaks_module = mod + , modBreaks_module = modl } -mkCCSArray - :: Interp -> Module -> Int -> [Tick] - -> IO (Array BreakTickIndex (RemotePtr GHC.Stack.CCS.CostCentre)) -mkCCSArray interp modul count entries - | GHCi.interpreterProfiled interp = do - let module_str = moduleNameString (moduleName modul) - costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries) - return (listArray (0,count-1) costcentres) - | otherwise = return (listArray (0,-1) []) - where - mk_one t = (name, src) - where name = concat $ intersperse "." $ tick_path t - src = renderWithContext defaultSDocContext $ ppr $ tick_loc t +-- | Get the source span for this breakpoint +getBreakLoc :: BreakpointId -> ModBreaks -> SrcSpan +getBreakLoc (BreakpointId bid_mod ix) mbs = + assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_locs mbs ! ix + +-- | Get the vars for this breakpoint +getBreakVars :: BreakpointId -> ModBreaks -> [OccName] +getBreakVars (BreakpointId bid_mod ix) mbs = + assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_vars mbs ! ix + +-- | Get the decls for this breakpoint +getBreakDecls :: BreakpointId -> ModBreaks -> [String] +getBreakDecls (BreakpointId bid_mod ix) mbs = + assert_modules_match bid_mod (modBreaks_module mbs) $ modBreaks_decls mbs ! ix + +-- | Assert that the module in the 'BreakpointId' and in 'ModBreaks' match. +assert_modules_match :: Module -> Module -> a -> a +assert_modules_match bid_mod mbs_mod = + assertPpr (bid_mod == mbs_mod) + (text "Tried to query the ModBreaks of module" <+> ppr mbs_mod + <+> text "with a BreakpointId for module" <+> ppr bid_mod) + +{- +Note [Field modBreaks_decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means: +The breakpoint is in the function called "baz" that is declared in a `let` +or `where` clause of a declaration called "bar", which itself is declared +in a `let` or `where` clause of the top-level function called "foo". +-} + ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -55,7 +55,6 @@ import Data.Bifunctor (second) import Data.List.NonEmpty (NonEmpty (..)) import Data.Set (Set) import qualified Data.Set as Set -import GHC.Types.Breakpoint (BreakpointId(..)) {- ************************************************************************ ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -56,7 +56,6 @@ 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 @@ -75,6 +74,7 @@ import GHC.Types.Avail import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic +import GHC.Types.Tickish import GHC.Unit.Module import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc ===================================== compiler/GHC/Runtime/Debugger/Breakpoints.hs ===================================== @@ -22,7 +22,6 @@ import GHC.Driver.Monad import GHC.Driver.Session.Inspect import GHC.Runtime.Eval import GHC.Runtime.Eval.Utils -import GHC.Types.Breakpoint import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Unit.Module ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -705,6 +705,7 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 } {- Note [Syncing breakpoint info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ROMES:TODO: Update To display the values of the free variables for a single breakpoint, the function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` pulls out the information from the fields `modBreaks_breakInfo` and ===================================== compiler/GHC/Runtime/Eval/Types.hs ===================================== @@ -17,17 +17,18 @@ import GHC.Prelude import GHCi.RemoteTypes import GHCi.Message (EvalExpr, ResumeContext) +import GHC.ByteCode.Types (InternalBreakpointId(..)) import GHC.Driver.Config (EvalStep(..)) import GHC.Types.Id import GHC.Types.Name import GHC.Types.TyThing -import GHC.Types.Breakpoint import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Utils.Exception import Data.Word import GHC.Stack.CCS +import GHC.Types.Tickish (BreakpointId) data ExecOptions = ExecOptions ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -28,11 +28,10 @@ module GHC.Runtime.Interpreter , whereFrom , getModBreaks , readModBreaks + , readModBreaksMaybe , seqHValue , evalBreakpointToId , internalBreakIdToBreakId - , interpreterDynamic - , interpreterProfiled -- * The object-code linker , initObjLinker @@ -77,9 +76,10 @@ import GHCi.Message import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) -import GHC.Types.Breakpoint -import GHC.ByteCode.Types +import GHC.HsToCore.Breakpoints +import GHC.ByteCode.Breakpoints +import GHC.ByteCode.Types import GHC.Linker.Types import GHC.Data.Maybe @@ -123,7 +123,6 @@ import qualified GHC.Unit.Home.Graph as HUG -- Standard libraries import GHC.Exts -import qualified Data.IntMap as IntMap {- Note [Remote GHCi] ~~~~~~~~~~~~~~~~~~ @@ -434,9 +433,8 @@ evalBreakpointToId eval_break = -- See also Note [Breakpoint identifiers] internalBreakIdToBreakId :: HomeUnitGraph -> InternalBreakpointId -> IO BreakpointId internalBreakIdToBreakId hug ibi = do - ModBreaks{modBreaks_breakInfo} <- readModBreaks hug (ibi_info_mod ibi) - let CgBreakInfo{cgb_tick_id} = expectJust $ - IntMap.lookup (ibi_info_index ibi) modBreaks_breakInfo + (imbs, _) <- readModBreaks hug (ibi_info_mod ibi) + let CgBreakInfo{cgb_tick_id} = getInternalBreak ibi imbs return cgb_tick_id -- | Process the result of a Seq or ResumeSeq message. #2950 @@ -467,7 +465,7 @@ handleSeqHValueStatus interp unit_env eval_status = -- Nothing case - should not occur! We should have the appropriate -- breakpoint information Nothing -> nothing_case - Just modbreaks -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi + Just (_, modbreaks) -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! bi_tick_index bi -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do @@ -747,10 +745,13 @@ wormholeRef interp _r = case interpInstance interp of ExternalInterp {} -> throwIO (InstallationError "this operation requires -fno-external-interpreter") --- ----------------------------------------------------------------------------- --- Misc utils +-------------------------------------------------------------------------------- +-- * Finding breakpoint information +-------------------------------------------------------------------------------- -getModBreaks :: HomeModInfo -> Maybe ModBreaks +-- | Get the breakpoint information from the ByteCode object associated to this +-- 'HomeModInfo'. +getModBreaks :: HomeModInfo -> Maybe (InternalModBreaks, ModBreaks) getModBreaks hmi | Just linkable <- homeModInfoByteCode hmi, -- The linkable may have 'DotO's as well; only consider BCOs. See #20570. @@ -759,33 +760,18 @@ getModBreaks hmi | otherwise = Nothing -- probably object code --- | Read the 'ModBreaks' of the given home 'Module' from the 'HomeUnitGraph'. -readModBreaks :: HomeUnitGraph -> Module -> IO ModBreaks -readModBreaks hug mod = - expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug +-- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module' +-- from the 'HomeUnitGraph'. +readModBreaks :: HomeUnitGraph -> Module -> IO (InternalModBreaks, ModBreaks) +readModBreaks hug mod = expectJust <$> readModBreaksMaybe hug mod + +readModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe (InternalModBreaks, ModBreaks)) +readModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug + +-- ----------------------------------------------------------------------------- +-- Misc utils fromEvalResult :: EvalResult a -> IO a fromEvalResult (EvalException e) = throwIO (fromSerializableException e) fromEvalResult (EvalSuccess a) = return a --- | Interpreter uses Profiling way -interpreterProfiled :: Interp -> Bool -interpreterProfiled interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> hostIsProfiled -#endif - ExternalInterp ext -> case ext of - ExtIServ i -> iservConfProfiled (interpConfig i) - ExtJS {} -> False -- we don't support profiling yet in the JS backend - ExtWasm i -> wasmInterpProfiled $ interpConfig i - --- | Interpreter uses Dynamic way -interpreterDynamic :: Interp -> Bool -interpreterDynamic interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> hostIsDynamic -#endif - ExternalInterp ext -> case ext of - ExtIServ i -> iservConfDynamic (interpConfig i) - ExtJS {} -> False -- dynamic doesn't make sense for JS - ExtWasm {} -> True -- wasm dyld can only load dynamic code ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -24,7 +24,8 @@ module GHC.Runtime.Interpreter.Types , interpSymbolSuffix , eliminateInterpSymbol , interpretedInterpSymbol - + , interpreterProfiled + , interpreterDynamic -- * IServ , IServ @@ -136,6 +137,28 @@ data ExtInterpInstance c = ExtInterpInstance -- ^ Instance specific extra fields } +-- | Interpreter uses Profiling way +interpreterProfiled :: Interp -> Bool +interpreterProfiled interp = case interpInstance interp of +#if defined(HAVE_INTERNAL_INTERPRETER) + InternalInterp -> hostIsProfiled +#endif + ExternalInterp ext -> case ext of + ExtIServ i -> iservConfProfiled (interpConfig i) + ExtJS {} -> False -- we don't support profiling yet in the JS backend + ExtWasm i -> wasmInterpProfiled $ interpConfig i + +-- | Interpreter uses Dynamic way +interpreterDynamic :: Interp -> Bool +interpreterDynamic interp = case interpInstance interp of +#if defined(HAVE_INTERNAL_INTERPRETER) + InternalInterp -> hostIsDynamic +#endif + ExternalInterp ext -> case ext of + ExtIServ i -> iservConfDynamic (interpConfig i) + ExtJS {} -> False -- dynamic doesn't make sense for JS + ExtWasm {} -> True -- wasm dyld can only load dynamic code + ------------------------ -- JS Stuff ------------------------ ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -4,13 +4,14 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DerivingVia #-} -- -- (c) The University of Glasgow 2002-2006 -- -- | GHC.StgToByteCode: Generate bytecode from STG -module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen) where +module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen ) where import GHC.Prelude @@ -70,7 +71,8 @@ import GHC.Data.OrdList import GHC.Data.Maybe import GHC.Types.Tickish import GHC.Types.SptEntry -import GHC.Types.Breakpoint +import GHC.HsToCore.Breakpoints +import GHC.ByteCode.Breakpoints import Data.List ( genericReplicate, intersperse , partition, scanl', sortBy, zip4, zip6 ) @@ -98,6 +100,10 @@ import GHC.Stg.Syntax import qualified Data.IntSet as IntSet import GHC.CoreToIface +import Control.Monad.IO.Class +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.State (StateT) + -- ----------------------------------------------------------------------------- -- Generating byte code for a complete module @@ -131,9 +137,15 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries "Proto-BCOs" FormatByteCode (vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos))) - let mod_breaks = case modBreaks of - Nothing -> Nothing - Just mb -> Just mb{ modBreaks_breakInfo = breakInfo } + let all_mod_breaks = case mb_modBreaks of + Just modBreaks -> Just (modBreaks, internalBreaks) + Nothing -> Nothing + -- no modBreaks, thus drop all + -- internalBreaks? Will we ever want to have internal breakpoints in + -- a module for which we're not doing breakpoints at all? probably + -- not? + -- TODO: Consider always returning InternalBreaks; + -- TODO: Consider making ModBreaks a SUM that can be empty instead of using Maybe. cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries -- Squash space leaks in the CompiledByteCode. This is really @@ -314,7 +326,7 @@ schemeTopBind (id, rhs) -- because mkConAppCode treats nullary constructor applications -- by just re-using the single top-level definition. So -- for the worker itself, we must allocate it directly. - -- ioToBc (putStrLn $ "top level BCO") + -- liftIO (putStrLn $ "top level BCO") pure (mkProtoBCO platform add_bco_name (getName id) (toOL [PACK data_con 0, RETURN P]) (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-}) @@ -395,32 +407,27 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do code <- schemeE d 0 p rhs hsc_env <- getHscEnv current_mod <- getCurrentModule - mb_current_mod_breaks <- getCurrentModBreaks - case mb_current_mod_breaks of - -- if we're not generating ModBreaks for this module for some reason, we - -- can't store breakpoint occurrence information. + liftIO (readModBreaksMaybe (hsc_HUG hsc_env) current_mod) >>= \case Nothing -> pure code - Just current_mod_breaks -> break_info hsc_env (bi_tick_mod tick_id) current_mod mb_current_mod_breaks >>= \case - Nothing -> pure code - Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = _tick_mod, modBreaks_ccs = cc_arr} -> do - platform <- profilePlatform <$> getProfile - let idOffSets = getVarOffSets platform d p fvs - ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) - toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) - toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) - breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id + Just ModBreaks {modBreaks_flags = breaks, modBreaks_ccs = cc_arr} -> do + platform <- profilePlatform <$> getProfile + let idOffSets = getVarOffSets platform d p fvs + ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) + toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) + toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) + breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id - let info_mod = modBreaks_module current_mod_breaks - infox <- newBreakInfo breakInfo + let info_mod = current_mod + infox <- newBreakInfo breakInfo - let cc | Just interp <- hsc_interp hsc_env - , interpreterProfiled interp - = cc_arr ! bi_tick_index tick_id - | otherwise = toRemotePtr nullPtr + let cc | Just interp <- hsc_interp hsc_env + , interpreterProfiled interp + = cc_arr ! bi_tick_index tick_id + | otherwise = toRemotePtr nullPtr - breakInstr = BRK_FUN breaks (InternalBreakpointId info_mod infox) cc + breakInstr = BRK_FUN breaks (InternalBreakpointId info_mod infox) cc - return $ breakInstr `consOL` code + return $ breakInstr `consOL` code schemeER_wrk d p rhs = schemeE d 0 p rhs -- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module @@ -452,7 +459,7 @@ break_info hsc_env mod current_mod current_mod_breaks | mod == current_mod = pure current_mod_breaks | otherwise - = ioToBc (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case + = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case Just hp -> pure $ getModBreaks hp Nothing -> pure Nothing @@ -2630,57 +2637,33 @@ typeArgReps platform = map (toArgRep platform) . typePrimRep -- ----------------------------------------------------------------------------- -- The bytecode generator's monad +-- | Read only environment for generating ByteCode +data BcM_Env + = BcM_Env + { bcm_hsc_env :: HscEnv + , bcm_module :: Module -- current module (for breakpoints) + , bcm_mod_breaks :: Maybe ModBreaks -- this module's ModBreaks + } + data BcM_State = BcM_State - { bcm_hsc_env :: HscEnv - , thisModule :: Module -- current module (for breakpoints) - , nextlabel :: Word32 -- for generating local labels - , modBreaks :: Maybe ModBreaks -- info about breakpoints - - , breakInfo :: IntMap CgBreakInfo -- ^ Info at breakpoint occurrence. - -- Indexed with breakpoint *info* index. - -- See Note [Breakpoint identifiers] - -- in GHC.Types.Breakpoint - , breakInfoIdx :: !Int -- ^ Next index for breakInfo array + { nextlabel :: !Word32 -- ^ For generating local labels + , breakInfoIdx :: !Int -- ^ Next index for breakInfo array + , internalBreaks :: InternalModBreaks + -- ^ Info at breakpoints occurrences. Indexed with + -- 'InternalBreakpointId'. See Note [Breakpoint identifiers] in + -- GHC.ByteCode.Breakpoints. } -newtype BcM r = BcM (BcM_State -> IO (BcM_State, r)) deriving (Functor) - -ioToBc :: IO a -> BcM a -ioToBc io = BcM $ \st -> do - x <- io - return (st, x) +newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (BcM_State, r)) + deriving (Functor, Applicative, Monad, MonadIO) + via (ReaderT BcM_Env (StateT BcM_State IO)) runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (BcM_State, r) runBc hsc_env this_mod modBreaks (BcM m) - = m (BcM_State hsc_env this_mod 0 modBreaks IntMap.empty 0) - -thenBc :: BcM a -> (a -> BcM b) -> BcM b -thenBc (BcM expr) cont = BcM $ \st0 -> do - (st1, q) <- expr st0 - let BcM k = cont q - (st2, r) <- k st1 - return (st2, r) - -thenBc_ :: BcM a -> BcM b -> BcM b -thenBc_ (BcM expr) (BcM cont) = BcM $ \st0 -> do - (st1, _) <- expr st0 - (st2, r) <- cont st1 - return (st2, r) - -returnBc :: a -> BcM a -returnBc result = BcM $ \st -> (return (st, result)) - -instance Applicative BcM where - pure = returnBc - (<*>) = ap - (*>) = thenBc_ - -instance Monad BcM where - (>>=) = thenBc - (>>) = (*>) + = m (BcM_Env hsc_env this_mod modBreaks) (BcM_State 0 0 (mkInternalModBreaks this_mod mempty)) instance HasDynFlags BcM where getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st)) @@ -2710,20 +2693,18 @@ getLabelsBc n = BcM $ \st -> let ctr = nextlabel st in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1]) -newBreakInfo :: CgBreakInfo -> BcM Int -newBreakInfo info = BcM $ \st -> +newBreakInfo :: CgBreakInfo -> BcM InternalBreakpointId +newBreakInfo info = BcM $ \env st -> let ix = breakInfoIdx st + ibi = InternalBreakpointId (bcm_module env) ix st' = st - { breakInfo = IntMap.insert ix info (breakInfo st) - , breakInfoIdx = ix + 1 - } - in return (st', ix) + { internalBreaks = addInternalBreak ibi info (internalBreaks st) + , breakInfoIdx = ix + 1 + } + in return (st', ibi) getCurrentModule :: BcM Module getCurrentModule = BcM $ \st -> return (st, thisModule st) -getCurrentModBreaks :: BcM (Maybe ModBreaks) -getCurrentModBreaks = BcM $ \st -> return (st, modBreaks st) - tickFS :: FastString tickFS = fsLit "ticked" ===================================== compiler/GHC/Types/Breakpoint.hs deleted ===================================== @@ -1,77 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- | Breakpoint related types -module GHC.Types.Breakpoint - ( BreakpointId (..) - , InternalBreakpointId (..) - , BreakTickIndex, BreakInfoIndex - ) -where - -import Control.DeepSeq -import GHC.Prelude -import GHC.Unit.Module -import GHC.Utils.Outputable -import Data.Data (Data) - --- | Breakpoint tick index -type BreakTickIndex = Int - --- | Internal breakpoint info index -type BreakInfoIndex = Int - --- | Breakpoint identifier. --- --- See Note [Breakpoint identifiers] -data BreakpointId = BreakpointId - { bi_tick_mod :: !Module -- ^ Breakpoint tick module - , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index - } - deriving (Eq, Ord, Data) - --- | Internal breakpoint identifier --- --- See Note [Breakpoint identifiers] -data InternalBreakpointId = InternalBreakpointId - { ibi_info_mod :: !Module -- ^ Breakpoint tick module - , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index - } - deriving (Eq, Ord) - --- Note [Breakpoint identifiers] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- ROMES:TODO: UPDATE NOTE --- Before optimization a breakpoint is identified uniquely with a tick module --- and a tick index. See BreakpointId. A tick module contains an array, indexed --- with the tick indexes, which indicates breakpoint status. --- --- When we generate ByteCode, we collect information for every breakpoint at --- their *occurrence sites* (see CgBreakInfo in GHC.ByteCode.Types) and these info --- are stored in the ModIface of the occurrence module. Because of inlining, we --- can't reuse the tick index to uniquely identify an occurrence; because of --- cross-module inlining, we can't assume that the occurrence module is the same --- as the tick module (#24712). --- --- 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. - --------------------------------------------------------------------------------- --- Instances --------------------------------------------------------------------------------- - -instance Outputable BreakpointId where - ppr BreakpointId{..} = - text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index - -instance Outputable InternalBreakpointId where - ppr InternalBreakpointId{..} = - text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index - -instance NFData BreakpointId where - rnf BreakpointId{..} = - rnf bi_tick_mod `seq` rnf bi_tick_index - -instance NFData InternalBreakpointId where - rnf InternalBreakpointId{..} = - rnf ibi_info_mod `seq` rnf ibi_info_index ===================================== compiler/GHC/Types/Tickish.hs ===================================== @@ -21,11 +21,15 @@ module GHC.Types.Tickish ( isProfTick, TickishPlacement(..), tickishPlace, - tickishContains + tickishContains, + + -- * Breakpoint tick identifiers + BreakpointId(..), BreakTickIndex ) where import GHC.Prelude import GHC.Data.FastString +import Control.DeepSeq import GHC.Core.Type @@ -40,8 +44,7 @@ import GHC.Utils.Panic import Language.Haskell.Syntax.Extension ( NoExtField ) import Data.Data -import GHC.Utils.Outputable (Outputable (ppr), text) -import GHC.Types.Breakpoint +import GHC.Utils.Outputable (Outputable (ppr), text, (<+>)) {- ********************************************************************* * * @@ -171,6 +174,33 @@ deriving instance Eq (GenTickish 'TickishPassCmm) deriving instance Ord (GenTickish 'TickishPassCmm) deriving instance Data (GenTickish 'TickishPassCmm) +-------------------------------------------------------------------------------- +-- Tick breakpoint index +-------------------------------------------------------------------------------- + +-- | Breakpoint tick index +type BreakTickIndex = Int + +-- | Breakpoint identifier. +-- +-- Indexes into the structures in the @'ModBreaks'@ created during desugaring +-- (after inserting the breakpoint ticks in the expressions). +-- See Note [Breakpoint identifiers] +data BreakpointId = BreakpointId + { bi_tick_mod :: !Module -- ^ Breakpoint tick module + , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index + } + deriving (Eq, Ord, Data) + +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 + +-------------------------------------------------------------------------------- -- | A "counting tick" (where tickishCounts is True) is one that -- counts evaluations in some way. We cannot discard a counting tick, ===================================== compiler/GHC/Unit/External.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Unit.Module.ModIface import GHC.Core.FamInstEnv import GHC.Core.InstEnv ( InstEnv, emptyInstEnv ) import GHC.Core.Opt.ConstantFold -import GHC.Core.Rules ( RuleBase, mkRuleBase) +import GHC.Core.Rules ( RuleBase, mkRuleBase ) import GHC.Types.Annotations ( AnnEnv, emptyAnnEnv ) import GHC.Types.CompleteMatch ===================================== compiler/GHC/Unit/Module/ModGuts.hs ===================================== @@ -7,7 +7,7 @@ where import GHC.Prelude -import GHC.ByteCode.Types +import GHC.HsToCore.Breakpoints import GHC.ForeignSrcLang import GHC.Hs ===================================== compiler/ghc.cabal.in ===================================== @@ -223,6 +223,7 @@ Library GHC.Builtin.Uniques GHC.Builtin.Utils GHC.ByteCode.Asm + GHC.ByteCode.Breakpoints GHC.ByteCode.InfoTable GHC.ByteCode.Instr GHC.ByteCode.Linker @@ -892,7 +893,6 @@ Library GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic - GHC.Types.Breakpoint GHC.Types.CompleteMatch GHC.Types.CostCentre GHC.Types.CostCentre.State View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2578af8a2a622f6e0990e7001ad7ae2... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2578af8a2a622f6e0990e7001ad7ae2... You're receiving this email because of your account on gitlab.haskell.org.