module GHC.HsToCore.Breakpoints ( mkModBreaks ) 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 GHC.HsToCore.Ticks (Tick (..)) import GHC.Data.SizedSeq import GHC.Utils.Outputable as Outputable import Data.List (intersperse) import Data.Array mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks mkModBreaks Interp interp Module mod SizedSeq Tick extendedMixEntries = do let count :: BreakIndex count = forall a b. (Integral a, Num b) => a -> b fromIntegral forall a b. (a -> b) -> a -> b $ forall a. SizedSeq a -> Word sizeSS SizedSeq Tick extendedMixEntries entries :: [Tick] entries = forall a. SizedSeq a -> [a] ssElts SizedSeq Tick extendedMixEntries ForeignRef BreakArray breakArray <- Interp -> BreakIndex -> IO (ForeignRef BreakArray) GHCi.newBreakArray Interp interp BreakIndex count Array BreakIndex (RemotePtr CostCentre) ccs <- Interp -> Module -> BreakIndex -> [Tick] -> IO (Array BreakIndex (RemotePtr CostCentre)) mkCCSArray Interp interp Module mod BreakIndex count [Tick] entries let locsTicks :: Array BreakIndex SrcSpan locsTicks = forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countforall a. Num a => a -> a -> a -BreakIndex 1) [ Tick -> SrcSpan tick_loc Tick t | Tick t <- [Tick] entries ] varsTicks :: Array BreakIndex [OccName] varsTicks = forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countforall a. Num a => a -> a -> a -BreakIndex 1) [ Tick -> [OccName] tick_ids Tick t | Tick t <- [Tick] entries ] declsTicks :: Array BreakIndex [String] declsTicks = forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countforall a. Num a => a -> a -> a -BreakIndex 1) [ Tick -> [String] tick_path Tick t | Tick t <- [Tick] entries ] forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ ModBreaks emptyModBreaks { modBreaks_flags :: ForeignRef BreakArray modBreaks_flags = ForeignRef BreakArray breakArray , modBreaks_locs :: Array BreakIndex SrcSpan modBreaks_locs = Array BreakIndex SrcSpan locsTicks , modBreaks_vars :: Array BreakIndex [OccName] modBreaks_vars = Array BreakIndex [OccName] varsTicks , modBreaks_decls :: Array BreakIndex [String] modBreaks_decls = Array BreakIndex [String] declsTicks , modBreaks_ccs :: Array BreakIndex (RemotePtr CostCentre) modBreaks_ccs = Array BreakIndex (RemotePtr CostCentre) ccs } mkCCSArray :: Interp -> Module -> Int -> [Tick] -> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre)) mkCCSArray :: Interp -> Module -> BreakIndex -> [Tick] -> IO (Array BreakIndex (RemotePtr CostCentre)) mkCCSArray Interp interp Module modul BreakIndex count [Tick] entries | Interp -> Bool GHCi.interpreterProfiled Interp interp = do let module_str :: String module_str = ModuleName -> String moduleNameString (forall unit. GenModule unit -> ModuleName moduleName Module modul) [RemotePtr CostCentre] costcentres <- Interp -> String -> [(String, String)] -> IO [RemotePtr CostCentre] GHCi.mkCostCentres Interp interp String module_str (forall a b. (a -> b) -> [a] -> [b] map Tick -> (String, String) mk_one [Tick] entries) forall (m :: * -> *) a. Monad m => a -> m a return (forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countforall a. Num a => a -> a -> a -BreakIndex 1) [RemotePtr CostCentre] costcentres) | Bool otherwise = forall (m :: * -> *) a. Monad m => a -> m a return (forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,-BreakIndex 1) []) where mk_one :: Tick -> (String, String) mk_one Tick t = (String name, String src) where name :: String name = forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat forall a b. (a -> b) -> a -> b $ forall a. a -> [a] -> [a] intersperse String "." forall a b. (a -> b) -> a -> b $ Tick -> [String] tick_path Tick t src :: String src = SDocContext -> SDoc -> String renderWithContext SDocContext defaultSDocContext forall a b. (a -> b) -> a -> b $ forall a. Outputable a => a -> SDoc ppr forall a b. (a -> b) -> a -> b $ Tick -> SrcSpan tick_loc Tick t