{-# LINE 1 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}



module GHC.Internal.InfoProv.Types
    ( InfoProv(..)
    , ipLoc
    , ipeProv
    , InfoProvEnt
    , peekInfoProv
    , getIPE
    , StgInfoTable
    , lookupIPE
    ) where

import GHC.Internal.Base
import GHC.Internal.Data.Maybe
import GHC.Internal.Enum
import GHC.Internal.Show (Show)
import GHC.Internal.Ptr (Ptr(..), plusPtr)
import GHC.Internal.Foreign.C.String.Encoding (CString, peekCString)
import GHC.Internal.Foreign.C.Types (CBool(..))
import GHC.Internal.Foreign.Marshal.Alloc (allocaBytes)
import GHC.Internal.IO.Encoding (utf8)
import GHC.Internal.Foreign.Storable (peekByteOff)
import GHC.Internal.ClosureTypes
import GHC.Internal.Text.Read
import GHC.Prim (whereFrom#)

data InfoProv = InfoProv {
  InfoProv -> String
ipName :: String,
  InfoProv -> ClosureType
ipDesc :: ClosureType,
  InfoProv -> String
ipTyDesc :: String,
  InfoProv -> String
ipLabel :: String,
  -- | @since base-4.20.0.0
  InfoProv -> String
ipUnitId :: String,
  InfoProv -> String
ipMod :: String,
  InfoProv -> String
ipSrcFile :: String,
  InfoProv -> String
ipSrcSpan :: String
} deriving (InfoProv -> InfoProv -> Bool
(InfoProv -> InfoProv -> Bool)
-> (InfoProv -> InfoProv -> Bool) -> Eq InfoProv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InfoProv -> InfoProv -> Bool
== :: InfoProv -> InfoProv -> Bool
$c/= :: InfoProv -> InfoProv -> Bool
/= :: InfoProv -> InfoProv -> Bool
Eq, Int -> InfoProv -> ShowS
[InfoProv] -> ShowS
InfoProv -> String
(Int -> InfoProv -> ShowS)
-> (InfoProv -> String) -> ([InfoProv] -> ShowS) -> Show InfoProv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InfoProv -> ShowS
showsPrec :: Int -> InfoProv -> ShowS
$cshow :: InfoProv -> String
show :: InfoProv -> String
$cshowList :: [InfoProv] -> ShowS
showList :: [InfoProv] -> ShowS
Show)

ipLoc :: InfoProv -> String
ipLoc :: InfoProv -> String
ipLoc InfoProv
ipe = InfoProv -> String
ipSrcFile InfoProv
ipe String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ InfoProv -> String
ipSrcSpan InfoProv
ipe

data InfoProvEnt

data StgInfoTable

foreign import ccall "lookupIPE" c_lookupIPE :: Ptr StgInfoTable -> Ptr InfoProvEnt -> IO CBool

lookupIPE :: Ptr StgInfoTable -> IO (Maybe InfoProv)
lookupIPE :: Ptr StgInfoTable -> IO (Maybe InfoProv)
lookupIPE Ptr StgInfoTable
itbl = Int
-> (Ptr InfoProvEnt -> IO (Maybe InfoProv)) -> IO (Maybe InfoProv)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
72)) ((Ptr InfoProvEnt -> IO (Maybe InfoProv)) -> IO (Maybe InfoProv))
-> (Ptr InfoProvEnt -> IO (Maybe InfoProv)) -> IO (Maybe InfoProv)
forall a b. (a -> b) -> a -> b
$ \Ptr InfoProvEnt
p -> do
{-# LINE 57 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
  res <- c_lookupIPE itbl p
  case res of
    1 -> Just `fmap` peekInfoProv (ipeProv p)
    _ -> return Nothing

getIPE :: a -> r -> (Ptr InfoProvEnt -> IO r) -> IO r
getIPE :: forall a r. a -> r -> (Ptr InfoProvEnt -> IO r) -> IO r
getIPE a
obj r
fail Ptr InfoProvEnt -> IO r
k = Int -> (Ptr InfoProvEnt -> IO r) -> IO r
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
72)) ((Ptr InfoProvEnt -> IO r) -> IO r)
-> (Ptr InfoProvEnt -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr InfoProvEnt
p -> (State# RealWorld -> (# State# RealWorld, r #)) -> IO r
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, r #)) -> IO r)
-> (State# RealWorld -> (# State# RealWorld, r #)) -> IO r
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
{-# LINE 64 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
  case whereFrom# obj (unPtr p) s of
    (# s', 1# #) -> unIO (k p) s'
    (# s', _   #) -> (# s', fail #)
  where
    unPtr :: Ptr a -> Addr#
unPtr (Ptr Addr#
p) = Addr#
p

ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
ipeProv Ptr InfoProvEnt
p = ((\Ptr InfoProvEnt
hsc_ptr -> Ptr InfoProvEnt
hsc_ptr Ptr InfoProvEnt -> Int -> Ptr InfoProv
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)) Ptr InfoProvEnt
p
{-# LINE 72 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}

peekIpName, peekIpDesc, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
peekIpName :: Ptr InfoProv -> IO CString
peekIpName Ptr InfoProv
p    =  ((\Ptr InfoProv
hsc_ptr -> Ptr InfoProv -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InfoProv
hsc_ptr Int
0)) Ptr InfoProv
p
{-# LINE 75 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpDesc p    =  ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 76 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpLabel p   =  ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 77 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpUnitId p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 78 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpModule p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p
{-# LINE 79 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpSrcFile p =  ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 80 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpSrcSpan p =  ((\hsc_ptr -> peekByteOff hsc_ptr 56)) p
{-# LINE 81 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpTyDesc p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 82 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}

peekInfoProv :: Ptr InfoProv -> IO InfoProv
peekInfoProv :: Ptr InfoProv -> IO InfoProv
peekInfoProv Ptr InfoProv
infop = do
  name <- TextEncoding -> CString -> IO String
peekCString TextEncoding
utf8 (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr InfoProv -> IO CString
peekIpName Ptr InfoProv
infop
  desc <- peekCString utf8 =<< peekIpDesc infop
  tyDesc <- peekCString utf8 =<< peekIpTyDesc infop
  label <- peekCString utf8 =<< peekIpLabel infop
  unit_id <- peekCString utf8 =<< peekIpUnitId infop
  mod <- peekCString utf8 =<< peekIpModule infop
  file <- peekCString utf8 =<< peekIpSrcFile infop
  span <- peekCString utf8 =<< peekIpSrcSpan infop
  return InfoProv {
      ipName = name,
      -- The INVALID_OBJECT case should be impossible as we
      -- control the C code generating these values.
      ipDesc = maybe INVALID_OBJECT toEnum . readMaybe @Int $ desc,
      ipTyDesc = tyDesc,
      ipLabel = label,
      ipUnitId = unit_id,
      ipMod = mod,
      ipSrcFile = file,
      ipSrcSpan = span
    }