{-# LINE 1 "libraries/base/GHC/InfoProv.hsc" #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.InfoProv
-- Copyright   :  (c) The University of Glasgow 2011
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- Access to GHC's info-table provenance metadata.
--
-- @since 4.18.0.0
-----------------------------------------------------------------------------

module GHC.InfoProv
    ( InfoProv(..)
    , ipLoc
    , ipeProv
    , whereFrom
      -- * Internals
    , InfoProvEnt
    , peekInfoProv
    ) where



import GHC.Base
import GHC.Show
import GHC.Ptr (Ptr(..), plusPtr, nullPtr)
import GHC.Foreign (CString, peekCString)
import GHC.IO.Encoding (utf8)
import Foreign.Storable (peekByteOff)

data InfoProv = InfoProv {
  InfoProv -> String
ipName :: String,
  InfoProv -> String
ipDesc :: String,
  InfoProv -> String
ipTyDesc :: String,
  InfoProv -> String
ipLabel :: 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)

data InfoProvEnt

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

getIPE :: a -> IO (Ptr InfoProvEnt)
getIPE :: forall a. a -> IO (Ptr InfoProvEnt)
getIPE a
obj = (State# RealWorld -> (# State# RealWorld, Ptr InfoProvEnt #))
-> IO (Ptr InfoProvEnt)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Ptr InfoProvEnt #))
 -> IO (Ptr InfoProvEnt))
-> (State# RealWorld -> (# State# RealWorld, Ptr InfoProvEnt #))
-> IO (Ptr InfoProvEnt)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
   case a -> State# RealWorld -> (# State# RealWorld, Addr# #)
forall a d. a -> State# d -> (# State# d, Addr# #)
whereFrom# a
obj State# RealWorld
s of
     (# State# RealWorld
s', Addr#
addr #) -> (# State# RealWorld
s', Addr# -> Ptr InfoProvEnt
forall a. Addr# -> Ptr a
Ptr Addr#
addr #)

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 62 "libraries/base/GHC/InfoProv.hsc" #-}

peekIpName, peekIpDesc, peekIpLabel, 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 65 "libraries/base/GHC/InfoProv.hsc" #-}
peekIpDesc p    =  ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 66 "libraries/base/GHC/InfoProv.hsc" #-}
peekIpLabel p   =  ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 67 "libraries/base/GHC/InfoProv.hsc" #-}
peekIpModule p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 68 "libraries/base/GHC/InfoProv.hsc" #-}
peekIpSrcFile p =  ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p
{-# LINE 69 "libraries/base/GHC/InfoProv.hsc" #-}
peekIpSrcSpan p =  ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 70 "libraries/base/GHC/InfoProv.hsc" #-}
peekIpTyDesc p  =  ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 71 "libraries/base/GHC/InfoProv.hsc" #-}

peekInfoProv :: Ptr InfoProv -> IO InfoProv
peekInfoProv :: Ptr InfoProv -> IO InfoProv
peekInfoProv Ptr InfoProv
infop = do
  String
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
  String
desc <- 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
peekIpDesc Ptr InfoProv
infop
  String
tyDesc <- 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
peekIpTyDesc Ptr InfoProv
infop
  String
label <- 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
peekIpLabel Ptr InfoProv
infop
  String
mod <- 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
peekIpModule Ptr InfoProv
infop
  String
file <- 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
peekIpSrcFile Ptr InfoProv
infop
  String
span <- 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
peekIpSrcSpan Ptr InfoProv
infop
  InfoProv -> IO InfoProv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InfoProv {
      ipName :: String
ipName = String
name,
      ipDesc :: String
ipDesc = String
desc,
      ipTyDesc :: String
ipTyDesc = String
tyDesc,
      ipLabel :: String
ipLabel = String
label,
      ipMod :: String
ipMod = String
mod,
      ipSrcFile :: String
ipSrcFile = String
file,
      ipSrcSpan :: String
ipSrcSpan = String
span
    }

-- | Get information about where a value originated from.
-- This information is stored statically in a binary when `-finfo-table-map` is
-- enabled.  The source positions will be greatly improved by also enabled debug
-- information with `-g3`. Finally you can enable `-fdistinct-constructor-tables` to
-- get more precise information about data constructor allocations.
--
-- The information is collect by looking at the info table address of a specific closure and
-- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think
-- the best source position to describe that info table arose from.
--
-- @since 4.16.0.0
whereFrom :: a -> IO (Maybe InfoProv)
whereFrom :: forall a. a -> IO (Maybe InfoProv)
whereFrom a
obj = do
  Ptr InfoProvEnt
ipe <- a -> IO (Ptr InfoProvEnt)
forall a. a -> IO (Ptr InfoProvEnt)
getIPE a
obj
  -- The primop returns the null pointer in two situations at the moment
  -- 1. The lookup fails for whatever reason
  -- 2. -finfo-table-map is not enabled.
  -- It would be good to distinguish between these two cases somehow.
  if Ptr InfoProvEnt
ipe Ptr InfoProvEnt -> Ptr InfoProvEnt -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr InfoProvEnt
forall a. Ptr a
nullPtr
    then Maybe InfoProv -> IO (Maybe InfoProv)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InfoProv
forall a. Maybe a
Nothing
    else do
      InfoProv
infoProv <- Ptr InfoProv -> IO InfoProv
peekInfoProv (Ptr InfoProvEnt -> Ptr InfoProv
ipeProv Ptr InfoProvEnt
ipe)
      Maybe InfoProv -> IO (Maybe InfoProv)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe InfoProv -> IO (Maybe InfoProv))
-> Maybe InfoProv -> IO (Maybe InfoProv)
forall a b. (a -> b) -> a -> b
$ InfoProv -> Maybe InfoProv
forall a. a -> Maybe a
Just InfoProv
infoProv