{-# LINE 1 "libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc" #-}
{-# LANGUAGE CPP, MagicHash #-}
module GHC.Exts.Heap.Utils (
dataConNames
) where
import Prelude
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
dataConNames :: Ptr StgInfoTable -> IO (String, String, String)
dataConNames :: Ptr StgInfoTable -> IO (String, String, String)
dataConNames Ptr StgInfoTable
ptr = do
Ptr Word8
conDescAddress <- IO (Ptr Word8)
getConDescAddress
(String, String, String) -> IO (String, String, String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, String, String) -> IO (String, String, String))
-> (String, String, String) -> IO (String, String, String)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> (String, String, String)
parse Ptr Word8
conDescAddress
where
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
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
#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
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) =
if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
rest1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
then [String] -> String -> ([String], String)
parseModOcc [] []
else [String] -> String -> ([String], String)
parseModOcc [] (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
rest1)
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)