{-# Language TransformListComp, MonadComprehensions #-}
{- |
Module           : Text.LLVM.DebugUtils
Description      : This module interprets the DWARF information associated
                   with a function's argument and return types in order to
                   interpret field name references.
License          : BSD3
Stability        : provisional
Maintainer       : emertens@galois.com
-}
module Text.LLVM.DebugUtils
  ( -- * Definition type analyzer
    Info(..), StructFieldInfo(..), BitfieldInfo(..), UnionFieldInfo(..)
  , computeFunctionTypes, valMdToInfo
  , localVariableNameDeclarations

  -- * Metadata lookup
  , mkMdMap

  -- * Type structure dereference
  , derefInfo
  , fieldIndexByPosition
  , fieldIndexByName

  -- * Info hueristics
  , guessAliasInfo
  , guessTypeInfo

  -- * Function arguments
  , debugInfoArgNames

  -- * Line numbers of definitions
  , debugInfoGlobalLines
  , debugInfoDefineLines
  ) where

import           Control.Applicative    ((<|>))
import           Control.Monad          ((<=<))
import           Data.Bits              (Bits(..))
import           Data.IntMap            (IntMap)
import qualified Data.IntMap as IntMap
import           Data.List              (elemIndex, tails, stripPrefix)
import           Data.Map               (Map)
import qualified Data.Map    as Map
import           Data.Maybe             (fromMaybe, listToMaybe, maybeToList, mapMaybe)
import           Data.Word              (Word16, Word64)
import           Text.LLVM.AST

dbgKind :: String
dbgKind :: String
dbgKind = String
"dbg"

llvmDbgCuKey :: String
llvmDbgCuKey :: String
llvmDbgCuKey = String
"llvm.dbg.cu"

dwarfPointer, dwarfStruct, dwarfTypedef, dwarfUnion, dwarfBasetype,
  dwarfConst, dwarfArray :: Word16
dwarfPointer :: Word16
dwarfPointer  = Word16
0x0f
dwarfStruct :: Word16
dwarfStruct   = Word16
0x13
dwarfTypedef :: Word16
dwarfTypedef  = Word16
0x16
dwarfArray :: Word16
dwarfArray    = Word16
0x01
dwarfUnion :: Word16
dwarfUnion    = Word16
0x17
dwarfBasetype :: Word16
dwarfBasetype = Word16
0x24
dwarfConst :: Word16
dwarfConst    = Word16
0x26

type MdMap = IntMap ValMd

data Info
  = Pointer Info
  | Structure (Maybe String) [StructFieldInfo]
  | Union     (Maybe String) [UnionFieldInfo]
  | Typedef String Info
  | ArrInfo Info
  | BaseType String DIBasicType
  | Unknown
  deriving Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Info -> ShowS
showsPrec :: Int -> Info -> ShowS
$cshow :: Info -> String
show :: Info -> String
$cshowList :: [Info] -> ShowS
showList :: [Info] -> ShowS
Show

-- | Record debug information about a field in a struct type.
data StructFieldInfo = StructFieldInfo
  { StructFieldInfo -> String
sfiName :: String
    -- ^ The field name.
  , StructFieldInfo -> Word64
sfiOffset :: Word64
    -- ^ The field's offset (in bits) from the start of the struct.
  , StructFieldInfo -> Maybe BitfieldInfo
sfiBitfield :: Maybe BitfieldInfo
    -- ^ If this field resides within a bitfield, this is
    -- @'Just' bitfieldInfo@. Otherwise, this is 'Nothing'.
  , StructFieldInfo -> Info
sfiInfo :: Info
    -- ^ The debug 'Info' associated with the field's type.
  } deriving Int -> StructFieldInfo -> ShowS
[StructFieldInfo] -> ShowS
StructFieldInfo -> String
(Int -> StructFieldInfo -> ShowS)
-> (StructFieldInfo -> String)
-> ([StructFieldInfo] -> ShowS)
-> Show StructFieldInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructFieldInfo -> ShowS
showsPrec :: Int -> StructFieldInfo -> ShowS
$cshow :: StructFieldInfo -> String
show :: StructFieldInfo -> String
$cshowList :: [StructFieldInfo] -> ShowS
showList :: [StructFieldInfo] -> ShowS
Show

-- | Record debug information about a field within a bitfield. For example,
-- the following C struct:
--
-- @
-- struct s {
--   int32_t w;
--   uint8_t x1:1;
--   uint8_t x2:2;
--   uint8_t y:1;
--   int32_t z;
-- };
-- @
--
-- Corresponds to the following 'Info':
--
-- @
-- 'Structure'
--   [ 'StructFieldInfo' { 'sfiName' = \"w\"
--                       , 'sfiOffset' = 0
--                       , 'sfiBitfield' = Nothing
--                       , 'sfiInfo' = 'BaseType' \"int32_t\"
--                       }
--   , 'StructFieldInfo' { 'sfiName' = \"x1\"
--                       , 'sfiOffset' = 32
--                       , 'sfiBitfield' = Just ('BitfieldInfo' { 'biFieldSize' = 1
--                                                              , 'biBitfieldOffset' = 32
--                                                              })
--                       , 'sfiInfo' = 'BaseType' \"uint8_t\"
--                       }
--   , 'StructFieldInfo' { 'sfiName' = \"x2\"
--                       , 'sfiOffset' = 33
--                       , 'sfiBitfield' = Just ('BitfieldInfo' { 'biFieldSize' = 2
--                                                              , 'biBitfieldOffset' = 32
--                                                              })
--                       , 'sfiInfo' = BaseType \"uint8_t\"
--                       }
--   , 'StructFieldInfo' { 'sfiName' = \"y\"
--                       , 'sfiOffset' = 35
--                       , 'sfiBitfield' = Just ('BitfieldInfo' { 'biFieldSize' = 1
--                                                              , 'biBitfieldOffset' = 32
--                                                              })
--                       , 'sfiInfo' = 'BaseType' \"uint8_t\"
--                       }
--   , 'StructFieldInfo' { 'sfiName' = \"z\"
--                       , 'sfiOffset' = 64
--                       , 'sfiBitfield' = Nothing
--                       , 'sfiInfo' = BaseType \"int32_t\"
--                       }
--   ]
-- @
--
-- Notice that only @x1@, @x2@, and @y@ have 'BitfieldInfo's, as they are the
-- only fields that were declared with bitfield syntax.
data BitfieldInfo = BitfieldInfo
  { BitfieldInfo -> Word64
biFieldSize :: Word64
    -- ^ The field's size (in bits) within the bitfield. This should not be
    --   confused with the size of the field's declared type. For example, the
    --   'biFieldSize' of the @x1@ field is @1@, despite the fact that its
    --   declared type, @uint8_t@, is otherwise 8 bits in size.
  , BitfieldInfo -> Word64
biBitfieldOffset :: Word64
    -- ^ The bitfield's offset (in bits) from the start of the struct. Note
    --   that for a given field within a bitfield, its 'sfiOffset' is equal to
    --   the 'biBitfieldOffset' plus the 'biFieldSize'.
  } deriving Int -> BitfieldInfo -> ShowS
[BitfieldInfo] -> ShowS
BitfieldInfo -> String
(Int -> BitfieldInfo -> ShowS)
-> (BitfieldInfo -> String)
-> ([BitfieldInfo] -> ShowS)
-> Show BitfieldInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BitfieldInfo -> ShowS
showsPrec :: Int -> BitfieldInfo -> ShowS
$cshow :: BitfieldInfo -> String
show :: BitfieldInfo -> String
$cshowList :: [BitfieldInfo] -> ShowS
showList :: [BitfieldInfo] -> ShowS
Show

-- | Record debug information about a field in a union type.
data UnionFieldInfo = UnionFieldInfo
  { UnionFieldInfo -> String
ufiName :: String
    -- ^ The field name.
  , UnionFieldInfo -> Info
ufiInfo :: Info
    -- ^ The debug 'Info' associated with the field's type.
  } deriving Int -> UnionFieldInfo -> ShowS
[UnionFieldInfo] -> ShowS
UnionFieldInfo -> String
(Int -> UnionFieldInfo -> ShowS)
-> (UnionFieldInfo -> String)
-> ([UnionFieldInfo] -> ShowS)
-> Show UnionFieldInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnionFieldInfo -> ShowS
showsPrec :: Int -> UnionFieldInfo -> ShowS
$cshow :: UnionFieldInfo -> String
show :: UnionFieldInfo -> String
$cshowList :: [UnionFieldInfo] -> ShowS
showList :: [UnionFieldInfo] -> ShowS
Show

-- | Compute an 'IntMap' of the unnamed metadata in a module
mkMdMap :: Module -> IntMap ValMd
mkMdMap :: Module -> IntMap ValMd
mkMdMap Module
m = [(Int, ValMd)] -> IntMap ValMd
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [ (UnnamedMd -> Int
umIndex UnnamedMd
md, UnnamedMd -> ValMd
umValues UnnamedMd
md) | UnnamedMd
md <- Module -> [UnnamedMd]
modUnnamedMd Module
m ]

------------------------------------------------------------------------

getDebugInfo :: MdMap -> ValMd -> Maybe DebugInfo
getDebugInfo :: IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap (ValMdRef Int
i)    = IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap (ValMd -> Maybe DebugInfo) -> Maybe ValMd -> Maybe DebugInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IntMap ValMd -> Maybe ValMd
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i IntMap ValMd
mdMap
getDebugInfo IntMap ValMd
_ (ValMdDebugInfo DebugInfo
di) = DebugInfo -> Maybe DebugInfo
forall a. a -> Maybe a
Just DebugInfo
di
getDebugInfo IntMap ValMd
_ ValMd
_                   = Maybe DebugInfo
forall a. Maybe a
Nothing

getInteger :: MdMap -> ValMd -> Maybe Integer
getInteger :: IntMap ValMd -> ValMd -> Maybe Integer
getInteger IntMap ValMd
mdMap (ValMdRef Int
i)                          = IntMap ValMd -> ValMd -> Maybe Integer
getInteger IntMap ValMd
mdMap (ValMd -> Maybe Integer) -> Maybe ValMd -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IntMap ValMd -> Maybe ValMd
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i IntMap ValMd
mdMap
getInteger IntMap ValMd
_     (ValMdValue (Typed Type
_ (ValInteger Integer
i))) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
getInteger IntMap ValMd
_     ValMd
_                                     = Maybe Integer
forall a. Maybe a
Nothing

getList :: MdMap -> ValMd -> Maybe [Maybe ValMd]
getList :: IntMap ValMd -> ValMd -> Maybe [Maybe ValMd]
getList IntMap ValMd
mdMap (ValMdRef Int
i) = IntMap ValMd -> ValMd -> Maybe [Maybe ValMd]
getList IntMap ValMd
mdMap (ValMd -> Maybe [Maybe ValMd])
-> Maybe ValMd -> Maybe [Maybe ValMd]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IntMap ValMd -> Maybe ValMd
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i IntMap ValMd
mdMap
getList IntMap ValMd
_ (ValMdNode [Maybe ValMd]
di)   = [Maybe ValMd] -> Maybe [Maybe ValMd]
forall a. a -> Maybe a
Just [Maybe ValMd]
di
getList IntMap ValMd
_ ValMd
_                = Maybe [Maybe ValMd]
forall a. Maybe a
Nothing

------------------------------------------------------------------------

valMdToInfo :: MdMap -> ValMd -> Info
valMdToInfo :: IntMap ValMd -> ValMd -> Info
valMdToInfo IntMap ValMd
mdMap ValMd
val =
  Info -> (DebugInfo -> Info) -> Maybe DebugInfo -> Info
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Info
Unknown (IntMap ValMd -> DebugInfo -> Info
debugInfoToInfo IntMap ValMd
mdMap) (IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap ValMd
val)


valMdToInfo' :: MdMap -> Maybe ValMd -> Info
valMdToInfo' :: IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' = Info -> (ValMd -> Info) -> Maybe ValMd -> Info
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Info
Unknown ((ValMd -> Info) -> Maybe ValMd -> Info)
-> (IntMap ValMd -> ValMd -> Info)
-> IntMap ValMd
-> Maybe ValMd
-> Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap ValMd -> ValMd -> Info
valMdToInfo


debugInfoToInfo :: MdMap -> DebugInfo -> Info
debugInfoToInfo :: IntMap ValMd -> DebugInfo -> Info
debugInfoToInfo IntMap ValMd
mdMap (DebugInfoDerivedType DIDerivedType' BlockLabel
dt)
  | DIDerivedType' BlockLabel -> Word16
forall lab. DIDerivedType' lab -> Word16
didtTag DIDerivedType' BlockLabel
dt Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
dwarfPointer  = Info -> Info
Pointer (IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' IntMap ValMd
mdMap (DIDerivedType' BlockLabel -> Maybe ValMd
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtBaseType DIDerivedType' BlockLabel
dt))
  | DIDerivedType' BlockLabel -> Word16
forall lab. DIDerivedType' lab -> Word16
didtTag DIDerivedType' BlockLabel
dt Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
dwarfTypedef  = case DIDerivedType' BlockLabel -> Maybe String
forall lab. DIDerivedType' lab -> Maybe String
didtName DIDerivedType' BlockLabel
dt of
                                    Maybe String
Nothing -> IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' IntMap ValMd
mdMap (DIDerivedType' BlockLabel -> Maybe ValMd
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtBaseType DIDerivedType' BlockLabel
dt)
                                    Just String
nm -> String -> Info -> Info
Typedef String
nm (IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' IntMap ValMd
mdMap (DIDerivedType' BlockLabel -> Maybe ValMd
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtBaseType DIDerivedType' BlockLabel
dt))
  | DIDerivedType' BlockLabel -> Word16
forall lab. DIDerivedType' lab -> Word16
didtTag DIDerivedType' BlockLabel
dt Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
dwarfConst    = IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' IntMap ValMd
mdMap (DIDerivedType' BlockLabel -> Maybe ValMd
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtBaseType DIDerivedType' BlockLabel
dt)
debugInfoToInfo IntMap ValMd
_     (DebugInfoBasicType DIBasicType
bt)
  | DIBasicType -> Word16
dibtTag DIBasicType
bt Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
dwarfBasetype = String -> DIBasicType -> Info
BaseType (DIBasicType -> String
dibtName DIBasicType
bt) DIBasicType
bt
debugInfoToInfo IntMap ValMd
mdMap (DebugInfoCompositeType DICompositeType' BlockLabel
ct)
  | DICompositeType' BlockLabel -> Word16
forall lab. DICompositeType' lab -> Word16
dictTag DICompositeType' BlockLabel
ct Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
dwarfStruct   = Info
-> ([StructFieldInfo] -> Info) -> Maybe [StructFieldInfo] -> Info
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Info
Unknown (Maybe String -> [StructFieldInfo] -> Info
Structure (DICompositeType' BlockLabel -> Maybe String
forall lab. DICompositeType' lab -> Maybe String
dictName DICompositeType' BlockLabel
ct)) (IntMap ValMd
-> DICompositeType' BlockLabel -> Maybe [StructFieldInfo]
getStructFields IntMap ValMd
mdMap DICompositeType' BlockLabel
ct)
  | DICompositeType' BlockLabel -> Word16
forall lab. DICompositeType' lab -> Word16
dictTag DICompositeType' BlockLabel
ct Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
dwarfUnion    = Info
-> ([UnionFieldInfo] -> Info) -> Maybe [UnionFieldInfo] -> Info
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Info
Unknown (Maybe String -> [UnionFieldInfo] -> Info
Union     (DICompositeType' BlockLabel -> Maybe String
forall lab. DICompositeType' lab -> Maybe String
dictName DICompositeType' BlockLabel
ct)) (IntMap ValMd
-> DICompositeType' BlockLabel -> Maybe [UnionFieldInfo]
getUnionFields IntMap ValMd
mdMap DICompositeType' BlockLabel
ct)
  | DICompositeType' BlockLabel -> Word16
forall lab. DICompositeType' lab -> Word16
dictTag DICompositeType' BlockLabel
ct Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
dwarfArray    = Info -> Info
ArrInfo (IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' IntMap ValMd
mdMap (DICompositeType' BlockLabel -> Maybe ValMd
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictBaseType DICompositeType' BlockLabel
ct))
debugInfoToInfo IntMap ValMd
_ DebugInfo
_             = Info
Unknown


getFieldDIs :: MdMap -> DICompositeType -> Maybe [DebugInfo]
getFieldDIs :: IntMap ValMd -> DICompositeType' BlockLabel -> Maybe [DebugInfo]
getFieldDIs IntMap ValMd
mdMap =
  (ValMd -> Maybe DebugInfo) -> [ValMd] -> Maybe [DebugInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap) ([ValMd] -> Maybe [DebugInfo])
-> (DICompositeType' BlockLabel -> Maybe [ValMd])
-> DICompositeType' BlockLabel
-> Maybe [DebugInfo]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Maybe ValMd] -> Maybe [ValMd]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Maybe ValMd] -> Maybe [ValMd])
-> (DICompositeType' BlockLabel -> Maybe [Maybe ValMd])
-> DICompositeType' BlockLabel
-> Maybe [ValMd]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IntMap ValMd -> ValMd -> Maybe [Maybe ValMd]
getList IntMap ValMd
mdMap (ValMd -> Maybe [Maybe ValMd])
-> (DICompositeType' BlockLabel -> Maybe ValMd)
-> DICompositeType' BlockLabel
-> Maybe [Maybe ValMd]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DICompositeType' BlockLabel -> Maybe ValMd
forall lab. DICompositeType' lab -> Maybe (ValMd' lab)
dictElements

getStructFields :: MdMap -> DICompositeType -> Maybe [StructFieldInfo]
getStructFields :: IntMap ValMd
-> DICompositeType' BlockLabel -> Maybe [StructFieldInfo]
getStructFields IntMap ValMd
mdMap = (DebugInfo -> Maybe StructFieldInfo)
-> [DebugInfo] -> Maybe [StructFieldInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IntMap ValMd -> DebugInfo -> Maybe StructFieldInfo
debugInfoToStructField IntMap ValMd
mdMap) ([DebugInfo] -> Maybe [StructFieldInfo])
-> (DICompositeType' BlockLabel -> Maybe [DebugInfo])
-> DICompositeType' BlockLabel
-> Maybe [StructFieldInfo]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IntMap ValMd -> DICompositeType' BlockLabel -> Maybe [DebugInfo]
getFieldDIs IntMap ValMd
mdMap

debugInfoToStructField :: MdMap -> DebugInfo -> Maybe StructFieldInfo
debugInfoToStructField :: IntMap ValMd -> DebugInfo -> Maybe StructFieldInfo
debugInfoToStructField IntMap ValMd
mdMap DebugInfo
di =
  do DebugInfoDerivedType DIDerivedType' BlockLabel
dt <- DebugInfo -> Maybe DebugInfo
forall a. a -> Maybe a
Just DebugInfo
di
     String
fieldName               <- DIDerivedType' BlockLabel -> Maybe String
forall lab. DIDerivedType' lab -> Maybe String
didtName DIDerivedType' BlockLabel
dt
     -- We check if a struct field resides within a bitfield by checking its
     -- `flags` field sets `BitField`, which has a numeric value of 19.
     -- (https://github.com/llvm/llvm-project/blob/1bebc31c617d1a0773f1d561f02dd17c5e83b23b/llvm/include/llvm/IR/DebugInfoFlags.def#L51)
     --
     -- If so, the `size` field records the size in bits, and the `extraData`
     -- field records the offset of the overall bitfield from the start of the
     -- struct.
     -- (https://github.com/llvm/llvm-project/blob/ee7652569854af567ba83e5255d70e80cc8619a1/llvm/lib/CodeGen/AsmPrinter/CodeViewDebug.cpp#L2489-L2508)
     let bitfield :: Maybe BitfieldInfo
bitfield | Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (DIDerivedType' BlockLabel -> Word32
forall lab. DIDerivedType' lab -> Word32
didtFlags DIDerivedType' BlockLabel
dt) Int
19
                  , Just ValMd
extraData      <- DIDerivedType' BlockLabel -> Maybe ValMd
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtExtraData DIDerivedType' BlockLabel
dt
                  , Just Integer
bitfieldOffset <- IntMap ValMd -> ValMd -> Maybe Integer
getInteger IntMap ValMd
mdMap ValMd
extraData
                  = BitfieldInfo -> Maybe BitfieldInfo
forall a. a -> Maybe a
Just (BitfieldInfo -> Maybe BitfieldInfo)
-> BitfieldInfo -> Maybe BitfieldInfo
forall a b. (a -> b) -> a -> b
$ BitfieldInfo { biFieldSize :: Word64
biFieldSize      = DIDerivedType' BlockLabel -> Word64
forall lab. DIDerivedType' lab -> Word64
didtSize DIDerivedType' BlockLabel
dt
                                        , biBitfieldOffset :: Word64
biBitfieldOffset = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
bitfieldOffset
                                        }
                  | Bool
otherwise
                  = Maybe BitfieldInfo
forall a. Maybe a
Nothing
     StructFieldInfo -> Maybe StructFieldInfo
forall a. a -> Maybe a
Just (StructFieldInfo { sfiName :: String
sfiName     = String
fieldName
                           , sfiOffset :: Word64
sfiOffset   = DIDerivedType' BlockLabel -> Word64
forall lab. DIDerivedType' lab -> Word64
didtOffset DIDerivedType' BlockLabel
dt
                           , sfiBitfield :: Maybe BitfieldInfo
sfiBitfield = Maybe BitfieldInfo
bitfield
                           , sfiInfo :: Info
sfiInfo     = IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' IntMap ValMd
mdMap (DIDerivedType' BlockLabel -> Maybe ValMd
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtBaseType DIDerivedType' BlockLabel
dt)
                           })


getUnionFields :: MdMap -> DICompositeType -> Maybe [UnionFieldInfo]
getUnionFields :: IntMap ValMd
-> DICompositeType' BlockLabel -> Maybe [UnionFieldInfo]
getUnionFields IntMap ValMd
mdMap = (DebugInfo -> Maybe UnionFieldInfo)
-> [DebugInfo] -> Maybe [UnionFieldInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IntMap ValMd -> DebugInfo -> Maybe UnionFieldInfo
debugInfoToUnionField IntMap ValMd
mdMap) ([DebugInfo] -> Maybe [UnionFieldInfo])
-> (DICompositeType' BlockLabel -> Maybe [DebugInfo])
-> DICompositeType' BlockLabel
-> Maybe [UnionFieldInfo]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IntMap ValMd -> DICompositeType' BlockLabel -> Maybe [DebugInfo]
getFieldDIs IntMap ValMd
mdMap


debugInfoToUnionField :: MdMap -> DebugInfo -> Maybe UnionFieldInfo
debugInfoToUnionField :: IntMap ValMd -> DebugInfo -> Maybe UnionFieldInfo
debugInfoToUnionField IntMap ValMd
mdMap DebugInfo
di =
  do DebugInfoDerivedType DIDerivedType' BlockLabel
dt <- DebugInfo -> Maybe DebugInfo
forall a. a -> Maybe a
Just DebugInfo
di
     String
fieldName               <- DIDerivedType' BlockLabel -> Maybe String
forall lab. DIDerivedType' lab -> Maybe String
didtName DIDerivedType' BlockLabel
dt
     UnionFieldInfo -> Maybe UnionFieldInfo
forall a. a -> Maybe a
Just (UnionFieldInfo { ufiName :: String
ufiName = String
fieldName
                          , ufiInfo :: Info
ufiInfo = IntMap ValMd -> Maybe ValMd -> Info
valMdToInfo' IntMap ValMd
mdMap (DIDerivedType' BlockLabel -> Maybe ValMd
forall lab. DIDerivedType' lab -> Maybe (ValMd' lab)
didtBaseType DIDerivedType' BlockLabel
dt)
                          })



-- | Compute the structures of a function's return and argument types
-- using DWARF information metadata of the LLVM module. Different
-- versions of LLVM make this information available via different
-- paths. This function attempts to support the variations.
computeFunctionTypes ::
  Module       {- ^ module to search                     -} ->
  Symbol       {- ^ function symbol                      -} ->
  Maybe [Maybe Info] {- ^ return and argument type information -}
computeFunctionTypes :: Module -> Symbol -> Maybe [Maybe Info]
computeFunctionTypes Module
m Symbol
sym =
  [ (ValMd -> Info) -> Maybe ValMd -> Maybe Info
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntMap ValMd -> ValMd -> Info
valMdToInfo IntMap ValMd
mdMap) (Maybe ValMd -> Maybe Info) -> [Maybe ValMd] -> [Maybe Info]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe ValMd]
types
     | let mdMap :: IntMap ValMd
mdMap = Module -> IntMap ValMd
mkMdMap Module
m
     , DISubprogram
sp <- IntMap ValMd -> Module -> Symbol -> Maybe DISubprogram
findSubprogramViaDefine IntMap ValMd
mdMap Module
m Symbol
sym
         Maybe DISubprogram -> Maybe DISubprogram -> Maybe DISubprogram
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IntMap ValMd -> Module -> Symbol -> Maybe DISubprogram
findSubprogramViaCu     IntMap ValMd
mdMap Module
m Symbol
sym
     , DebugInfoSubroutineType DISubroutineType' BlockLabel
st <- IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap (ValMd -> Maybe DebugInfo) -> Maybe ValMd -> Maybe DebugInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DISubprogram -> Maybe ValMd
forall lab. DISubprogram' lab -> Maybe (ValMd' lab)
dispType DISubprogram
sp
     , [Maybe ValMd]
types                      <- IntMap ValMd -> ValMd -> Maybe [Maybe ValMd]
getList IntMap ValMd
mdMap      (ValMd -> Maybe [Maybe ValMd])
-> Maybe ValMd -> Maybe [Maybe ValMd]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DISubroutineType' BlockLabel -> Maybe ValMd
forall lab. DISubroutineType' lab -> Maybe (ValMd' lab)
distTypeArray DISubroutineType' BlockLabel
st
     ]


