{-# LANGUAGE RecordWildCards #-}

-- | Breakpoint information constructed during ByteCode generation.
--
-- Specifically, code-generation breakpoints are referred to as "internal
-- breakpoints", the internal breakpoint data for a module is stored in
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
-- See Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
  ( -- * Internal Mod Breaks
    InternalModBreaks(..), CgBreakInfo(..)
  , mkInternalModBreaks

    -- ** Internal breakpoint identifier
  , InternalBreakpointId(..), BreakInfoIndex

    -- * Operations
  , toBreakpointId

    -- ** Internal-level operations
  , getInternalBreak, addInternalBreak

    -- ** Source-level information operations
  , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS

    -- * Utils
  , 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

{-
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
and a tick index. See 'BreakpointId'. A tick module contains an array, indexed
with the tick indexes, which indicates breakpoint status.

When we generate ByteCode, we collect information for every breakpoint at
their *occurrence sites* (see CgBreakInfo) and these info
are stored in the ModIface of the occurrence module. Because of inlining, we
can't reuse the tick index to uniquely identify an occurrence; because of
cross-module inlining, we can't assume that the occurrence module is the same
as the tick module (#24712).

So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
-}

--------------------------------------------------------------------------------
-- * Internal breakpoint identifiers
--------------------------------------------------------------------------------

-- | Internal breakpoint info index
type BreakInfoIndex = Int

-- | Internal breakpoint identifier
--
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
  { InternalBreakpointId -> Module
ibi_tick_mod   :: !Module         -- ^ Breakpoint tick module
  , InternalBreakpointId -> Int
ibi_tick_index :: !Int            -- ^ Breakpoint tick index
  , InternalBreakpointId -> Module
ibi_info_mod   :: !Module         -- ^ Breakpoint tick module
  , InternalBreakpointId -> Int
ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
  }
  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)

toBreakpointId :: InternalBreakpointId -> BreakpointId
toBreakpointId :: InternalBreakpointId -> BreakpointId
toBreakpointId InternalBreakpointId
ibi = BreakpointId
  { bi_tick_mod :: Module
bi_tick_mod   = InternalBreakpointId -> Module
ibi_tick_mod InternalBreakpointId
ibi
  , bi_tick_index :: Int
bi_tick_index = InternalBreakpointId -> Int
ibi_tick_index InternalBreakpointId
ibi
  }

--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------

-- | Internal mod breaks store the runtime-relevant information of breakpoints.
--
-- Importantly, it maps 'InternalBreakpointId's to 'CgBreakInfo'.
--
-- 'InternalModBreaks' are constructed during bytecode generation and stored in
-- 'CompiledByteCode' afterwards.
data InternalModBreaks = InternalModBreaks
      { InternalModBreaks -> IntMap CgBreakInfo
imodBreaks_breakInfo :: !(IntMap CgBreakInfo)
        -- ^ Access code-gen time information about a breakpoint, indexed by
        -- 'InternalBreakpointId'.

      , InternalModBreaks -> ModBreaks
imodBreaks_modBreaks :: !ModBreaks
        -- ^ Store the original ModBreaks for this module, unchanged.
        -- Allows us to query about source-level breakpoint information using
        -- an internal breakpoint id.
      }

-- | Construct an 'InternalModBreaks'
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

-- | Information about a breakpoint that we know at code-generation time
-- In order to be used, this needs to be hydrated relative to the current HscEnv by
-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for
-- preventing space leaks (see #22530)
data CgBreakInfo
   = CgBreakInfo
   { CgBreakInfo -> [IfaceTvBndr]
cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
   , CgBreakInfo -> [Maybe (IfaceIdBndr, Word)]
cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
   , CgBreakInfo -> IfaceType
cgb_resty   :: !IfaceType
   }
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval

-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
getInternalBreak (InternalBreakpointId Module
_ Int
_ Module
info_mod Int
info_ix) InternalModBreaks
imbs =
  Module -> Module -> CgBreakInfo -> CgBreakInfo
forall a. Module -> Module -> a -> a
assert_modules_match Module
info_mod (ModBreaks -> Module
modBreaks_module (ModBreaks -> Module) -> ModBreaks -> Module
forall a b. (a -> b) -> a -> b
$ InternalModBreaks -> ModBreaks
imodBreaks_modBreaks InternalModBreaks
imbs) (CgBreakInfo -> CgBreakInfo) -> CgBreakInfo -> CgBreakInfo
forall a b. (a -> b) -> a -> b
$
    InternalModBreaks -> IntMap CgBreakInfo
imodBreaks_breakInfo InternalModBreaks
imbs IntMap CgBreakInfo -> Int -> CgBreakInfo
forall a. IntMap a -> Int -> a
IM.! Int
info_ix

-- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
addInternalBreak :: InternalBreakpointId
-> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
addInternalBreak (InternalBreakpointId Module
_ Int
_ Module
info_mod Int
info_ix) CgBreakInfo
info InternalModBreaks
imbs =
  Module -> Module -> InternalModBreaks -> InternalModBreaks
forall a. Module -> Module -> a -> a
assert_modules_match Module
info_mod (ModBreaks -> Module
modBreaks_module (ModBreaks -> Module) -> ModBreaks -> Module
forall a b. (a -> b) -> a -> b
$ InternalModBreaks -> ModBreaks
imodBreaks_modBreaks InternalModBreaks
imbs) (InternalModBreaks -> InternalModBreaks)
-> InternalModBreaks -> InternalModBreaks
forall a b. (a -> b) -> a -> b
$
    InternalModBreaks
imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}

-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
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)

--------------------------------------------------------------------------------
-- Tick-level Breakpoint information
--------------------------------------------------------------------------------

-- | Get the source span for this breakpoint
getBreakLoc  :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
getBreakLoc = (ModBreaks -> Array Int SrcSpan)
-> InternalBreakpointId -> InternalModBreaks -> SrcSpan
forall a.
(ModBreaks -> Array Int a)
-> InternalBreakpointId -> InternalModBreaks -> a
getBreakXXX ModBreaks -> Array Int SrcSpan
modBreaks_locs

-- | Get the vars for this breakpoint
getBreakVars  :: InternalBreakpointId -> InternalModBreaks -> [OccName]
getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
getBreakVars = (ModBreaks -> Array Int [OccName])
-> InternalBreakpointId -> InternalModBreaks -> [OccName]
forall a.
(ModBreaks -> Array Int a)
-> InternalBreakpointId -> InternalModBreaks -> a
getBreakXXX ModBreaks -> Array Int [OccName]
modBreaks_vars

-- | Get the decls for this breakpoint
getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
getBreakDecls = (ModBreaks -> Array Int [String])
-> InternalBreakpointId -> InternalModBreaks -> [String]
forall a.
(ModBreaks -> Array Int a)
-> InternalBreakpointId -> InternalModBreaks -> a
getBreakXXX ModBreaks -> Array Int [String]
modBreaks_decls

-- | Get the decls for this breakpoint
getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
getBreakCCS = (ModBreaks -> Array Int (String, String))
-> InternalBreakpointId -> InternalModBreaks -> (String, String)
forall a.
(ModBreaks -> Array Int a)
-> InternalBreakpointId -> InternalModBreaks -> a
getBreakXXX ModBreaks -> Array Int (String, String)
modBreaks_ccs

-- | Internal utility to access a ModBreaks field at a particular breakpoint index
getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
getBreakXXX :: forall a.
(ModBreaks -> Array Int a)
-> InternalBreakpointId -> InternalModBreaks -> a
getBreakXXX ModBreaks -> Array Int a
view (InternalBreakpointId Module
tick_mod Int
tick_id Module
_ Int
_) InternalModBreaks
imbs =
  Module -> Module -> a -> a
forall a. Module -> Module -> a -> a
assert_modules_match Module
tick_mod (ModBreaks -> Module
modBreaks_module (ModBreaks -> Module) -> ModBreaks -> Module
forall a b. (a -> b) -> a -> b
$ InternalModBreaks -> ModBreaks
imodBreaks_modBreaks InternalModBreaks
imbs) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ do
    ModBreaks -> Array Int a
view (InternalModBreaks -> ModBreaks
imodBreaks_modBreaks InternalModBreaks
imbs) Array Int a -> Int -> a
forall i e. Ix i => Array i e -> i -> e
! Int
tick_id

--------------------------------------------------------------------------------
-- Instances
--------------------------------------------------------------------------------

-- | Fully force an 'InternalModBreaks' value
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
cgb_tyvars :: CgBreakInfo -> [IfaceTvBndr]
cgb_vars :: CgBreakInfo -> [Maybe (IfaceIdBndr, Word)]
cgb_resty :: CgBreakInfo -> IfaceType
cgb_tyvars :: [IfaceTvBndr]
cgb_vars :: [Maybe (IfaceIdBndr, Word)]
cgb_resty :: IfaceType
..} =
        [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

instance Outputable InternalBreakpointId where
  ppr :: InternalBreakpointId -> SDoc
ppr InternalBreakpointId{Int
Module
ibi_tick_mod :: InternalBreakpointId -> Module
ibi_tick_index :: InternalBreakpointId -> Int
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_index :: InternalBreakpointId -> Int
ibi_tick_mod :: Module
ibi_tick_index :: Int
ibi_info_mod :: Module
ibi_info_index :: Int
..} =
    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
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
ibi_info_index

instance NFData InternalBreakpointId where
  rnf :: InternalBreakpointId -> ()
rnf InternalBreakpointId{Int
Module
ibi_tick_mod :: InternalBreakpointId -> Module
ibi_tick_index :: InternalBreakpointId -> Int
ibi_info_mod :: InternalBreakpointId -> Module
ibi_info_index :: InternalBreakpointId -> Int
ibi_tick_mod :: Module
ibi_tick_index :: Int
ibi_info_mod :: Module
ibi_info_index :: Int
..} =
    Module -> ()
forall a. NFData a => a -> ()
rnf Module
ibi_info_mod () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
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))