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
    RemotePtr ModuleName
mod_ptr <- Interp -> ModuleName -> IO (RemotePtr ModuleName)
GHCi.newModuleName Interp
interp (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
    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
                       , modBreaks_module = mod_ptr
                       }

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