-- | This method of computing argument type information works on at least LLVM 3.8
findSubprogramViaDefine ::
  IntMap ValMd       {- ^ unnamed metadata                             -} ->
  Module             {- ^ module to search                             -} ->
  Symbol             {- ^ function symbol to find                      -} ->
  Maybe DISubprogram {- ^ debug information related to function symbol -}
findSubprogramViaDefine :: IntMap ValMd -> Module -> Symbol -> Maybe DISubprogram
findSubprogramViaDefine IntMap ValMd
mdMap Module
m Symbol
sym =
  [ DISubprogram
sp
     | Define
def                    <- Module -> [Define]
modDefines Module
m
     , Define -> Symbol
defName Define
def Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
sym
     , then [a] -> Maybe a
[Define] -> Maybe Define
forall a. [a] -> Maybe a
listToMaybe ----- commits to a choice -----
     , ValMd
dbgMd                  <- String -> Map String ValMd -> Maybe ValMd
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
dbgKind (Define -> Map String ValMd
defMetadata Define
def)
     , DebugInfoSubprogram DISubprogram
sp <- IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap ValMd
dbgMd
     ]


-- | This method of computing function debugging information works on LLVM 3.7
findSubprogramViaCu ::
  MdMap              {- ^ map of unnamed metadata                -} ->
  Module             {- ^ module to search                       -} ->
  Symbol             {- ^ function symbol to search for          -} ->
  Maybe DISubprogram {- ^ debugging information for given symbol -}
