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 = Word -> BreakIndex forall a b. (Integral a, Num b) => a -> b fromIntegral (Word -> BreakIndex) -> Word -> BreakIndex forall a b. (a -> b) -> a -> b $ SizedSeq Tick -> Word forall a. SizedSeq a -> Word sizeSS SizedSeq Tick extendedMixEntries entries :: [Tick] entries = SizedSeq Tick -> [Tick] 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 = (BreakIndex, BreakIndex) -> [SrcSpan] -> Array BreakIndex SrcSpan forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countBreakIndex -> BreakIndex -> BreakIndex forall a. Num a => a -> a -> a -BreakIndex 1) [ Tick -> SrcSpan tick_loc Tick t | Tick t <- [Tick] entries ] varsTicks :: Array BreakIndex [OccName] varsTicks = (BreakIndex, BreakIndex) -> [[OccName]] -> Array BreakIndex [OccName] forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countBreakIndex -> BreakIndex -> BreakIndex forall a. Num a => a -> a -> a -BreakIndex 1) [ Tick -> [OccName] tick_ids Tick t | Tick t <- [Tick] entries ] declsTicks :: Array BreakIndex [String] declsTicks = (BreakIndex, BreakIndex) -> [[String]] -> Array BreakIndex [String] forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countBreakIndex -> BreakIndex -> BreakIndex forall a. Num a => a -> a -> a -BreakIndex 1) [ Tick -> [String] tick_path Tick t | Tick t <- [Tick] entries ] ModBreaks -> IO ModBreaks forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (ModBreaks -> IO ModBreaks) -> ModBreaks -> IO ModBreaks forall a b. (a -> b) -> a -> b $ ModBreaks emptyModBreaks { modBreaks_flags = breakArray , modBreaks_locs = locsTicks , modBreaks_vars = varsTicks , modBreaks_decls = declsTicks , modBreaks_ccs = 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 (Module -> ModuleName 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 ((Tick -> (String, String)) -> [Tick] -> [(String, String)] forall a b. (a -> b) -> [a] -> [b] map Tick -> (String, String) mk_one [Tick] entries) Array BreakIndex (RemotePtr CostCentre) -> IO (Array BreakIndex (RemotePtr CostCentre)) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return ((BreakIndex, BreakIndex) -> [RemotePtr CostCentre] -> Array BreakIndex (RemotePtr CostCentre) forall i e. Ix i => (i, i) -> [e] -> Array i e listArray (BreakIndex 0,BreakIndex countBreakIndex -> BreakIndex -> BreakIndex forall a. Num a => a -> a -> a -BreakIndex 1) [RemotePtr CostCentre] costcentres) | Bool otherwise = Array BreakIndex (RemotePtr CostCentre) -> IO (Array BreakIndex (RemotePtr CostCentre)) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return ((BreakIndex, BreakIndex) -> [RemotePtr CostCentre] -> Array BreakIndex (RemotePtr CostCentre) 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 = [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ String -> [String] -> [String] forall a. a -> [a] -> [a] intersperse String "." ([String] -> [String]) -> [String] -> [String] forall a b. (a -> b) -> a -> b $ Tick -> [String] tick_path Tick t src :: String src = SDocContext -> SDoc -> String renderWithContext SDocContext defaultSDocContext (SDoc -> String) -> SDoc -> String forall a b. (a -> b) -> a -> b $ SrcSpan -> SDoc forall a. Outputable a => a -> SDoc ppr (SrcSpan -> SDoc) -> SrcSpan -> SDoc forall a b. (a -> b) -> a -> b $ Tick -> SrcSpan tick_loc Tick t