{-# LANGUAGE RecordWildCards #-}

-- | Information attached to Breakpoints generated from Ticks
--
-- The breakpoint information stored in 'ModBreaks' is generated during
-- desugaring from the ticks annotating the source expressions.
--
-- This information can be queried per-breakpoint using the 'BreakpointId'
-- datatype, which indexes tick-level breakpoint information.
--
-- 'ModBreaks' and 'BreakpointId's are not to be confused with
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
  ( -- * ModBreaks
    mkModBreaks, ModBreaks(..), modBreaks_locs

    -- ** Re-exports BreakpointId
  , BreakpointId(..), BreakTickIndex
  ) where

import GHC.Prelude
import Data.Array

import GHC.HsToCore.Ticks (Tick (..))
import GHC.Data.SizedSeq
import GHC.Types.SrcLoc (SrcSpan)
import GHC.Types.Name (OccName)
import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..))
import GHC.Unit.Module (Module)
import GHC.Utils.Binary
import GHC.Utils.Outputable
import Data.List (intersperse)
import Data.Coerce

--------------------------------------------------------------------------------
-- ModBreaks
--------------------------------------------------------------------------------

-- | All the information about the source-relevant breakpoints for a module
--
-- This information is constructed once during desugaring (with `mkModBreaks`)
-- from breakpoint ticks and fixed/unchanged from there on forward. It could be
-- exported as an abstract datatype because it should never be updated after
-- construction, only queried.
--
-- The arrays can be indexed using the int in the corresponding 'BreakpointId'
-- (i.e. the 'BreakpointId' whose 'Module' matches the 'Module' corresponding
-- to these 'ModBreaks') with the accessors 'modBreaks_locs', 'modBreaks_vars',
-- and 'modBreaks_decls'.
data ModBreaks
   = ModBreaks
   { ModBreaks -> Array BreakTickIndex BinSrcSpan
modBreaks_locs_   :: !(Array BreakTickIndex BinSrcSpan)
        -- ^ An array giving the source span of each breakpoint.
   , ModBreaks -> Array BreakTickIndex [OccName]
modBreaks_vars   :: !(Array BreakTickIndex [OccName])
        -- ^ An array giving the names of the free variables at each breakpoint.
   , ModBreaks -> Array BreakTickIndex [String]
modBreaks_decls  :: !(Array BreakTickIndex [String])
        -- ^ An array giving the names of the declarations enclosing each breakpoint.
        -- See Note [Field modBreaks_decls]
   , ModBreaks -> Array BreakTickIndex (String, String)
modBreaks_ccs    :: !(Array BreakTickIndex (String, String))
        -- ^ Array pointing to cost centre info for each breakpoint;
        -- actual 'CostCentre' allocation is done at link-time.
   , ModBreaks -> Module
modBreaks_module :: !Module
        -- ^ The module to which this ModBreaks is associated.
        -- We also cache this here for internal sanity checks.
   }

modBreaks_locs :: ModBreaks -> Array BreakTickIndex SrcSpan
modBreaks_locs :: ModBreaks -> Array BreakTickIndex SrcSpan
modBreaks_locs = Array BreakTickIndex BinSrcSpan -> Array BreakTickIndex SrcSpan
forall a b. Coercible a b => a -> b
coerce (Array BreakTickIndex BinSrcSpan -> Array BreakTickIndex SrcSpan)
-> (ModBreaks -> Array BreakTickIndex BinSrcSpan)
-> ModBreaks
-> Array BreakTickIndex SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModBreaks -> Array BreakTickIndex BinSrcSpan
modBreaks_locs_

-- | Initialize memory for breakpoint data that is shared between the bytecode
-- generator and the interpreter.
--
-- Since GHCi and the RTS need to interact with breakpoint data and the bytecode
-- generator needs to encode this information for each expression, the data is
-- allocated remotely in GHCi's address space and passed to the codegen as
-- foreign pointers.
mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -}
            -> Module -> SizedSeq Tick -> ModBreaks
mkModBreaks :: Bool -> Module -> SizedSeq Tick -> ModBreaks
mkModBreaks Bool
interpreterProfiled Module
modl SizedSeq Tick
extendedMixEntries
  = let count :: BreakTickIndex
count = Word -> BreakTickIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> BreakTickIndex) -> Word -> BreakTickIndex
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
        locsTicks :: Array BreakTickIndex BinSrcSpan
locsTicks  = (BreakTickIndex, BreakTickIndex)
-> [BinSrcSpan] -> Array BreakTickIndex BinSrcSpan
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (BreakTickIndex
0,BreakTickIndex
countBreakTickIndex -> BreakTickIndex -> BreakTickIndex
forall a. Num a => a -> a -> a
-BreakTickIndex
1) [ SrcSpan -> BinSrcSpan
BinSrcSpan (Tick -> SrcSpan
tick_loc  Tick
t) | Tick
t <- [Tick]
entries ]
        varsTicks :: Array BreakTickIndex [OccName]
varsTicks  = (BreakTickIndex, BreakTickIndex)
-> [[OccName]] -> Array BreakTickIndex [OccName]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (BreakTickIndex
0,BreakTickIndex
countBreakTickIndex -> BreakTickIndex -> BreakTickIndex
forall a. Num a => a -> a -> a
-BreakTickIndex
1) [ Tick -> [OccName]
tick_ids  Tick
t | Tick
t <- [Tick]
entries ]
        declsTicks :: Array BreakTickIndex [String]