findSubprogramViaCu :: IntMap ValMd -> Module -> Symbol -> Maybe DISubprogram
findSubprogramViaCu IntMap ValMd
mdMap Module
m (Symbol String
sym) = [DISubprogram] -> Maybe DISubprogram
forall a. [a] -> Maybe a
listToMaybe
  [ DISubprogram
sp
    | NamedMd
md                      <- Module -> [NamedMd]
modNamedMd Module
m
    , NamedMd -> String
nmName NamedMd
md String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
llvmDbgCuKey
    , Int
ref                     <- NamedMd -> [Int]
nmValues NamedMd
md
    , DebugInfoCompileUnit DICompileUnit' BlockLabel
cu <- Maybe DebugInfo -> [DebugInfo]
forall a. Maybe a -> [a]
maybeToList  (Maybe DebugInfo -> [DebugInfo]) -> Maybe DebugInfo -> [DebugInfo]
forall a b. (a -> b) -> a -> b
$ IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap (ValMd -> Maybe DebugInfo) -> ValMd -> Maybe DebugInfo
forall a b. (a -> b) -> a -> b
$ Int -> ValMd
forall lab. Int -> ValMd' lab
ValMdRef Int
ref
    , Just ValMd
entry              <- [Maybe ValMd] -> Maybe [Maybe ValMd] -> [Maybe ValMd]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Maybe ValMd] -> [Maybe ValMd])
-> Maybe [Maybe ValMd] -> [Maybe ValMd]
forall a b. (a -> b) -> a -> b
$ IntMap ValMd -> ValMd -> Maybe [Maybe ValMd]
getList IntMap ValMd
mdMap (ValMd -> Maybe [Maybe ValMd])
-> Maybe ValMd -> Maybe [Maybe ValMd]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DICompileUnit' BlockLabel -> Maybe ValMd
forall lab. DICompileUnit' lab -> Maybe (ValMd' lab)
dicuSubprograms DICompileUnit' BlockLabel
cu
    , DebugInfoSubprogram DISubprogram
