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