{-# LANGUAGE RecordWildCards #-}
module GHC.ByteCode.Breakpoints
(
InternalModBreaks(..), CgBreakInfo(..)
, mkInternalModBreaks, imodBreaks_module
, InternalBreakpointId(..), BreakInfoIndex
, getInternalBreak
, getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
, getBreakSourceId
, seqInternalModBreaks
)
where
import GHC.Prelude
import GHC.Types.SrcLoc
import GHC.Types.Name.Occurrence
import Control.DeepSeq
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import GHC.HsToCore.Breakpoints
import GHC.Iface.Syntax
import GHC.Unit.Module (Module)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.Array
type BreakInfoIndex = Int
data InternalBreakpointId = InternalBreakpointId
{ InternalBreakpointId -> Module
ibi_info_mod :: !Module
, InternalBreakpointId -> BreakInfoIndex
ibi_info_index :: !BreakInfoIndex
}
deriving (InternalBreakpointId -> InternalBreakpointId -> Bool
(InternalBreakpointId -> InternalBreakpointId -> Bool)
-> (InternalBreakpointId -> InternalBreakpointId -> Bool)
-> Eq InternalBreakpointId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalBreakpointId -> InternalBreakpointId -> Bool
== :: InternalBreakpointId -> InternalBreakpointId -> Bool
$c/= :: InternalBreakpointId -> InternalBreakpointId -> Bool
/= :: InternalBreakpointId -> InternalBreakpointId -> Bool
Eq, Eq InternalBreakpointId
Eq InternalBreakpointId =>
(InternalBreakpointId -> InternalBreakpointId -> Ordering)
-> (InternalBreakpointId -> InternalBreakpointId -> Bool)
-> (InternalBreakpointId -> InternalBreakpointId -> Bool)
-> (InternalBreakpointId -> InternalBreakpointId -> Bool)
-> (InternalBreakpointId -> InternalBreakpointId -> Bool)
-> (InternalBreakpointId
-> InternalBreakpointId -> InternalBreakpointId)
-> (InternalBreakpointId
-> InternalBreakpointId -> InternalBreakpointId)
-> Ord InternalBreakpointId
InternalBreakpointId -> InternalBreakpointId -> Bool
InternalBreakpointId -> InternalBreakpointId -> Ordering
InternalBreakpointId
-> InternalBreakpointId -> InternalBreakpointId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InternalBreakpointId -> InternalBreakpointId -> Ordering
compare :: InternalBreakpointId -> InternalBreakpointId -> Ordering
$c< :: InternalBreakpointId -> InternalBreakpointId -> Bool
< :: InternalBreakpointId -> InternalBreakpointId -> Bool
$c<= :: InternalBreakpointId -> InternalBreakpointId -> Bool
<= :: InternalBreakpointId -> InternalBreakpointId -> Bool
$c> :: InternalBreakpointId -> InternalBreakpointId -> Bool
> :: InternalBreakpointId -> InternalBreakpointId -> Bool
$c>= :: InternalBreakpointId -> InternalBreakpointId -> Bool
>= :: InternalBreakpointId -> InternalBreakpointId -> Bool
$cmax :: InternalBreakpointId
-> InternalBreakpointId -> InternalBreakpointId
max :: InternalBreakpointId
-> InternalBreakpointId -> InternalBreakpointId
$cmin :: InternalBreakpointId
-> InternalBreakpointId -> InternalBreakpointId
min :: InternalBreakpointId
-> InternalBreakpointId -> InternalBreakpointId
Ord)
data InternalModBreaks = InternalModBreaks
{ InternalModBreaks -> IntMap CgBreakInfo
imodBreaks_breakInfo :: !(IntMap CgBreakInfo)
, InternalModBreaks -> ModBreaks
imodBreaks_modBreaks :: !ModBreaks
}
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
mkInternalModBreaks Module
mod IntMap CgBreakInfo
im ModBreaks
mbs =
Bool -> SDoc -> InternalModBreaks -> InternalModBreaks
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== ModBreaks -> Module
modBreaks_module ModBreaks
mbs)
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructing InternalModBreaks with the ModBreaks of a different module!") (InternalModBreaks -> InternalModBreaks)
-> InternalModBreaks -> InternalModBreaks
forall a b. (a -> b) -> a -> b
$
IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks
InternalModBreaks IntMap CgBreakInfo
im ModBreaks
mbs
imodBreaks_module :: InternalModBreaks -> Module
imodBreaks_module :: InternalModBreaks -> Module
imodBreaks_module = ModBreaks -> Module
modBreaks_module (ModBreaks -> Module)
-> (InternalModBreaks -> ModBreaks) -> InternalModBreaks -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalModBreaks -> ModBreaks
imodBreaks_modBreaks
data CgBreakInfo
= CgBreakInfo
{ CgBreakInfo -> [IfaceTvBndr]
cgb_tyvars :: ![IfaceTvBndr]
, CgBreakInfo -> [Maybe (IfaceIdBndr, Word)]
cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, CgBreakInfo -> IfaceType
cgb_resty :: !IfaceType
, CgBreakInfo -> BreakpointId
cgb_tick_id :: !BreakpointId
}
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId Module
mod BreakInfoIndex
ix) InternalModBreaks
imbs =
Module -> Module -> CgBreakInfo -> CgBreakInfo
forall a. Module -> Module -> a -> a
assert_modules_match Module
mod (InternalModBreaks -> Module
imodBreaks_module InternalModBreaks
imbs) (CgBreakInfo -> CgBreakInfo) -> CgBreakInfo -> CgBreakInfo
forall a b. (a -> b) -> a -> b
$
InternalModBreaks -> IntMap CgBreakInfo
imodBreaks_breakInfo InternalModBreaks
imbs IntMap CgBreakInfo -> BreakInfoIndex -> CgBreakInfo
forall a. IntMap a -> BreakInfoIndex -> a
IM.! BreakInfoIndex
ix
assert_modules_match :: Module -> Module -> a -> a
assert_modules_match :: forall a. Module -> Module -> a -> a
assert_modules_match Module
ibi_mod Module
imbs_mod =
Bool -> SDoc -> a -> a
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Module
ibi_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
imbs_mod)
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Tried to query the InternalModBreaks of module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
imbs_mod
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with an InternalBreakpointId for module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
ibi_mod)
getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
getBreakSourceId (InternalBreakpointId Module
ibi_mod BreakInfoIndex
ibi_ix) InternalModBreaks
imbs =
Module -> Module -> BreakpointId -> BreakpointId
forall a. Module -> Module -> a -> a
assert_modules_match Module
ibi_mod (InternalModBreaks -> Module
imodBreaks_module InternalModBreaks
imbs) (BreakpointId -> BreakpointId) -> BreakpointId -> BreakpointId
forall a b. (a -> b) -> a -> b
$
let cgb :: CgBreakInfo
cgb = InternalModBreaks -> IntMap CgBreakInfo
imodBreaks_breakInfo InternalModBreaks
imbs IntMap CgBreakInfo -> BreakInfoIndex -> CgBreakInfo
forall a. IntMap a -> BreakInfoIndex -> a
IM.! BreakInfoIndex
ibi_ix
in CgBreakInfo -> BreakpointId
cgb_tick_id CgBreakInfo
cgb
getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc :: (Module -> IO ModBreaks)
-> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
getBreakLoc = (ModBreaks -> Array BreakInfoIndex SrcSpan)
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO SrcSpan
forall a.
(ModBreaks -> Array BreakInfoIndex a)
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO a
getBreakXXX ModBreaks -> Array BreakInfoIndex SrcSpan
modBreaks_locs
getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars :: (Module -> IO ModBreaks)
-> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
getBreakVars = (ModBreaks -> Array BreakInfoIndex [OccName])
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO [OccName]
forall a.
(ModBreaks -> Array BreakInfoIndex a)
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO a
getBreakXXX ModBreaks -> Array BreakInfoIndex [OccName]
modBreaks_vars
getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls :: (Module -> IO ModBreaks)
-> InternalBreakpointId -> InternalModBreaks -> IO [String]
getBreakDecls = (ModBreaks -> Array BreakInfoIndex [String])
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO [String]
forall a.
(ModBreaks -> Array BreakInfoIndex a)
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO a
getBreakXXX ModBreaks -> Array BreakInfoIndex [String]
modBreaks_decls
getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS :: (Module -> IO ModBreaks)
-> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
getBreakCCS = (ModBreaks -> Array BreakInfoIndex (String, String))
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO (String, String)
forall a.
(ModBreaks -> Array BreakInfoIndex a)
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO a
getBreakXXX ModBreaks -> Array BreakInfoIndex (String, String)
modBreaks_ccs
getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
getBreakXXX :: forall a.
(ModBreaks -> Array BreakInfoIndex a)
-> (Module -> IO ModBreaks)
-> InternalBreakpointId
-> InternalModBreaks
-> IO a
getBreakXXX ModBreaks -> Array BreakInfoIndex a
view Module -> IO ModBreaks
lookupModule (InternalBreakpointId Module
ibi_mod BreakInfoIndex
ibi_ix) InternalModBreaks
imbs =
Module -> Module -> IO a -> IO a
forall a. Module -> Module -> a -> a
assert_modules_match Module
ibi_mod (InternalModBreaks -> Module
imodBreaks_module InternalModBreaks
imbs) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
let cgb :: CgBreakInfo
cgb = InternalModBreaks -> IntMap CgBreakInfo
imodBreaks_breakInfo InternalModBreaks
imbs IntMap CgBreakInfo -> BreakInfoIndex -> CgBreakInfo
forall a. IntMap a -> BreakInfoIndex -> a
IM.! BreakInfoIndex
ibi_ix
case CgBreakInfo -> BreakpointId
cgb_tick_id CgBreakInfo
cgb of
BreakpointId{Module
bi_tick_mod :: Module
bi_tick_mod :: BreakpointId -> Module
bi_tick_mod, BreakInfoIndex
bi_tick_index :: BreakInfoIndex
bi_tick_index :: BreakpointId -> BreakInfoIndex
bi_tick_index}
| Module
bi_tick_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
ibi_mod
-> do
let these_mbs :: ModBreaks
these_mbs = InternalModBreaks -> ModBreaks
imodBreaks_modBreaks InternalModBreaks
imbs
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ ModBreaks -> Array BreakInfoIndex a
view ModBreaks
these_mbs Array BreakInfoIndex a -> BreakInfoIndex -> a
forall i e. Ix i => Array i e -> i -> e
! BreakInfoIndex
bi_tick_index
| Bool
otherwise
-> do
other_mbs <- Module -> IO ModBreaks
lookupModule Module
bi_tick_mod
return $ view other_mbs ! bi_tick_index
seqInternalModBreaks :: InternalModBreaks -> ()
seqInternalModBreaks :: InternalModBreaks -> ()
seqInternalModBreaks InternalModBreaks{IntMap CgBreakInfo
ModBreaks
imodBreaks_breakInfo :: InternalModBreaks -> IntMap CgBreakInfo
imodBreaks_modBreaks :: InternalModBreaks -> ModBreaks
imodBreaks_breakInfo :: IntMap CgBreakInfo
imodBreaks_modBreaks :: ModBreaks
..} =
IntMap () -> ()
forall a. NFData a => a -> ()
rnf ((CgBreakInfo -> ()) -> IntMap CgBreakInfo -> IntMap ()
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CgBreakInfo -> ()
seqCgBreakInfo IntMap CgBreakInfo
imodBreaks_breakInfo)
where
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo CgBreakInfo{[Maybe (IfaceIdBndr, Word)]
[IfaceTvBndr]
IfaceType
BreakpointId
cgb_tyvars :: CgBreakInfo -> [IfaceTvBndr]
cgb_vars :: CgBreakInfo -> [Maybe (IfaceIdBndr, Word)]
cgb_resty :: CgBreakInfo -> IfaceType
cgb_tick_id :: CgBreakInfo -> BreakpointId
cgb_tyvars :: [IfaceTvBndr]
cgb_vars :: [Maybe (IfaceIdBndr, Word)]
cgb_resty :: IfaceType
cgb_tick_id :: BreakpointId
..} =
[IfaceTvBndr] -> ()
forall a. NFData a => a -> ()
rnf [IfaceTvBndr]
cgb_tyvars () -> () -> ()
forall a b. a -> b -> b
`seq`
[Maybe (IfaceIdBndr, Word)] -> ()
forall a. NFData a => a -> ()
rnf [Maybe (IfaceIdBndr, Word)]
cgb_vars () -> () -> ()
forall a b. a -> b -> b
`seq`
IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
cgb_resty () -> () -> ()
forall a b. a -> b -> b
`seq`
BreakpointId -> ()
forall a. NFData a => a -> ()
rnf BreakpointId
cgb_tick_id
instance Outputable InternalBreakpointId where
ppr :: InternalBreakpointId -> SDoc
ppr InternalBreakpointId{BreakInfoIndex
Module
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_index :: InternalBreakpointId -> BreakInfoIndex
ibi_info_mod :: Module
ibi_info_index :: BreakInfoIndex
..} =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InternalBreakpointId" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
ibi_info_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> BreakInfoIndex -> SDoc
forall a. Outputable a => a -> SDoc
ppr BreakInfoIndex
ibi_info_index
instance NFData InternalBreakpointId where
rnf :: InternalBreakpointId -> ()
rnf InternalBreakpointId{BreakInfoIndex
Module
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_index :: InternalBreakpointId -> BreakInfoIndex
ibi_info_mod :: Module
ibi_info_index :: BreakInfoIndex
..} =
Module -> ()
forall a. NFData a => a -> ()
rnf Module
ibi_info_mod () -> () -> ()
forall a b. a -> b -> b
`seq` BreakInfoIndex -> ()
forall a. NFData a => a -> ()
rnf BreakInfoIndex
ibi_info_index
instance Outputable CgBreakInfo where
ppr :: CgBreakInfo -> SDoc
ppr CgBreakInfo
info = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CgBreakInfo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([Maybe (IfaceIdBndr, Word)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CgBreakInfo -> [Maybe (IfaceIdBndr, Word)]
cgb_vars CgBreakInfo
info) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CgBreakInfo -> IfaceType
cgb_resty CgBreakInfo
info) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
BreakpointId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CgBreakInfo -> BreakpointId
cgb_tick_id CgBreakInfo
info))