{-# 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.HsToCore.Breakpoints.Types
import GHC.Data.SizedSeq
import GHC.Unit.Module (Module)
import GHC.Utils.Binary
import GHC.Utils.Encoding (utf8EncodeShortByteString)
import GHC.Utils.Outputable
import Data.List (intersperse)

-- | 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 (ShortByteString, ShortByteString)
ccs
          | Bool
interpreterProfiled =
              (BreakTickIndex, BreakTickIndex)
-> [(ShortByteString, ShortByteString)]
-> Array BreakTickIndex (ShortByteString, ShortByteString)
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 -> ShortByteString
utf8EncodeShortByteString (String -> ShortByteString) -> String -> ShortByteString
forall a b. (a -> b) -> a -> b
$ [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,
                    String -> ShortByteString
utf8EncodeShortByteString (String -> ShortByteString) -> String -> ShortByteString
forall a b. (a -> b) -> a -> b
$ 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)
-> [(ShortByteString, ShortByteString)]
-> Array BreakTickIndex (ShortByteString, ShortByteString)
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 (ShortByteString, ShortByteString)
modBreaks_ccs    = Array BreakTickIndex (ShortByteString, ShortByteString)
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".
-}