sp  <- Maybe DebugInfo -> [DebugInfo]
forall a. Maybe a -> [a]
maybeToList  (Maybe DebugInfo -> [DebugInfo]) -> Maybe DebugInfo -> [DebugInfo]
forall a b. (a -> b) -> a -> b
$ IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap ValMd
entry
    , DISubprogram -> Maybe String
forall lab. DISubprogram' lab -> Maybe String
dispName DISubprogram
sp Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
sym
    ]


------------------------------------------------------------------------

-- | If the argument describes a pointer, return the information for the
-- type that it points do. If the argument describes an array, return
-- information about the element type.
derefInfo ::
  Info {- ^ pointer type information                -} ->
  Info {- ^ type information of pointer's base type -}
derefInfo :: Info -> Info
derefInfo (Pointer Info
x) = Info
x
derefInfo (ArrInfo Info
x) = Info
x
derefInfo Info
_           = Info
Unknown

-- | If the argument describes a composite type, returns the type of the
-- field by zero-based index into the list of fields.
fieldIndexByPosition ::
  Int  {- ^ zero-based field index               -} ->
  Info {- ^ composite type information           -} ->
  Info {- ^ type information for specified field -}
fieldIndexByPosition :: Int -> Info -> Info
fieldIndexByPosition Int
i Info
info =
  case Info
info of
    Typedef String
_ Info
info' -> Int -> Info -> Info
fieldIndexByPosition Int
i Info
info'
    Structure Maybe String
_ [StructFieldInfo]
xs  -> [Info] -> Info
go [ Info
x | StructFieldInfo{sfiInfo :: StructFieldInfo -> Info
sfiInfo = Info
x} <- [StructFieldInfo]
xs ]
    Union     Maybe String
_ [UnionFieldInfo]
xs  -> [Info] -> Info
go [ Info
x | UnionFieldInfo{ufiInfo :: UnionFieldInfo -> Info
ufiInfo = Info
x}  <- [UnionFieldInfo]
xs ]
    Info
_               -> Info
Unknown
  where
    go :: [Info] -> Info
go [Info]
xs = case Int -> [Info] -> [Info]
forall a. Int -> [a] -> [a]
drop Int
i [Info]
xs of
              []  -> Info
Unknown
              Info
x:[Info]
_ -> Info
x

-- | If the argument describes a composite type, return the first, zero-based
-- index of the field in that type that matches the given name.
fieldIndexByName ::
  String    {- ^ field name                                  -} ->
  Info      {- ^ composite type info                         -} ->
  Maybe Int {- ^ zero-based index of field matching the name -}
fieldIndexByName :: String -> Info -> Maybe Int
fieldIndexByName String
n Info
info =
  case Info
info of
    Typedef String
_ Info
info' -> String -> Info -> Maybe Int
fieldIndexByName String
n Info
info'
    Structure Maybe String
_ [StructFieldInfo]
xs  -> [String] -> Maybe Int
go [ String
x | StructFieldInfo{sfiName :: StructFieldInfo -> String
sfiName = String
x} <- [StructFieldInfo]
xs ]
    Union     Maybe String
_ [UnionFieldInfo]
xs  -> [String] -> Maybe Int
go [ String
x | UnionFieldInfo{ufiName :: UnionFieldInfo -> String
ufiName = String
x}  <- [UnionFieldInfo]
xs ]
    Info
_               -> Maybe Int
forall a. Maybe a
Nothing
  where
    go :: [String] -> Maybe Int
go = String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
n

------------------------------------------------------------------------

localVariableNameDeclarations ::
  IntMap ValMd    {- ^ unnamed metadata      -} ->
  Define          {- ^ function definition   -} ->
  Map Ident Ident {- ^ raw name, actual name -}
localVariableNameDeclarations :: IntMap ValMd -> Define -> Map Ident Ident
localVariableNameDeclarations IntMap ValMd
mdMap Define
def =
  case Define -> [BasicBlock]
defBody Define
def of
    BasicBlock
blk1 : [BasicBlock]
_ -> ([Stmt] -> Map Ident Ident -> Map Ident Ident)
-> Map Ident Ident -> [[Stmt]] -> Map Ident Ident
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Stmt] -> Map Ident Ident -> Map Ident Ident
aux Map Ident Ident
forall k a. Map k a
Map.empty ([Stmt] -> [[Stmt]]
forall a. [a] -> [[a]]
tails (BasicBlock -> [Stmt]
forall lab. BasicBlock' lab -> [Stmt' lab]
bbStmts BasicBlock
blk1))
    [BasicBlock]
