    {-# LINE 1 "libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc" #-}
    {-# LANGUAGE CPP, MagicHash #-}

    module GHC.Exts.Heap.Utils (
        dataConNames
        ) where

    import Prelude -- See note [Why do we import Prelude here?]
    import GHC.Exts.Heap.Constants
    import GHC.Exts.Heap.InfoTable

    import Data.Char
    import Data.List (intercalate)
    import Foreign
    import GHC.CString
    import GHC.Exts

    {- To find the string in the constructor's info table we need to consider
          the layout of info tables relative to the entry code for a closure.

          An info table can be next to the entry code for the closure, or it can
          be separate. The former (faster) is used in registerised versions of ghc,
          and the latter (portable) is for non-registerised versions.

          The diagrams below show where the string is to be found relative to
          the normal info table of the closure.

          1) Tables next to code:

             --------------
             |            |   <- pointer to the start of the string
             --------------
             |            |   <- the (start of the) info table structure
             |            |
             |            |
             --------------
             | entry code |
             |    ....    |

             In this case the pointer to the start of the string can be found in
             the memory location _one word before_ the first entry in the normal info
             table.

          2) Tables NOT next to code:

                                     --------------
             info table structure -> |     *------------------> --------------
                                     |            |             | entry code |
                                     |            |             |    ....    |
                                     --------------
             ptr to start of str ->  |            |
                                     --------------

             In this case the pointer to the start of the string can be found
             in the memory location: info_table_ptr + info_table_size
    -}

    -- Given a ptr to an 'StgInfoTable' for a data constructor
    -- return (Package, Module, Name)
    dataConNames :: Ptr StgInfoTable -> IO (String, String, String)
    dataConNames :: Ptr StgInfoTable -> IO (String, String, String)
    dataConNames Ptr StgInfoTable
    ptr = do
        conDescAddress <- IO (Ptr Word8)
    getConDescAddress
        pure $ parse conDescAddress
      where
        -- Retrieve the con_desc field address pointing to
        -- 'Package:Module.Name' string
        getConDescAddress :: IO (Ptr Word8)
        getConDescAddress :: IO (Ptr Word8)
    getConDescAddress

    {-# LINE 71 "libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc" #-}
          = do
            offsetToString <- peek (ptr `plusPtr` negate wORD_SIZE)
            pure $ (ptr `plusPtr` stdInfoTableSizeB)
                        `plusPtr` fromIntegral (offsetToString :: Int32)

    {-# LINE 78 "libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc" #-}

        stdInfoTableSizeW :: Int
        -- The size of a standard info table varies with profiling/ticky etc,
        -- so we can't get it from Constants
        -- It must vary in sync with mkStdInfoTable
        stdInfoTableSizeW :: Int
    stdInfoTableSizeW
          = Int
    size_fixed Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    size_prof
          where
            size_fixed :: Int
    size_fixed = Int
    2  -- layout, type
    #if defined(PROFILING)
            size_prof = 2
    #else
            size_prof :: Int
    size_prof = Int
    0
    #endif

        stdInfoTableSizeB :: Int
        stdInfoTableSizeB :: Int
    stdInfoTableSizeB = Int
    stdInfoTableSizeW Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    wORD_SIZE

    -- parsing names is a little bit fiddly because we have a string in the form:
    -- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").
    -- Thus we split at the leftmost colon and the rightmost occurrence of the dot.
    -- It would be easier if the string was in the form pkg:A.B.C:foo, but alas
    -- this is not the conventional way of writing Haskell names. We stick with
    -- convention, even though it makes the parsing code more troublesome.
    -- Warning: this code assumes that the string is well formed.
    parse :: Ptr Word8 -> (String, String, String)
    parse :: Ptr Word8 -> (String, String, String)
    parse (Ptr Addr#
    addr) = if Bool -> Bool
    not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Bool) -> [Int] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >Int
    0) ([Int] -> Bool) -> ([String] -> [Int]) -> [String] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Int) -> [String] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([String] -> Bool) -> [String] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [String
    p,String
    m,String
    occ]
                         then ([], [], String
    input)
                         else (String
    p, String
    m, String
    occ)
      where
        input :: String
    input = Addr# -> String
    unpackCStringUtf8# Addr#
    addr
        (String
    p, String
    rest1) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ':') String
    input
        (String
    m, String
    occ)
            = (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    modWords, String
    occWord)
            where
            ([String]
    modWords, String
    occWord) = [String] -> String -> ([String], String)
    parseModOcc [] (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 String
    rest1)
        -- We only look for dots if str could start with a module name,
        -- i.e. if it starts with an upper case character.
        -- Otherwise we might think that "X.:->" is the module name in
        -- "X.:->.+", whereas actually "X" is the module name and
        -- ":->.+" is a constructor name.
        parseModOcc :: [String] -> String -> ([String], String)
        parseModOcc :: [String] -> String -> ([String], String)
    parseModOcc [String]
    acc str :: String
    str@(Char
    c : String
    _)
            | Char -> Bool
    isUpper Char
    c =
                case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') String
    str of
                    (String
    top, []) -> ([String]
    acc, String
    top)
                    (String
    top, Char
    _:String
    bot) -> [String] -> String -> ([String], String)
    parseModOcc (String
    top String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    acc) String
    bot
        parseModOcc [String]
    acc String
    str = ([String]
    acc, String
    str)