declsTicks = (BreakTickIndex, BreakTickIndex)
-> [[String]] -> Array BreakTickIndex [String]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (BreakTickIndex
0,BreakTickIndex
countBreakTickIndex -> BreakTickIndex -> BreakTickIndex
forall a. Num a => a -> a -> a
-BreakTickIndex
1) [ Tick -> [String]
tick_path Tick
t | Tick
t <- [Tick]
entries ]
        ccs :: Array BreakTickIndex (String, String)
ccs
          | Bool
interpreterProfiled =
              (BreakTickIndex, BreakTickIndex)
-> [(String, String)] -> Array BreakTickIndex (String, String)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray
                (BreakTickIndex
0, BreakTickIndex
count BreakTickIndex -> BreakTickIndex -> BreakTickIndex
forall a. Num a => a -> a -> a
- BreakTickIndex
1)
                [ ( [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,
                    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
                  )
                | Tick
t <- [Tick]
entries
                ]
          | Bool
otherwise = (BreakTickIndex, BreakTickIndex)
-> [(String, String)] -> Array BreakTickIndex (String, String)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (BreakTickIndex
0, -BreakTickIndex
1) []
     in ModBreaks
      { modBreaks_locs_ :: Array BreakTickIndex BinSrcSpan
modBreaks_locs_   = Array BreakTickIndex BinSrcSpan
locsTicks
      , modBreaks_vars :: Array BreakTickIndex [OccName]
modBreaks_vars   = Array BreakTickIndex [OccName]
varsTicks
      , modBreaks_decls :: Array BreakTickIndex [String]
modBreaks_decls  = Array BreakTickIndex [String]
declsTicks
      , modBreaks_ccs :: Array BreakTickIndex (String, String)
modBreaks_ccs    = Array BreakTickIndex (String, String)
ccs
      , modBreaks_module :: Module
modBreaks_module = Module
modl
      }

{-
Note [Field modBreaks_decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means:
The breakpoint is in the function called "baz" that is declared in a `let`
or `where` clause of a declaration called "bar", which itself is declared
in a `let` or `where` clause of the top-level function called "foo".
-}

instance Binary ModBreaks where
  get :: ReadBinHandle -> IO ModBreaks
get ReadBinHandle
bh = Array BreakTickIndex BinSrcSpan
-> Array BreakTickIndex [OccName]
-> Array BreakTickIndex [String]
-> Array BreakTickIndex (String, String)
-> Module
-> ModBreaks
ModBreaks (Array BreakTickIndex BinSrcSpan
 -> Array BreakTickIndex [OccName]
 -> Array BreakTickIndex [String]
 -> Array BreakTickIndex (String, String)
 -> Module
 -> ModBreaks)
-> IO (Array BreakTickIndex BinSrcSpan)
-> IO
     (Array BreakTickIndex [OccName]
      -> Array BreakTickIndex [String]
      -> Array BreakTickIndex (String, String)
      -> Module
      -> ModBreaks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO (Array BreakTickIndex BinSrcSpan)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO
  (Array BreakTickIndex [OccName]
   -> Array BreakTickIndex [String]
   -> Array BreakTickIndex (String, String)
   -> Module
   -> ModBreaks)
-> IO (Array BreakTickIndex [OccName])
-> IO
     (Array BreakTickIndex [String]
      -> Array BreakTickIndex (String, String) -> Module -> ModBreaks)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO (Array BreakTickIndex [OccName])
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO
  (Array BreakTickIndex [String]
   -> Array BreakTickIndex (String, String) -> Module -> ModBreaks)
-> IO (Array BreakTickIndex [String])
-> IO
     (Array BreakTickIndex (String, String) -> Module -> ModBreaks)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO (Array BreakTickIndex [String])
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (Array BreakTickIndex (String, String) -> Module -> ModBreaks)
-> IO (Array BreakTickIndex (String, String))
-> IO (Module -> ModBreaks)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO (Array BreakTickIndex (String, String))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh IO (Module -> ModBreaks) -> IO Module -> IO ModBreaks
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadBinHandle -> IO Module
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh

  put_ :: WriteBinHandle -> ModBreaks -> IO ()
put_ WriteBinHandle
bh ModBreaks {Array BreakTickIndex [String]
Array BreakTickIndex [OccName]
Array BreakTickIndex (String, String)
Array BreakTickIndex BinSrcSpan
Module
modBreaks_vars :: ModBreaks -> Array BreakTickIndex [OccName]
modBreaks_decls :: ModBreaks -> Array BreakTickIndex [String]
modBreaks_locs_ :: ModBreaks -> Array BreakTickIndex BinSrcSpan
modBreaks_ccs :: ModBreaks -> Array BreakTickIndex (String, String)
modBreaks_module :: ModBreaks -> Module
modBreaks_locs_ :: Array BreakTickIndex BinSrcSpan
modBreaks_vars :: Array BreakTickIndex [OccName]
modBreaks_decls :: Array BreakTickIndex [String]
modBreaks_ccs :: Array BreakTickIndex (String, String)
modBreaks_module :: Module
..} =
    WriteBinHandle -> Array BreakTickIndex BinSrcSpan -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Array BreakTickIndex BinSrcSpan
modBreaks_locs_
      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Array BreakTickIndex [OccName] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Array BreakTickIndex [OccName]
modBreaks_vars
      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Array BreakTickIndex [String] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Array BreakTickIndex [String]
modBreaks_decls
      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Array BreakTickIndex (String, String) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Array BreakTickIndex (String, String)
modBreaks_ccs
      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Module
modBreaks_module