{-# 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 (String, fmap, return, unIO, ($), (++), (=<<))
import GHC.Internal.Classes (Eq)
import GHC.Internal.Enum
import GHC.Internal.Maybe (Maybe(..))
import GHC.Internal.Real (fromIntegral)
import GHC.Internal.Types (IO(..))
import GHC.Internal.Word (Word32)
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.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
80)) ((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 60 "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
80)) ((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
(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 67 "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 75 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}

peekIpDesc :: Ptr InfoProv -> IO Word32
peekIpDesc :: Ptr InfoProv -> IO Word32
peekIpDesc Ptr InfoProv
p    =  ((\Ptr InfoProv
hsc_ptr -> Ptr InfoProv -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr InfoProv
hsc_ptr Int
16)) Ptr InfoProv
p
{-# LINE 78 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}

peekIpName, 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
8)) Ptr InfoProv
p
{-# LINE 81 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpLabel p   =  ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 82 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpUnitId p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p
{-# LINE 83 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpModule p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 84 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpSrcFile p =  ((\hsc_ptr -> peekByteOff hsc_ptr 56)) p
{-# LINE 85 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpSrcSpan p =  ((\hsc_ptr -> peekByteOff hsc_ptr 64)) p
{-# LINE 86 "libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc" #-}
peekIpTyDesc p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 87 "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 <- 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 = toEnum $ fromIntegral desc,
      ipTyDesc = tyDesc,
      ipLabel = label,
      ipUnitId = unit_id,
      ipMod = mod,
      ipSrcFile = file,
      ipSrcSpan = span
    }