_        -> Map Ident Ident
forall k a. Map k a
Map.empty
  where

    aux :: [Stmt] -> Map Ident Ident -> Map Ident Ident
    aux :: [Stmt] -> Map Ident Ident -> Map Ident Ident
aux ( Effect (Store Typed (Value' BlockLabel)
src Typed (Value' BlockLabel)
dst Maybe AtomicOrdering
_ Maybe Int
_) [(String, ValMd)]
_
        : Effect (Call Bool
_ Type
_ (ValSymbol (Symbol String
what)) [Typed (Value' BlockLabel)
var,Typed (Value' BlockLabel)
md,Typed (Value' BlockLabel)
_]) [(String, ValMd)]
_
        : [Stmt]
_) Map Ident Ident
sofar
      | String
what String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"llvm.dbg.declare"
      , Just Ident
dstIdent <- Typed (Value' BlockLabel) -> Maybe Ident
extractIdent Typed (Value' BlockLabel)
dst
      , Just Ident
srcIdent <- Typed (Value' BlockLabel) -> Maybe Ident
extractIdent Typed (Value' BlockLabel)
src
      , Just Ident
varIdent <- Typed (Value' BlockLabel) -> Maybe Ident
extractIdent Typed (Value' BlockLabel)
var
      , Ident
dstIdent Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
varIdent
      , Just Ident
name <- Typed (Value' BlockLabel) -> Maybe Ident
extractLvName Typed (Value' BlockLabel)
md
      = Ident -> Ident -> Map Ident Ident -> Map Ident Ident
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
name Ident
srcIdent Map Ident Ident
sofar

    aux ( Effect (Call Bool
_ Type
_ (ValSymbol (Symbol String
what)) [Typed (Value' BlockLabel)
var,Typed (Value' BlockLabel)
_,Typed (Value' BlockLabel)
md,Typed (Value' BlockLabel)
_]) [(String, ValMd)]
_
        : [Stmt]
_) Map Ident Ident
sofar
      | String
what String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"llvm.dbg.value"
      , Just Ident
key  <- Typed (Value' BlockLabel) -> Maybe Ident
extractIdent Typed (Value' BlockLabel)
var
      , Just Ident
name <- Typed (Value' BlockLabel) -> Maybe Ident
extractLvName Typed (Value' BlockLabel)
md
      = Ident -> Ident -> Map Ident Ident -> Map Ident Ident
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
name Ident
key Map Ident Ident
sofar

    aux [Stmt]
_ Map Ident Ident
sofar = Map Ident Ident
sofar

    extractIdent :: Typed Value -> Maybe Ident
    extractIdent :: Typed (Value' BlockLabel) -> Maybe Ident
extractIdent (Typed Type
_ (ValIdent Ident
i)) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
i
    extractIdent Typed (Value' BlockLabel)
_                      = Maybe Ident
forall a. Maybe a
Nothing

    extractLvName :: Typed Value -> Maybe Ident
    extractLvName :: Typed (Value' BlockLabel) -> Maybe Ident
extractLvName Typed (Value' BlockLabel)
mdArg =
      do ValMd ValMd
md                    <- Value' BlockLabel -> Maybe (Value' BlockLabel)
forall a. a -> Maybe a
Just (Typed (Value' BlockLabel) -> Value' BlockLabel
forall a. Typed a -> a
typedValue Typed (Value' BlockLabel)
mdArg)
         DebugInfoLocalVariable DILocalVariable' BlockLabel
dilv <- IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap ValMd
md
         String -> Ident
Ident (String -> Ident) -> Maybe String -> Maybe Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DILocalVariable' BlockLabel -> Maybe String
forall lab. DILocalVariable' lab -> Maybe String
dilvName DILocalVariable' BlockLabel
dilv

------------------------------------------------------------------------

-- | Search the metadata for debug info corresponding
-- to a given type alias. This is considered a heuristic
-- because there's no direct mapping between type aliases
-- and debug info. The debug information must be search
-- for a textual match.
--
-- Compared to @guessTypeInfo@, this function first tries
-- to strip the \"struct.\" and \"union.\" prefixes that are
-- commonly added by clang before searching for the type information.
guessAliasInfo ::
  IntMap ValMd    {- ^ unnamed metadata      -} ->
  Ident           {- ^ alias                 -} ->
  Info
guessAliasInfo :: IntMap ValMd -> Ident -> Info
guessAliasInfo IntMap ValMd
mdMap (Ident String
name)
  | Just String
pfx <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"struct." String
name = IntMap ValMd -> String -> Info
guessTypeInfo IntMap ValMd
mdMap String
pfx
  | Just String
pfx <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"union."  String
name = IntMap ValMd -> String -> Info
guessTypeInfo IntMap ValMd
mdMap String
pfx
  | Bool
otherwise = IntMap ValMd -> String -> Info
guessTypeInfo IntMap ValMd
mdMap String
name

-- | Search the metadata for debug info corresponding
-- to a given type alias. This is considered a heuristic
-- because there's no direct mapping between type aliases
-- and debug info. The debug information must be search
-- for a textual match.
guessTypeInfo ::
  IntMap ValMd    {- ^ unnamed metadata      -} ->
  String          {- ^ struct alias          -} ->
  Info
guessTypeInfo :: IntMap ValMd -> String -> Info
guessTypeInfo IntMap ValMd
mdMap String
name =
  case (ValMd -> Maybe Info) -> [ValMd] -> [Info]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DebugInfo -> Maybe Info
go (DebugInfo -> Maybe Info)
-> (ValMd -> Maybe DebugInfo) -> ValMd -> Maybe Info
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IntMap ValMd -> ValMd -> Maybe DebugInfo
getDebugInfo IntMap ValMd
mdMap) (IntMap ValMd -> [ValMd]
forall a. IntMap a -> [a]
IntMap.elems IntMap ValMd
mdMap) of
    []  -> Info
Unknown
    Info
x:[Info]
_ -> Info
x

  where
    go :: DebugInfo -> Maybe Info
go DebugInfo
di | DebugInfoDerivedType DIDerivedType' BlockLabel
didt <- DebugInfo
di
          , String -> Maybe String
forall a. a -> Maybe a
Just String
name Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== DIDerivedType' BlockLabel -> Maybe String
forall lab. DIDerivedType' lab -> Maybe String
didtName DIDerivedType' BlockLabel
didt
          = Info -> Maybe Info
forall a. a -> Maybe a
Just (IntMap ValMd -> DebugInfo -> Info
debugInfoToInfo IntMap ValMd
mdMap DebugInfo
di)

    go DebugInfo
di | DebugInfoCompositeType DICompositeType' BlockLabel
dict <- DebugInfo
di
          , String -> Maybe String
forall a. a -> Maybe a
Just String
name Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== DICompositeType' BlockLabel -> Maybe String
forall lab. DICompositeType' lab -> Maybe String
dictName DICompositeType' BlockLabel
dict
          = Info -> Maybe Info
forall a. a -> Maybe a
Just (IntMap ValMd -> DebugInfo -> Info
debugInfoToInfo IntMap ValMd
mdMap DebugInfo
di)

    go DebugInfo
_ = Maybe Info
forall a. Maybe a
Nothing

------------------------------------------------------------------------

-- | Find source-level names of function arguments
debugInfoArgNames :: Module -> Define -> IntMap String
debugInfoArgNames :: Module -> Define -> IntMap String
debugInfoArgNames Module
m Define
d =
  case String -> Map String ValMd -> Maybe ValMd
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
dbgKind (Map String ValMd -> Maybe ValMd)
-> Map String ValMd -> Maybe ValMd
forall a b. (a -> b) -> a -> b
$ Define -> Map String ValMd
defMetadata Define
d of
    Just (ValMdRef Int
s) -> Int -> IntMap String
scopeArgs Int
s
    Maybe ValMd
_ -> IntMap String
forall a. IntMap a
IntMap.empty
  where
    scopeArgs :: Int -> IntMap String
    scopeArgs :: Int -> IntMap String
scopeArgs Int
s = [(Int, String)] -> IntMap String
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, String)] -> IntMap String)
-> ([UnnamedMd] -> [(Int, String)]) -> [UnnamedMd] -> IntMap String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnnamedMd -> Maybe (Int, String))
-> [UnnamedMd] -> [(Int, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UnnamedMd -> Maybe (Int, String)
go ([UnnamedMd] -> IntMap String) -> [UnnamedMd] -> IntMap String
forall a b. (a -> b) -> a -> b
$ Module -> [UnnamedMd]
modUnnamedMd Module
m
      where
        go :: UnnamedMd -> Maybe (Int, String)
        go :: UnnamedMd -> Maybe (Int, String)
go
          ( UnnamedMd
              { umValues :: UnnamedMd -> ValMd
umValues =
                  ValMdDebugInfo
                    ( DebugInfoLocalVariable
                        DILocalVariable
                          { dilvScope :: forall lab. DILocalVariable' lab -> Maybe (ValMd' lab)
dilvScope = Just (ValMdRef Int
s'),
                            dilvArg :: forall lab. DILocalVariable' lab -> Word16
dilvArg = Word16
a,
                            dilvName :: forall lab. DILocalVariable' lab -> Maybe String
dilvName = Just String
n
                          }
                      )
              }) =
            if Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s'
            then (Int, String) -> Maybe (Int, String)
forall a. a -> Maybe a
Just (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, String
n)
            else Maybe (Int, String)
forall a. Maybe a
Nothing
        go UnnamedMd
_ = Maybe (Int, String)
forall a. Maybe a
Nothing

------------------------------------------------------------------------

-- | Map global variable names to the line on which the global is defined
debugInfoGlobalLines :: Module -> Map String Int
debugInfoGlobalLines :: Module -> Map String Int
debugInfoGlobalLines = [(String, Int)] -> Map String Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Int)] -> Map String Int)
-> (Module -> [(String, Int)]) -> Module -> Map String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnnamedMd -> Maybe (String, Int))
-> [UnnamedMd] -> [(String, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UnnamedMd -> Maybe (String, Int)
go ([UnnamedMd] -> [(String, Int)])
-> (Module -> [UnnamedMd]) -> Module -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [UnnamedMd]
modUnnamedMd
  where
    go :: UnnamedMd -> Maybe (String, Int)
    go :: UnnamedMd -> Maybe (String, Int)
go (UnnamedMd
         { umValues :: UnnamedMd -> ValMd
umValues = ValMdDebugInfo
           (DebugInfoGlobalVariable DIGlobalVariable
             { digvName :: forall lab. DIGlobalVariable' lab -> Maybe String
digvName = Just String
n
             , digvLine :: forall lab. DIGlobalVariable' lab -> Word32
digvLine = Word32
l
             }
           )
         }) = (String, Int) -> Maybe (String, Int)
forall a. a -> Maybe a
Just (String
n, (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l))
    go UnnamedMd
_ = Maybe (String, Int)
forall a. Maybe a
Nothing

-- | Map function names to the line on which the function is defined
debugInfoDefineLines :: Module -> Map String Int
debugInfoDefineLines :: Module -> Map String Int
debugInfoDefineLines = [(String, Int)] -> Map String Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Int)] -> Map String Int)
-> (Module -> [(String, Int)]) -> Module -> Map String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnnamedMd -> Maybe (String, Int))
-> [UnnamedMd] -> [(String, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UnnamedMd -> Maybe (String, Int)
go ([UnnamedMd] -> [(String, Int)])
-> (Module -> [UnnamedMd]) -> Module -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [UnnamedMd]
modUnnamedMd
  where
    go :: UnnamedMd -> Maybe (String, Int)
    go :: UnnamedMd -> Maybe (String, Int)
go (UnnamedMd
         { umValues :: UnnamedMd -> ValMd
umValues = ValMdDebugInfo
           (DebugInfoSubprogram DISubprogram
             { dispName :: forall lab. DISubprogram' lab -> Maybe String
dispName = Just String
n
             , dispIsDefinition :: forall lab. DISubprogram' lab -> Bool
dispIsDefinition = Bool
True
             , dispLine :: forall lab. DISubprogram' lab -> Word32
dispLine = Word32
l
             }
           )
         }) = (String, Int) -> Maybe (String, Int)
forall a. a -> Maybe a
Just (String
n, (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l))
    go UnnamedMd
_ = Maybe (String, Int)
forall a. Maybe a
Nothing