{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- This defines data structures for parsing Dwarf debug information from
-- binaries.
module Data.Macaw.Dwarf
  ( -- * Compile units and declarations
    Data.Macaw.Memory.Endianness (..),
    Dwarf.Sections,
    Dwarf.mkSections,
    Dwarf.CUContext,
    Dwarf.CUOffset (..),
    firstCUContext,
    Dwarf.nextCUContext,
    getCompileUnit,
    dwarfCompileUnits,
    CompileUnit,
    cuRanges,
    cuSubprograms,
    lookupSubprogram,
    dwarfGlobals,

    -- ** Utility function
    dwarfInfoFromElf,

    -- * Variables
    Variable,
    varName,
    varType,
    varOrigin,

    -- * Sub programs
    Subprogram (..),
    SubprogramDef (..),

    -- * Inlineing
    SubprogramRef,
    VariableRef,

    -- * Locations
    Location (..),
    DeclLoc, -- (..)

    -- * Type information
    TypeRef,
    typeRefFileOffset,
    AbsType,
    TypeApp (..),
    StructDecl (..),
    UnionDecl (..),
    Member (..),
    EnumDecl (..),
    Enumerator, -- (..)
    SubroutineTypeDecl (..),
    Subrange (..),
    Typedef (..),
    TypeQual (..),
    TypeQualAnn (..),

    -- * Name and Description
    Name (..),
    Description (..),

    -- * Low-level access
    DwarfExpr (..),

    -- * Exports of "Data.Dwarf"
    Dwarf.DieID,
    Dwarf.DW_OP (..),
    Dwarf.Range (..),
  )
where

import Control.Lens
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Data.Binary.Get
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Dwarf as Dwarf hiding (Endianess (..), firstCUContext)
import qualified Data.Dwarf as Dwarf
import qualified Data.ElfEdit as Elf
import Data.Foldable
import Data.Int
import Data.List (sortOn)
import Data.Macaw.Memory (Endianness (..))
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String
import qualified Data.Vector as V
import Data.Word
import Numeric (showHex)
import Prettyprinter
import Text.Printf

hasAttribute :: DW_AT -> DIE -> Bool
hasAttribute :: DW_AT -> DIE -> Bool
hasAttribute DW_AT
a DIE
d = ((DW_AT, DW_ATVAL) -> Bool) -> [(DW_AT, DW_ATVAL)] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (\(DW_AT, DW_ATVAL)
p -> (DW_AT, DW_ATVAL) -> DW_AT
forall a b. (a, b) -> a
fst (DW_AT, DW_ATVAL)
p DW_AT -> DW_AT -> Bool
forall a. Eq a => a -> a -> Bool
== DW_AT
a) (DIE -> [(DW_AT, DW_ATVAL)]
dieAttributes DIE
d)

------------------------------------------------------------------------
-- WarnMonad

-- A monad that allows one to collect warnings with a given type during execution.
class Monad m => WarnMonad s m | m -> s where
  -- Emit the given warning
  warn :: s -> m ()

  -- Run a computation in a context where all warnings are transformed by the given
  -- function.
  runInContext :: (s -> s) -> m r -> m r

instance WarnMonad s m => WarnMonad s (ReaderT r m) where
  warn :: s -> ReaderT r m ()
warn s
s = (r -> m ()) -> ReaderT r m ()
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m ()) -> ReaderT r m ()) -> (r -> m ()) -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ \r
_ -> s -> m ()
forall s (m :: Type -> Type). WarnMonad s m => s -> m ()
warn s
s
  runInContext :: forall r. (s -> s) -> ReaderT r m r -> ReaderT r m r
runInContext s -> s
f ReaderT r m r
m = (r -> m r) -> ReaderT r m r
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m r) -> ReaderT r m r) -> (r -> m r) -> ReaderT r m r
forall a b. (a -> b) -> a -> b
$ \r
r ->
    (s -> s) -> m r -> m r
forall r. (s -> s) -> m r -> m r
forall s (m :: Type -> Type) r.
WarnMonad s m =>
(s -> s) -> m r -> m r
runInContext s -> s
f (ReaderT r m r -> r -> m r
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m r
m r
r)

------------------------------------------------------------------------
-- WarnT

-- | A monad transformer that adds the ability to collect a list of messages
-- (called "warnings") and throw a exception.
newtype WarnT e m r = WarnT {forall e (m :: Type -> Type) r.
WarnT e m r -> ExceptT e (StateT [e] m) r
unWarnT :: ExceptT e (StateT [e] m) r}
  deriving ((forall a b. (a -> b) -> WarnT e m a -> WarnT e m b)
-> (forall a b. a -> WarnT e m b -> WarnT e m a)
-> Functor (WarnT e m)
forall a b. a -> WarnT e m b -> WarnT e m a
forall a b. (a -> b) -> WarnT e m a -> WarnT e m b
forall e (m :: Type -> Type) a b.
Functor m =>
a -> WarnT e m b -> WarnT e m a
forall e (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> WarnT e m a -> WarnT e m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> WarnT e m a -> WarnT e m b
fmap :: forall a b. (a -> b) -> WarnT e m a -> WarnT e m b
$c<$ :: forall e (m :: Type -> Type) a b.
Functor m =>
a -> WarnT e m b -> WarnT e m a
<$ :: forall a b. a -> WarnT e m b -> WarnT e m a
Functor, Functor (WarnT e m)
Functor (WarnT e m) =>
(forall a. a -> WarnT e m a)
-> (forall a b. WarnT e m (a -> b) -> WarnT e m a -> WarnT e m b)
-> (forall a b c.
    (a -> b -> c) -> WarnT e m a -> WarnT e m b -> WarnT e m c)
-> (forall a b. WarnT e m a -> WarnT e m b -> WarnT e m b)
-> (forall a b. WarnT e m a -> WarnT e m b -> WarnT e m a)
-> Applicative (WarnT e m)
forall a. a -> WarnT e m a
forall a b. WarnT e m a -> WarnT e m b -> WarnT e m a
forall a b. WarnT e m a -> WarnT e m b -> WarnT e m b
forall a b. WarnT e m (a -> b) -> WarnT e m a -> WarnT e m b
forall a b c.
(a -> b -> c) -> WarnT e m a -> WarnT e m b -> WarnT e m c
forall e (m :: Type -> Type). Monad m => Functor (WarnT e m)
forall e (m :: Type -> Type) a. Monad m => a -> WarnT e m a
forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> WarnT e m b -> WarnT e m a
forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> WarnT e m b -> WarnT e m b
forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m (a -> b) -> WarnT e m a -> WarnT e m b
forall e (m :: Type -> Type) a b c.
Monad m =>
(a -> b -> c) -> WarnT e m a -> WarnT e m b -> WarnT e m c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall e (m :: Type -> Type) a. Monad m => a -> WarnT e m a
pure :: forall a. a -> WarnT e m a
$c<*> :: forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m (a -> b) -> WarnT e m a -> WarnT e m b
<*> :: forall a b. WarnT e m (a -> b) -> WarnT e m a -> WarnT e m b
$cliftA2 :: forall e (m :: Type -> Type) a b c.
Monad m =>
(a -> b -> c) -> WarnT e m a -> WarnT e m b -> WarnT e m c
liftA2 :: forall a b c.
(a -> b -> c) -> WarnT e m a -> WarnT e m b -> WarnT e m c
$c*> :: forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> WarnT e m b -> WarnT e m b
*> :: forall a b. WarnT e m a -> WarnT e m b -> WarnT e m b
$c<* :: forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> WarnT e m b -> WarnT e m a
<* :: forall a b. WarnT e m a -> WarnT e m b -> WarnT e m a
Applicative, Applicative (WarnT e m)
Applicative (WarnT e m) =>
(forall a b. WarnT e m a -> (a -> WarnT e m b) -> WarnT e m b)
-> (forall a b. WarnT e m a -> WarnT e m b -> WarnT e m b)
-> (forall a. a -> WarnT e m a)
-> Monad (WarnT e m)
forall a. a -> WarnT e m a
forall a b. WarnT e m a -> WarnT e m b -> WarnT e m b
forall a b. WarnT e m a -> (a -> WarnT e m b) -> WarnT e m b
forall e (m :: Type -> Type). Monad m => Applicative (WarnT e m)
forall e (m :: Type -> Type) a. Monad m => a -> WarnT e m a
forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> WarnT e m b -> WarnT e m b
forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> (a -> WarnT e m b) -> WarnT e m b
forall (m :: Type -> Type).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> (a -> WarnT e m b) -> WarnT e m b
>>= :: forall a b. WarnT e m a -> (a -> WarnT e m b) -> WarnT e m b
$c>> :: forall e (m :: Type -> Type) a b.
Monad m =>
WarnT e m a -> WarnT e m b -> WarnT e m b
>> :: forall a b. WarnT e m a -> WarnT e m b -> WarnT e m b
$creturn :: forall e (m :: Type -> Type) a. Monad m => a -> WarnT e m a
return :: forall a. a -> WarnT e m a
Monad, MonadError e)

runWarnT :: WarnT e m r -> m (Either e r, [e])
runWarnT :: forall e (m :: Type -> Type) r. WarnT e m r -> m (Either e r, [e])
runWarnT WarnT e m r
m = StateT [e] m (Either e r) -> [e] -> m (Either e r, [e])
forall s (m :: Type -> Type) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT e (StateT [e] m) r -> StateT [e] m (Either e r)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT (WarnT e m r -> ExceptT e (StateT [e] m) r
forall e (m :: Type -> Type) r.
WarnT e m r -> ExceptT e (StateT [e] m) r
unWarnT WarnT e m r
m)) []

instance Monad m => WarnMonad e (WarnT e m) where
  warn :: e -> WarnT e m ()
warn e
msg = ExceptT e (StateT [e] m) () -> WarnT e m ()
forall e (m :: Type -> Type) r.
ExceptT e (StateT [e] m) r -> WarnT e m r
WarnT (ExceptT e (StateT [e] m) () -> WarnT e m ())
-> ExceptT e (StateT [e] m) () -> WarnT e m ()
forall a b. (a -> b) -> a -> b
$ StateT [e] m (Either e ()) -> ExceptT e (StateT [e] m) ()
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT [e] m (Either e ()) -> ExceptT e (StateT [e] m) ())
-> StateT [e] m (Either e ()) -> ExceptT e (StateT [e] m) ()
forall a b. (a -> b) -> a -> b
$ ([e] -> m (Either e (), [e])) -> StateT [e] m (Either e ())
forall s (m :: Type -> Type) a. (s -> m (a, s)) -> StateT s m a
StateT (([e] -> m (Either e (), [e])) -> StateT [e] m (Either e ()))
-> ([e] -> m (Either e (), [e])) -> StateT [e] m (Either e ())
forall a b. (a -> b) -> a -> b
$ \[e]
s -> (Either e (), [e]) -> m (Either e (), [e])
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (() -> Either e ()
forall a b. b -> Either a b
Right (), e
msg e -> [e] -> [e]
forall a. a -> [a] -> [a]
: [e]
s)

  runInContext :: forall r. (e -> e) -> WarnT e m r -> WarnT e m r
runInContext e -> e
f WarnT e m r
m = ExceptT e (StateT [e] m) r -> WarnT e m r
forall e (m :: Type -> Type) r.
ExceptT e (StateT [e] m) r -> WarnT e m r
WarnT (ExceptT e (StateT [e] m) r -> WarnT e m r)
-> ExceptT e (StateT [e] m) r -> WarnT e m r
forall a b. (a -> b) -> a -> b
$
    StateT [e] m (Either e r) -> ExceptT e (StateT [e] m) r
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT [e] m (Either e r) -> ExceptT e (StateT [e] m) r)
-> StateT [e] m (Either e r) -> ExceptT e (StateT [e] m) r
forall a b. (a -> b) -> a -> b
$
      ([e] -> m (Either e r, [e])) -> StateT [e] m (Either e r)
forall s (m :: Type -> Type) a. (s -> m (a, s)) -> StateT s m a
StateT (([e] -> m (Either e r, [e])) -> StateT [e] m (Either e r))
-> ([e] -> m (Either e r, [e])) -> StateT [e] m (Either e r)
forall a b. (a -> b) -> a -> b
$ \[e]
s -> do
        let g :: (Either e r, [e]) -> (Either e r, [e])
g (Either e r
mr, [e]
warnings) = ((e -> Either e r) -> (r -> Either e r) -> Either e r -> Either e r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Either e r
forall a b. a -> Either a b
Left (e -> Either e r) -> (e -> e) -> e -> Either e r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> e
f) r -> Either e r
forall a b. b -> Either a b
Right Either e r
mr, (e -> e) -> [e] -> [e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e
f [e]
warnings [e] -> [e] -> [e]
forall a. [a] -> [a] -> [a]
++ [e]
s)
         in (Either e r, [e]) -> (Either e r, [e])
g ((Either e r, [e]) -> (Either e r, [e]))
-> m (Either e r, [e]) -> m (Either e r, [e])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> WarnT e m r -> m (Either e r, [e])
forall e (m :: Type -> Type) r. WarnT e m r -> m (Either e r, [e])
runWarnT WarnT e m r
m

------------------------------------------------------------------------
-- Parser

-- | The context needed to read dwarf entries.
newtype ParserState = ParserState
  { ParserState -> Reader
readerInfo :: Dwarf.Reader
  }

newtype Parser r = Parser {forall r. Parser r -> ReaderT ParserState (WarnT String Identity) r
unParser :: ReaderT ParserState (WarnT String Identity) r}
  deriving
    ( (forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
$c<$ :: forall a b. a -> Parser b -> Parser a
<$ :: forall a b. a -> Parser b -> Parser a
Functor,
      Functor Parser
Functor Parser =>
(forall a. a -> Parser a)
-> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
-> (forall a b c.
    (a -> b -> c) -> Parser a -> Parser b -> Parser c)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser a)
-> Applicative Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Parser a
pure :: forall a. a -> Parser a
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
liftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
$c*> :: forall a b. Parser a -> Parser b -> Parser b
*> :: forall a b. Parser a -> Parser b -> Parser b
$c<* :: forall a b. Parser a -> Parser b -> Parser a
<* :: forall a b. Parser a -> Parser b -> Parser a
Applicative,
      Applicative Parser
Applicative Parser =>
(forall a b. Parser a -> (a -> Parser b) -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a. a -> Parser a)
-> Monad Parser
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: Type -> Type).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
$c>> :: forall a b. Parser a -> Parser b -> Parser b
>> :: forall a b. Parser a -> Parser b -> Parser b
$creturn :: forall a. a -> Parser a
return :: forall a. a -> Parser a
Monad,
      MonadError String,
      WarnMonad String
    )

instance MonadFail Parser where
  fail :: forall a. String -> Parser a
fail = String -> Parser a
forall a. String -> Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError


runParser :: Dwarf.Reader -> Parser r -> (Either String r, [String])
runParser :: forall r. Reader -> Parser r -> (Either String r, [String])
runParser Reader
dr Parser r
p = Identity (Either String r, [String]) -> (Either String r, [String])
forall a. Identity a -> a
runIdentity (WarnT String Identity r -> Identity (Either String r, [String])
forall e (m :: Type -> Type) r. WarnT e m r -> m (Either e r, [e])
runWarnT (ReaderT ParserState (WarnT String Identity) r
-> ParserState -> WarnT String Identity r
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (Parser r -> ReaderT ParserState (WarnT String Identity) r
forall r. Parser r -> ReaderT ParserState (WarnT String Identity) r
unParser Parser r
p) ParserState
s))
  where
    s :: ParserState
s =
      ParserState
        { readerInfo :: Reader
readerInfo = Reader
dr
        }

------------------------------------------------------------------------
-- Parser functions

-- | Error from parsing an attribute.
data AttrError
  = IncorrectTypeFor !BSC.ByteString
  | InvalidFileIndex !Word64

ppAttrError :: AttrError -> String
ppAttrError :: AttrError -> String
ppAttrError AttrError
e =
  case AttrError
e of
    IncorrectTypeFor ByteString
tp -> String
"Incorrect type for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BSC.unpack ByteString
tp
    InvalidFileIndex Word64
idx -> String
"Invalid file index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
idx

-- | A parser for attribute values.
type AttrParser r = Dwarf.Reader -> DW_ATVAL -> Except AttrError r

convertAttribute ::
  DW_AT ->
  AttrParser r ->
  DW_ATVAL ->
  Parser r
convertAttribute :: forall r. DW_AT -> AttrParser r -> DW_ATVAL -> Parser r
convertAttribute DW_AT
dat AttrParser r
f DW_ATVAL
v = do
  Reader
dr <- ReaderT ParserState (WarnT String Identity) Reader -> Parser Reader
forall r. ReaderT ParserState (WarnT String Identity) r -> Parser r
Parser (ReaderT ParserState (WarnT String Identity) Reader
 -> Parser Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
-> Parser Reader
forall a b. (a -> b) -> a -> b
$ (ParserState -> Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks ParserState -> Reader
readerInfo
  case Except AttrError r -> Either AttrError r
forall e a. Except e a -> Either e a
runExcept (AttrParser r
f Reader
dr DW_ATVAL
v) of
    Left AttrError
e ->
      String -> Parser r
forall a. String -> Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> Parser r) -> String -> Parser r
forall a b. (a -> b) -> a -> b
$
        String
"Could not interpret attribute "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_AT -> String
forall a. Show a => a -> String
show DW_AT
dat
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" value "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_ATVAL -> String
forall a. Show a => a -> String
show DW_ATVAL
v
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttrError -> String
ppAttrError AttrError
e
    Right r
r -> r -> Parser r
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure r
r

attributeValue :: AttrParser DW_ATVAL
attributeValue :: AttrParser DW_ATVAL
attributeValue = \Reader
_ -> DW_ATVAL -> ExceptT AttrError Identity DW_ATVAL
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

attributeAsBlob :: AttrParser BS.ByteString
attributeAsBlob :: AttrParser ByteString
attributeAsBlob Reader
_ (DW_ATVAL_BLOB ByteString
b) = ByteString -> ExceptT AttrError Identity ByteString
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
b
attributeAsBlob Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity ByteString
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity ByteString)
-> AttrError -> ExceptT AttrError Identity ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"BLOB"

attributeAsBool :: AttrParser Bool
attributeAsBool :: AttrParser Bool
attributeAsBool Reader
_ (DW_ATVAL_BOOL Bool
b) = Bool -> ExceptT AttrError Identity Bool
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
b
attributeAsBool Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity Bool
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity Bool)
-> AttrError -> ExceptT AttrError Identity Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"Bool"

attributeAsUInt :: AttrParser Word64
attributeAsUInt :: AttrParser Word64
attributeAsUInt Reader
_ (DW_ATVAL_UINT Word64
u) = Word64 -> ExceptT AttrError Identity Word64
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Word64
u
attributeAsUInt Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity Word64
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity Word64)
-> AttrError -> ExceptT AttrError Identity Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"UInt"

-- | Parse an attribute as a DIE identifier.
attributeAsDieID :: AttrParser DieID
attributeAsDieID :: AttrParser DieID
attributeAsDieID Reader
_ (DW_ATVAL_REF DieID
r) = DieID -> ExceptT AttrError Identity DieID
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DieID
r
attributeAsDieID Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity DieID
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity DieID)
-> AttrError -> ExceptT AttrError Identity DieID
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"DieID"

-- | Parse an attribute intended to be interpreted as a displayable
-- string.
--
-- The character set is not defined, but typically 7-bit ASCII.
attributeAsString :: AttrParser BS.ByteString
attributeAsString :: AttrParser ByteString
attributeAsString Reader
_ (DW_ATVAL_STRING ByteString
s) = ByteString -> ExceptT AttrError Identity ByteString
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
s
attributeAsString Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity ByteString
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity ByteString)
-> AttrError -> ExceptT AttrError Identity ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"String"

attributeAsBaseTypeEncoding :: AttrParser DW_ATE
attributeAsBaseTypeEncoding :: AttrParser DW_ATE
attributeAsBaseTypeEncoding Reader
_ (DW_ATVAL_UINT Word64
u) = DW_ATE -> ExceptT AttrError Identity DW_ATE
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Word64 -> DW_ATE
DW_ATE Word64
u)
attributeAsBaseTypeEncoding Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity DW_ATE
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity DW_ATE)
-> AttrError -> ExceptT AttrError Identity DW_ATE
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"BaseTypeEncoding"

attributeAsLang :: AttrParser DW_LANG
attributeAsLang :: AttrParser DW_LANG
attributeAsLang Reader
dr DW_ATVAL
v = Word64 -> DW_LANG
DW_LANG (Word64 -> DW_LANG)
-> ExceptT AttrError Identity Word64
-> ExceptT AttrError Identity DW_LANG
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrParser Word64
attributeAsUInt Reader
dr DW_ATVAL
v

mapAttr :: (a -> b) -> AttrParser a -> AttrParser b
mapAttr :: forall a b. (a -> b) -> AttrParser a -> AttrParser b
mapAttr a -> b
f AttrParser a
p Reader
dr DW_ATVAL
v = a -> b
f (a -> b)
-> ExceptT AttrError Identity a -> ExceptT AttrError Identity b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrParser a
p Reader
dr DW_ATVAL
v

parseGet :: BS.ByteString -> Get a -> Parser a
parseGet :: forall a. ByteString -> Get a -> Parser a
parseGet ByteString
bs Get a
m =
  case Decoder a -> Decoder a
forall a. Decoder a -> Decoder a
pushEndOfInput (Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
m Decoder a -> ByteString -> Decoder a
forall a. Decoder a -> ByteString -> Decoder a
`pushChunk` ByteString
bs) of
    Fail ByteString
_ ByteOffset
_ String
msg -> String -> Parser a
forall a. String -> Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError String
msg
    Partial Maybe ByteString -> Decoder a
_ -> String -> Parser a
forall a. String -> Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError String
"Unexpected partial"
    Done ByteString
_ ByteOffset
_ a
r -> a -> Parser a
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
r

------------------------------------------------------------------------
-- Range

ppRange :: Range -> Doc ann
ppRange :: forall ann. Range -> Doc ann
ppRange (Range Word64
x Word64
y) =
  Doc ann
"low:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
x String
"") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"high:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
y String
"")

------------------------------------------------------------------------
-- DIEParser

data DIEParserState = DPS
  { DIEParserState -> DIE
dpsDIE :: DIE,
    -- | Maps attributes to the set of values with that attribute.
    DIEParserState -> Map DW_AT [DW_ATVAL]
dpsAttributeMap :: Map DW_AT [DW_ATVAL],
    -- | Set of attributes that a parser has searched for.
    --
    -- Used so that we can flag when a DIE contains an attribute
    -- we have not considered.
    DIEParserState -> Set DW_AT
_dpsSeenAttributes :: Set DW_AT,
    -- | Maps tags to the set of child die nodes with that tag.
    DIEParserState -> Map DW_TAG [DIE]
dpsChildrenMap :: Map DW_TAG [DIE],
    -- | Set of tags for children that we have attempted to
    -- parse.
    --
    -- Used so that we can flag when a DIE contains a child tag
    -- we have not considered.
    DIEParserState -> Set DW_TAG
_dpsSeenChildren :: Set DW_TAG
  }

dpsSeenAttributes :: Lens' DIEParserState (Set DW_AT)
dpsSeenAttributes :: Lens' DIEParserState (Set DW_AT)
dpsSeenAttributes = (DIEParserState -> Set DW_AT)
-> (DIEParserState -> Set DW_AT -> DIEParserState)
-> Lens' DIEParserState (Set DW_AT)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DIEParserState -> Set DW_AT
_dpsSeenAttributes (\DIEParserState
s Set DW_AT
v -> DIEParserState
s {_dpsSeenAttributes = v})

dpsSeenChildren :: Lens' DIEParserState (Set DW_TAG)
dpsSeenChildren :: Lens' DIEParserState (Set DW_TAG)
dpsSeenChildren = (DIEParserState -> Set DW_TAG)
-> (DIEParserState -> Set DW_TAG -> DIEParserState)
-> Lens' DIEParserState (Set DW_TAG)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DIEParserState -> Set DW_TAG
_dpsSeenChildren (\DIEParserState
s Set DW_TAG
v -> DIEParserState
s {_dpsSeenChildren = v})

type DIEParser = StateT DIEParserState Parser

taggedError :: String -> String -> String
taggedError :: String -> String -> String
taggedError String
nm String
msg =
  String
"Error parsing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> [String] -> [String]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
msg)

runDIEParser ::
  String ->
  DIE ->
  DIEParser r ->
  Parser r
runDIEParser :: forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
ctx DIE
d DIEParser r
act =
  (String -> String) -> Parser r -> Parser r
forall r. (String -> String) -> Parser r -> Parser r
forall s (m :: Type -> Type) r.
WarnMonad s m =>
(s -> s) -> m r -> m r
runInContext (String -> String -> String
taggedError (String
ctx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DieID -> String
forall a. Show a => a -> String
show (DIE -> DieID
dieId DIE
d) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_TAG -> String
forall a. Show a => a -> String
show (DIE -> DW_TAG
dieTag DIE
d))) (Parser r -> Parser r) -> Parser r -> Parser r
forall a b. (a -> b) -> a -> b
$ do
    let childMap :: Map DW_TAG [DIE]
        childMap :: Map DW_TAG [DIE]
childMap = (DIE -> Map DW_TAG [DIE] -> Map DW_TAG [DIE])
-> Map DW_TAG [DIE] -> [DIE] -> Map DW_TAG [DIE]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\DIE
d' -> ([DIE] -> [DIE] -> [DIE])
-> DW_TAG -> [DIE] -> Map DW_TAG [DIE] -> Map DW_TAG [DIE]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\[DIE]
_ [DIE]
o -> DIE
d' DIE -> [DIE] -> [DIE]
forall a. a -> [a] -> [a]
: [DIE]
o) (DIE -> DW_TAG
dieTag DIE
d') [DIE
d']) Map DW_TAG [DIE]
forall k a. Map k a
Map.empty (DIE -> [DIE]
dieChildren DIE
d)
        attrMap :: Map DW_AT [DW_ATVAL]
attrMap = ((DW_AT, DW_ATVAL) -> Map DW_AT [DW_ATVAL] -> Map DW_AT [DW_ATVAL])
-> Map DW_AT [DW_ATVAL]
-> [(DW_AT, DW_ATVAL)]
-> Map DW_AT [DW_ATVAL]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\(DW_AT
k, DW_ATVAL
v) -> ([DW_ATVAL] -> [DW_ATVAL] -> [DW_ATVAL])
-> DW_AT
-> [DW_ATVAL]
-> Map DW_AT [DW_ATVAL]
-> Map DW_AT [DW_ATVAL]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [DW_ATVAL] -> [DW_ATVAL] -> [DW_ATVAL]
forall a. [a] -> [a] -> [a]
(++) DW_AT
k [DW_ATVAL
v]) Map DW_AT [DW_ATVAL]
forall k a. Map k a
Map.empty (DIE -> [(DW_AT, DW_ATVAL)]
dieAttributes DIE
d)
        s0 :: DIEParserState
s0 =
          DPS
            { dpsDIE :: DIE
dpsDIE = DIE
d,
              dpsAttributeMap :: Map DW_AT [DW_ATVAL]
dpsAttributeMap = Map DW_AT [DW_ATVAL]
attrMap,
              _dpsSeenAttributes :: Set DW_AT
_dpsSeenAttributes = DW_AT -> Set DW_AT
forall a. a -> Set a
Set.singleton DW_AT
DW_AT_sibling,
              dpsChildrenMap :: Map DW_TAG [DIE]
dpsChildrenMap = Map DW_TAG [DIE]
childMap,
              _dpsSeenChildren :: Set DW_TAG
_dpsSeenChildren = Set DW_TAG
forall a. Set a
Set.empty
            }
    (r
r, DIEParserState
s1) <- DIEParser r -> DIEParserState -> Parser (r, DIEParserState)
forall s (m :: Type -> Type) a. StateT s m a -> s -> m (a, s)
runStateT DIEParser r
act DIEParserState
s0
    do
      let missingTags :: Set DW_TAG
missingTags = Map DW_TAG [DIE] -> Set DW_TAG
forall k a. Map k a -> Set k
Map.keysSet Map DW_TAG [DIE]
childMap Set DW_TAG -> Set DW_TAG -> Set DW_TAG
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` (DIEParserState
s1 DIEParserState
-> Getting (Set DW_TAG) DIEParserState (Set DW_TAG) -> Set DW_TAG
forall s a. s -> Getting a s a -> a
^. Getting (Set DW_TAG) DIEParserState (Set DW_TAG)
Lens' DIEParserState (Set DW_TAG)
dpsSeenChildren)
      Bool -> Parser () -> Parser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Set DW_TAG -> Bool
forall a. Set a -> Bool
Set.null Set DW_TAG
missingTags)) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
        [DIE] -> (DIE -> Parser ()) -> Parser ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DIE -> [DIE]
dieChildren DIE
d) ((DIE -> Parser ()) -> Parser ())
-> (DIE -> Parser ()) -> Parser ()
forall a b. (a -> b) -> a -> b
$ \DIE
child -> do
          Bool -> Parser () -> Parser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (DW_TAG -> Set DW_TAG -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (DIE -> DW_TAG
dieTag DIE
child) (DIEParserState
s1 DIEParserState
-> Getting (Set DW_TAG) DIEParserState (Set DW_TAG) -> Set DW_TAG
forall s a. s -> Getting a s a -> a
^. Getting (Set DW_TAG) DIEParserState (Set DW_TAG)
Lens' DIEParserState (Set DW_TAG)
dpsSeenChildren))) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
            String -> Parser ()
forall s (m :: Type -> Type). WarnMonad s m => s -> m ()
warn (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected child for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
child
    do
      let missingAttrs :: Set DW_AT
missingAttrs = Map DW_AT [DW_ATVAL] -> Set DW_AT
forall k a. Map k a -> Set k
Map.keysSet Map DW_AT [DW_ATVAL]
attrMap Set DW_AT -> Set DW_AT -> Set DW_AT
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` (DIEParserState
s1 DIEParserState
-> Getting (Set DW_AT) DIEParserState (Set DW_AT) -> Set DW_AT
forall s a. s -> Getting a s a -> a
^. Getting (Set DW_AT) DIEParserState (Set DW_AT)
Lens' DIEParserState (Set DW_AT)
dpsSeenAttributes)
      Bool -> Parser () -> Parser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Set DW_AT -> Bool
forall a. Set a -> Bool
Set.null Set DW_AT
missingAttrs)) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
        String -> Parser ()
forall s (m :: Type -> Type). WarnMonad s m => s -> m ()
warn (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected attributes: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [DW_AT] -> String
forall a. Show a => a -> String
show (Set DW_AT -> [DW_AT]
forall a. Set a -> [a]
Set.toList Set DW_AT
missingAttrs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
d
    r -> Parser r
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure r
r

checkTag :: DW_TAG -> DIEParser ()
checkTag :: DW_TAG -> DIEParser ()
checkTag DW_TAG
tag = do
  DIE
d <- (DIEParserState -> DIE) -> StateT DIEParserState Parser DIE
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> DIE
dpsDIE
  Parser () -> DIEParser ()
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser () -> DIEParser ()) -> Parser () -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Parser () -> Parser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DIE -> DW_TAG
dieTag DIE
d DW_TAG -> DW_TAG -> Bool
forall a. Eq a => a -> a -> Bool
/= DW_TAG
tag) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall s (m :: Type -> Type). WarnMonad s m => s -> m ()
warn (String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_TAG -> String
forall a. Show a => a -> String
show DW_TAG
tag)

ignoreAttribute :: DW_AT -> DIEParser ()
ignoreAttribute :: DW_AT -> DIEParser ()
ignoreAttribute DW_AT
dat = do
  (Set DW_AT -> Identity (Set DW_AT))
-> DIEParserState -> Identity DIEParserState
Lens' DIEParserState (Set DW_AT)
dpsSeenAttributes ((Set DW_AT -> Identity (Set DW_AT))
 -> DIEParserState -> Identity DIEParserState)
-> (Set DW_AT -> Set DW_AT) -> DIEParser ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= DW_AT -> Set DW_AT -> Set DW_AT
forall a. Ord a => a -> Set a -> Set a
Set.insert DW_AT
dat

ignoreChild :: DW_TAG -> DIEParser ()
ignoreChild :: DW_TAG -> DIEParser ()
ignoreChild DW_TAG
dat = do
  (Set DW_TAG -> Identity (Set DW_TAG))
-> DIEParserState -> Identity DIEParserState
Lens' DIEParserState (Set DW_TAG)
dpsSeenChildren ((Set DW_TAG -> Identity (Set DW_TAG))
 -> DIEParserState -> Identity DIEParserState)
-> (Set DW_TAG -> Set DW_TAG) -> DIEParser ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= DW_TAG -> Set DW_TAG -> Set DW_TAG
forall a. Ord a => a -> Set a -> Set a
Set.insert DW_TAG
dat

getSingleAttribute :: DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute :: forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
dat AttrParser v
p = do
  DIE
d <- (DIEParserState -> DIE) -> StateT DIEParserState Parser DIE
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> DIE
dpsDIE
  Map DW_AT [DW_ATVAL]
m <- (DIEParserState -> Map DW_AT [DW_ATVAL])
-> StateT DIEParserState Parser (Map DW_AT [DW_ATVAL])
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> Map DW_AT [DW_ATVAL]
dpsAttributeMap
  case [DW_ATVAL] -> DW_AT -> Map DW_AT [DW_ATVAL] -> [DW_ATVAL]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] DW_AT
dat Map DW_AT [DW_ATVAL]
m of
    [] -> String -> DIEParser v
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser v) -> String -> DIEParser v
forall a b. (a -> b) -> a -> b
$ String
"Expected attribute " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_AT -> String
forall a. Show a => a -> String
show DW_AT
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    [DW_ATVAL
v] -> do
      DW_AT -> DIEParser ()
ignoreAttribute DW_AT
dat
      Parser v -> DIEParser v
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser v -> DIEParser v) -> Parser v -> DIEParser v
forall a b. (a -> b) -> a -> b
$ DW_AT -> AttrParser v -> DW_ATVAL -> Parser v
forall r. DW_AT -> AttrParser r -> DW_ATVAL -> Parser r
convertAttribute DW_AT
dat AttrParser v
p DW_ATVAL
v
    [DW_ATVAL]
_ -> String -> DIEParser v
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser v) -> String -> DIEParser v
forall a b. (a -> b) -> a -> b
$ String
"Found multiple attributes for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_AT -> String
forall a. Show a => a -> String
show DW_AT
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

getAttributeWithDefault :: DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault :: forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
dat v
def AttrParser v
f = do
  DIE
d <- (DIEParserState -> DIE) -> StateT DIEParserState Parser DIE
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> DIE
dpsDIE
  Map DW_AT [DW_ATVAL]
m <- (DIEParserState -> Map DW_AT [DW_ATVAL])
-> StateT DIEParserState Parser (Map DW_AT [DW_ATVAL])
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> Map DW_AT [DW_ATVAL]
dpsAttributeMap
  case [DW_ATVAL] -> DW_AT -> Map DW_AT [DW_ATVAL] -> [DW_ATVAL]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] DW_AT
dat Map DW_AT [DW_ATVAL]
m of
    [] -> do
      DW_AT -> DIEParser ()
ignoreAttribute DW_AT
dat
      v -> DIEParser v
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure v
def
    [DW_ATVAL
v] -> do
      DW_AT -> DIEParser ()
ignoreAttribute DW_AT
dat
      Parser v -> DIEParser v
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser v -> DIEParser v) -> Parser v -> DIEParser v
forall a b. (a -> b) -> a -> b
$ DW_AT -> AttrParser v -> DW_ATVAL -> Parser v
forall r. DW_AT -> AttrParser r -> DW_ATVAL -> Parser r
convertAttribute DW_AT
dat AttrParser v
f DW_ATVAL
v
    [DW_ATVAL]
_ -> String -> DIEParser v
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser v) -> String -> DIEParser v
forall a b. (a -> b) -> a -> b
$ String
"Found multiple attributes for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_AT -> String
forall a. Show a => a -> String
show DW_AT
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

getMaybeAttribute :: DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute :: forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
dat AttrParser v
f = do
  DIE
d <- (DIEParserState -> DIE) -> StateT DIEParserState Parser DIE
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> DIE
dpsDIE
  Map DW_AT [DW_ATVAL]
m <- (DIEParserState -> Map DW_AT [DW_ATVAL])
-> StateT DIEParserState Parser (Map DW_AT [DW_ATVAL])
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> Map DW_AT [DW_ATVAL]
dpsAttributeMap
  case [DW_ATVAL] -> DW_AT -> Map DW_AT [DW_ATVAL] -> [DW_ATVAL]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] DW_AT
dat Map DW_AT [DW_ATVAL]
m of
    [] -> do
      DW_AT -> DIEParser ()
ignoreAttribute DW_AT
dat
      Maybe v -> DIEParser (Maybe v)
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing
    [DW_ATVAL
v] -> do
      DW_AT -> DIEParser ()
ignoreAttribute DW_AT
dat
      Parser (Maybe v) -> DIEParser (Maybe v)
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (Maybe v) -> DIEParser (Maybe v))
-> Parser (Maybe v) -> DIEParser (Maybe v)
forall a b. (a -> b) -> a -> b
$ v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v) -> Parser v -> Parser (Maybe v)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DW_AT -> AttrParser v -> DW_ATVAL -> Parser v
forall r. DW_AT -> AttrParser r -> DW_ATVAL -> Parser r
convertAttribute DW_AT
dat AttrParser v
f DW_ATVAL
v
    [DW_ATVAL]
_ -> String -> DIEParser (Maybe v)
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser (Maybe v)) -> String -> DIEParser (Maybe v)
forall a b. (a -> b) -> a -> b
$ String
"Found multiple attributes for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_AT -> String
forall a. Show a => a -> String
show DW_AT
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

parseChildrenList :: DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList :: forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
tag DIE -> Parser v
f = do
  DW_TAG -> DIEParser ()
ignoreChild DW_TAG
tag
  Map DW_TAG [DIE]
m <- (DIEParserState -> Map DW_TAG [DIE])
-> StateT DIEParserState Parser (Map DW_TAG [DIE])
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> Map DW_TAG [DIE]
dpsChildrenMap
  Parser [v] -> DIEParser [v]
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser [v] -> DIEParser [v]) -> Parser [v] -> DIEParser [v]
forall a b. (a -> b) -> a -> b
$ (DIE -> Parser v) -> [DIE] -> Parser [v]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse DIE -> Parser v
f ([DIE] -> Parser [v]) -> [DIE] -> Parser [v]
forall a b. (a -> b) -> a -> b
$ [DIE] -> DW_TAG -> Map DW_TAG [DIE] -> [DIE]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] DW_TAG
tag Map DW_TAG [DIE]
m

hasChildren :: DW_TAG -> DIEParser Bool
hasChildren :: DW_TAG -> DIEParser Bool
hasChildren DW_TAG
tag = do
  DW_TAG -> DIEParser ()
ignoreChild DW_TAG
tag
  (DIEParserState -> Bool) -> DIEParser Bool
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets ((DIEParserState -> Bool) -> DIEParser Bool)
-> (DIEParserState -> Bool) -> DIEParser Bool
forall a b. (a -> b) -> a -> b
$ DW_TAG -> Map DW_TAG [DIE] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member DW_TAG
tag (Map DW_TAG [DIE] -> Bool)
-> (DIEParserState -> Map DW_TAG [DIE]) -> DIEParserState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DIEParserState -> Map DW_TAG [DIE]
dpsChildrenMap

------------------------------------------------------------------------
-- DeclLoc

-- | Type synonym for file paths in Dwarf
--
-- The empty string denotes no file.
newtype DwarfFilePath = DwarfFilePath {DwarfFilePath -> ByteString
filePathVal :: BS.ByteString}
  deriving (DwarfFilePath -> DwarfFilePath -> Bool
(DwarfFilePath -> DwarfFilePath -> Bool)
-> (DwarfFilePath -> DwarfFilePath -> Bool) -> Eq DwarfFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DwarfFilePath -> DwarfFilePath -> Bool
== :: DwarfFilePath -> DwarfFilePath -> Bool
$c/= :: DwarfFilePath -> DwarfFilePath -> Bool
/= :: DwarfFilePath -> DwarfFilePath -> Bool
Eq, String -> DwarfFilePath
(String -> DwarfFilePath) -> IsString DwarfFilePath
forall a. (String -> a) -> IsString a
$cfromString :: String -> DwarfFilePath
fromString :: String -> DwarfFilePath
IsString)

instance Show DwarfFilePath where
  show :: DwarfFilePath -> String
show = ByteString -> String
BSC.unpack (ByteString -> String)
-> (DwarfFilePath -> ByteString) -> DwarfFilePath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DwarfFilePath -> ByteString
filePathVal

instance Pretty DwarfFilePath where
  pretty :: forall ann. DwarfFilePath -> Doc ann
pretty = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann)
-> (DwarfFilePath -> String) -> DwarfFilePath -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack (ByteString -> String)
-> (DwarfFilePath -> ByteString) -> DwarfFilePath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DwarfFilePath -> ByteString
filePathVal

-- | File vector read from line-number information.
type FileVec = V.Vector DwarfFilePath

-- | A file and line number for a declaration.
data DeclLoc = DeclLoc
  { DeclLoc -> DwarfFilePath
locFile :: !DwarfFilePath,
    DeclLoc -> Word64
locLine :: !Word64,
    DeclLoc -> Word64
locColumn :: !Word64
  }

instance Pretty DeclLoc where
  pretty :: forall ann. DeclLoc -> Doc ann
pretty DeclLoc
loc =
    let file :: Doc ann
file
          | DeclLoc -> DwarfFilePath
locFile DeclLoc
loc DwarfFilePath -> DwarfFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== DwarfFilePath
"" = Doc ann
forall ann. Doc ann
emptyDoc
          | Bool
otherwise = Doc ann
"decl_file:   " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DwarfFilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DwarfFilePath -> Doc ann
pretty (DeclLoc -> DwarfFilePath
locFile DeclLoc
loc) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line
        lne :: Doc ann
lne
          | DeclLoc -> Word64
locLine DeclLoc
loc Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Doc ann
forall ann. Doc ann
emptyDoc
          | Bool
otherwise = Doc ann
"decl_line:   " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word64 -> Doc ann
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (DeclLoc -> Word64
locLine DeclLoc
loc) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line
        col :: Doc ann
col
          | DeclLoc -> Word64
locColumn DeclLoc
loc Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Doc ann
forall ann. Doc ann
emptyDoc
          | Bool
otherwise = Doc ann
"decl_column: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word64 -> Doc ann
forall ann. Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (DeclLoc -> Word64
locColumn DeclLoc
loc) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line
     in Doc ann
file Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
lne Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
col

instance Show DeclLoc where
  show :: DeclLoc -> String
show = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (DeclLoc -> Doc Any) -> DeclLoc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeclLoc -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. DeclLoc -> Doc ann
pretty

attributeAsFile :: FileVec -> AttrParser DwarfFilePath
attributeAsFile :: FileVec -> AttrParser DwarfFilePath
attributeAsFile FileVec
fileVec Reader
_ (DW_ATVAL_UINT Word64
i) =
  if Word64
i Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
    then DwarfFilePath -> ExceptT AttrError Identity DwarfFilePath
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DwarfFilePath
""
    else
      if Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger (FileVec -> Int
forall a. Vector a -> Int
V.length FileVec
fileVec)
        then DwarfFilePath -> ExceptT AttrError Identity DwarfFilePath
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (DwarfFilePath -> ExceptT AttrError Identity DwarfFilePath)
-> DwarfFilePath -> ExceptT AttrError Identity DwarfFilePath
forall a b. (a -> b) -> a -> b
$! FileVec
fileVec FileVec -> Int -> DwarfFilePath
forall a. Vector a -> Int -> a
V.! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
1)
        else AttrError -> ExceptT AttrError Identity DwarfFilePath
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity DwarfFilePath)
-> AttrError -> ExceptT AttrError Identity DwarfFilePath
forall a b. (a -> b) -> a -> b
$ Word64 -> AttrError
InvalidFileIndex Word64
i
attributeAsFile FileVec
_ Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity DwarfFilePath
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity DwarfFilePath)
-> AttrError -> ExceptT AttrError Identity DwarfFilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"file path"

-- | Read the decl_file and decl_line attributes from the DIE
parseDeclLoc :: FileVec -> DIEParser DeclLoc
parseDeclLoc :: FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec = do
  DwarfFilePath
declFile <- DW_AT
-> DwarfFilePath
-> AttrParser DwarfFilePath
-> DIEParser DwarfFilePath
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_decl_file DwarfFilePath
"" (FileVec -> AttrParser DwarfFilePath
attributeAsFile FileVec
fileVec)
  Word64
declLine <- DW_AT -> Word64 -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_decl_line Word64
0 AttrParser Word64
attributeAsUInt
  Word64
declCol <- DW_AT -> Word64 -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_decl_column Word64
0 AttrParser Word64
attributeAsUInt
  DeclLoc -> DIEParser DeclLoc
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    (DeclLoc -> DIEParser DeclLoc) -> DeclLoc -> DIEParser DeclLoc
forall a b. (a -> b) -> a -> b
$! DeclLoc
      { locFile :: DwarfFilePath
locFile = DwarfFilePath
declFile,
        locLine :: Word64
locLine = Word64
declLine,
        locColumn :: Word64
locColumn = Word64
declCol
      }

------------------------------------------------------------------------
-- DW_OP operations

ppOp :: DW_OP -> Doc ann
ppOp :: forall ann. DW_OP -> Doc ann
ppOp (DW_OP_addr Word64
w) | Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0 = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
w String
"")
ppOp DW_OP
o = DW_OP -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow DW_OP
o

ppOps :: [DW_OP] -> Doc ann
ppOps :: forall ann. [DW_OP] -> Doc ann
ppOps [DW_OP]
l = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (DW_OP -> Doc ann
forall ann. DW_OP -> Doc ann
ppOp (DW_OP -> Doc ann) -> [DW_OP] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [DW_OP]
l)

------------------------------------------------------------------------
-- Name and Descripion

newtype Name = Name {Name -> ByteString
nameVal :: BS.ByteString}
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord)

instance IsString Name where
  fromString :: String -> Name
fromString = ByteString -> Name
Name (ByteString -> Name) -> (String -> ByteString) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC.pack

instance Pretty Name where
  pretty :: forall ann. Name -> Doc ann
pretty = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (Name -> String) -> Name -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack (ByteString -> String) -> (Name -> ByteString) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ByteString
nameVal

instance Show Name where
  show :: Name -> String
show = ByteString -> String
BSC.unpack (ByteString -> String) -> (Name -> ByteString) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ByteString
nameVal

-- | The value of a `DW_AT_description` field.
--
-- Note. This is the empty string if th
newtype Description = Description {Description -> ByteString
descriptionVal :: BS.ByteString}

instance Show Description where
  show :: Description -> String
show = ByteString -> String
BSC.unpack (ByteString -> String)
-> (Description -> ByteString) -> Description -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Description -> ByteString
descriptionVal

-- | Get name and description.
--
-- If name of description is missing, the empty string is returned.
getNameAndDescription :: DIEParser (Name, Description)
getNameAndDescription :: DIEParser (Name, Description)
getNameAndDescription = do
  (,) (Name -> Description -> (Name, Description))
-> StateT DIEParserState Parser Name
-> StateT
     DIEParserState Parser (Description -> (Name, Description))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Name
Name (ByteString -> Name)
-> StateT DIEParserState Parser ByteString
-> StateT DIEParserState Parser Name
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DW_AT
-> ByteString
-> AttrParser ByteString
-> StateT DIEParserState Parser ByteString
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_name ByteString
BS.empty AttrParser ByteString
attributeAsString)
    StateT DIEParserState Parser (Description -> (Name, Description))
-> StateT DIEParserState Parser Description
-> DIEParser (Name, Description)
forall a b.
StateT DIEParserState Parser (a -> b)
-> StateT DIEParserState Parser a -> StateT DIEParserState Parser b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (ByteString -> Description
Description (ByteString -> Description)
-> StateT DIEParserState Parser ByteString
-> StateT DIEParserState Parser Description
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DW_AT
-> ByteString
-> AttrParser ByteString
-> StateT DIEParserState Parser ByteString
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_description ByteString
BS.empty AttrParser ByteString
attributeAsString)

------------------------------------------------------------------------
-- ConstValue

data ConstValue
  = ConstBlob BS.ByteString
  | ConstInt Int64
  | ConstUInt Word64
  | -- | A string of bytes that was originally null-terminated.
    --
    -- Note. The null terminator was removed and does not appear
    -- in the Haskell `ByteString`.
    ConstString BS.ByteString
  deriving (Int -> ConstValue -> String -> String
[ConstValue] -> String -> String
ConstValue -> String
(Int -> ConstValue -> String -> String)
-> (ConstValue -> String)
-> ([ConstValue] -> String -> String)
-> Show ConstValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ConstValue -> String -> String
showsPrec :: Int -> ConstValue -> String -> String
$cshow :: ConstValue -> String
show :: ConstValue -> String
$cshowList :: [ConstValue] -> String -> String
showList :: [ConstValue] -> String -> String
Show)

attributeConstValue :: AttrParser ConstValue
attributeConstValue :: AttrParser ConstValue
attributeConstValue Reader
_ DW_ATVAL
v =
  case DW_ATVAL
v of
    DW_ATVAL_BLOB ByteString
x -> ConstValue -> Except AttrError ConstValue
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ConstValue -> Except AttrError ConstValue)
-> ConstValue -> Except AttrError ConstValue
forall a b. (a -> b) -> a -> b
$! ByteString -> ConstValue
ConstBlob ByteString
x
    DW_ATVAL_INT ByteOffset
x -> ConstValue -> Except AttrError ConstValue
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ConstValue -> Except AttrError ConstValue)
-> ConstValue -> Except AttrError ConstValue
forall a b. (a -> b) -> a -> b
$! ByteOffset -> ConstValue
ConstInt ByteOffset
x
    DW_ATVAL_UINT Word64
x -> ConstValue -> Except AttrError ConstValue
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ConstValue -> Except AttrError ConstValue)
-> ConstValue -> Except AttrError ConstValue
forall a b. (a -> b) -> a -> b
$! Word64 -> ConstValue
ConstUInt Word64
x
    DW_ATVAL_STRING ByteString
x -> ConstValue -> Except AttrError ConstValue
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ConstValue -> Except AttrError ConstValue)
-> ConstValue -> Except AttrError ConstValue
forall a b. (a -> b) -> a -> b
$! ByteString -> ConstValue
ConstString ByteString
x
    DW_ATVAL
_ -> AttrError -> Except AttrError ConstValue
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> Except AttrError ConstValue)
-> AttrError -> Except AttrError ConstValue
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"const value"

getConstValue :: DIEParser (Maybe ConstValue)
getConstValue :: DIEParser (Maybe ConstValue)
getConstValue = DW_AT -> AttrParser ConstValue -> DIEParser (Maybe ConstValue)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_const_value AttrParser ConstValue
attributeConstValue

------------------------------------------------------------------------
-- TypeRef

-- | A reference to a type DIE
newtype TypeRef = TypeRef DieID
  deriving (TypeRef -> TypeRef -> Bool
(TypeRef -> TypeRef -> Bool)
-> (TypeRef -> TypeRef -> Bool) -> Eq TypeRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeRef -> TypeRef -> Bool
== :: TypeRef -> TypeRef -> Bool
$c/= :: TypeRef -> TypeRef -> Bool
/= :: TypeRef -> TypeRef -> Bool
Eq, Eq TypeRef
Eq TypeRef =>
(TypeRef -> TypeRef -> Ordering)
-> (TypeRef -> TypeRef -> Bool)
-> (TypeRef -> TypeRef -> Bool)
-> (TypeRef -> TypeRef -> Bool)
-> (TypeRef -> TypeRef -> Bool)
-> (TypeRef -> TypeRef -> TypeRef)
-> (TypeRef -> TypeRef -> TypeRef)
-> Ord TypeRef
TypeRef -> TypeRef -> Bool
TypeRef -> TypeRef -> Ordering
TypeRef -> TypeRef -> TypeRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeRef -> TypeRef -> Ordering
compare :: TypeRef -> TypeRef -> Ordering
$c< :: TypeRef -> TypeRef -> Bool
< :: TypeRef -> TypeRef -> Bool
$c<= :: TypeRef -> TypeRef -> Bool
<= :: TypeRef -> TypeRef -> Bool
$c> :: TypeRef -> TypeRef -> Bool
> :: TypeRef -> TypeRef -> Bool
$c>= :: TypeRef -> TypeRef -> Bool
>= :: TypeRef -> TypeRef -> Bool
$cmax :: TypeRef -> TypeRef -> TypeRef
max :: TypeRef -> TypeRef -> TypeRef
$cmin :: TypeRef -> TypeRef -> TypeRef
min :: TypeRef -> TypeRef -> TypeRef
Ord, Int -> TypeRef -> String -> String
[TypeRef] -> String -> String
TypeRef -> String
(Int -> TypeRef -> String -> String)
-> (TypeRef -> String)
-> ([TypeRef] -> String -> String)
-> Show TypeRef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TypeRef -> String -> String
showsPrec :: Int -> TypeRef -> String -> String
$cshow :: TypeRef -> String
show :: TypeRef -> String
$cshowList :: [TypeRef] -> String -> String
showList :: [TypeRef] -> String -> String
Show)

-- | Return the offset asssociated with the type.
typeRefFileOffset :: TypeRef -> Word64
typeRefFileOffset :: TypeRef -> Word64
typeRefFileOffset (TypeRef DieID
o) = DieID -> Word64
dieID DieID
o

instance Pretty TypeRef where
  pretty :: forall ann. TypeRef -> Doc ann
pretty TypeRef
r = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex (TypeRef -> Word64
typeRefFileOffset TypeRef
r) String
"")

------------------------------------------------------------------------
-- Enumerator

data Enumerator = Enumerator
  { Enumerator -> Name
enumName :: !Name,
    Enumerator -> Description
enumDescription :: !Description,
    Enumerator -> ConstValue
enumValue :: !ConstValue
  }
  deriving (Int -> Enumerator -> String -> String
[Enumerator] -> String -> String
Enumerator -> String
(Int -> Enumerator -> String -> String)
-> (Enumerator -> String)
-> ([Enumerator] -> String -> String)
-> Show Enumerator
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Enumerator -> String -> String
showsPrec :: Int -> Enumerator -> String -> String
$cshow :: Enumerator -> String
show :: Enumerator -> String
$cshowList :: [Enumerator] -> String -> String
showList :: [Enumerator] -> String -> String
Show)

parseEnumerator :: DIE -> Parser Enumerator
parseEnumerator :: DIE -> Parser Enumerator
parseEnumerator DIE
d = String -> DIE -> DIEParser Enumerator -> Parser Enumerator
forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
"parseEnumerator" DIE
d (DIEParser Enumerator -> Parser Enumerator)
-> DIEParser Enumerator -> Parser Enumerator
forall a b. (a -> b) -> a -> b
$ do
  DW_TAG -> DIEParser ()
checkTag DW_TAG
DW_TAG_enumerator
  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  ConstValue
val <- DW_AT -> AttrParser ConstValue -> DIEParser ConstValue
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_const_value AttrParser ConstValue
attributeConstValue
  Enumerator -> DIEParser Enumerator
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    Enumerator
      { enumName :: Name
enumName = Name
name,
        enumDescription :: Description
enumDescription = Description
desc,
        enumValue :: ConstValue
enumValue = ConstValue
val
      }

------------------------------------------------------------------------
-- Subrange

data Subrange tp = Subrange
  { forall tp. Subrange tp -> tp
subrangeType :: tp,
    forall tp. Subrange tp -> [DW_OP]
subrangeUpperBound :: [DW_OP]
  }
  deriving (Int -> Subrange tp -> String -> String
[Subrange tp] -> String -> String
Subrange tp -> String
(Int -> Subrange tp -> String -> String)
-> (Subrange tp -> String)
-> ([Subrange tp] -> String -> String)
-> Show (Subrange tp)
forall tp. Show tp => Int -> Subrange tp -> String -> String
forall tp. Show tp => [Subrange tp] -> String -> String
forall tp. Show tp => Subrange tp -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall tp. Show tp => Int -> Subrange tp -> String -> String
showsPrec :: Int -> Subrange tp -> String -> String
$cshow :: forall tp. Show tp => Subrange tp -> String
show :: Subrange tp -> String
$cshowList :: forall tp. Show tp => [Subrange tp] -> String -> String
showList :: [Subrange tp] -> String -> String
Show)

--subrangeTypeLens :: Lens (Subrange a) (Subrange b) a b
--subrangeTypeLens = lens subrangeType (\s v -> s { subrangeType = v })

parseSubrange :: DIE -> Parser (Subrange TypeRef)
parseSubrange :: DIE -> Parser (Subrange TypeRef)
parseSubrange DIE
d = String
-> DIE -> DIEParser (Subrange TypeRef) -> Parser (Subrange TypeRef)
forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
"parseSubrange" DIE
d (DIEParser (Subrange TypeRef) -> Parser (Subrange TypeRef))
-> DIEParser (Subrange TypeRef) -> Parser (Subrange TypeRef)
forall a b. (a -> b) -> a -> b
$ do
  Reader
dr <- Parser Reader -> StateT DIEParserState Parser Reader
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Reader -> StateT DIEParserState Parser Reader)
-> Parser Reader -> StateT DIEParserState Parser Reader
forall a b. (a -> b) -> a -> b
$ ReaderT ParserState (WarnT String Identity) Reader -> Parser Reader
forall r. ReaderT ParserState (WarnT String Identity) r -> Parser r
Parser (ReaderT ParserState (WarnT String Identity) Reader
 -> Parser Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
-> Parser Reader
forall a b. (a -> b) -> a -> b
$ (ParserState -> Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks ParserState -> Reader
readerInfo
  TypeRef
tp <- DW_AT -> AttrParser TypeRef -> DIEParser TypeRef
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef
  DW_ATVAL
upperVal <- DW_AT -> AttrParser DW_ATVAL -> DIEParser DW_ATVAL
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_upper_bound AttrParser DW_ATVAL
attributeValue

  [DW_OP]
upper <-
    case DW_ATVAL
upperVal of
      DW_ATVAL_UINT Word64
w -> [DW_OP] -> StateT DIEParserState Parser [DW_OP]
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Word64 -> DW_OP
DW_OP_const8u Word64
w]
      DW_ATVAL_BLOB ByteString
bs ->
        case Reader
-> ByteString -> Either ([DW_OP], ByteOffset, String) [DW_OP]
parseDW_OPs Reader
dr ByteString
bs of
          Left ([DW_OP]
_, ByteOffset
_, String
msg) -> String -> StateT DIEParserState Parser [DW_OP]
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError String
msg
          Right [DW_OP]
ops -> [DW_OP] -> StateT DIEParserState Parser [DW_OP]
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [DW_OP]
ops
      DW_ATVAL
_ -> String -> StateT DIEParserState Parser [DW_OP]
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError String
"Invalid upper bound"

  Subrange TypeRef -> DIEParser (Subrange TypeRef)
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    (Subrange TypeRef -> DIEParser (Subrange TypeRef))
-> Subrange TypeRef -> DIEParser (Subrange TypeRef)
forall a b. (a -> b) -> a -> b
$! Subrange
      { subrangeType :: TypeRef
subrangeType = TypeRef
tp,
        subrangeUpperBound :: [DW_OP]
subrangeUpperBound = [DW_OP]
upper
      }

------------------------------------------------------------------------
-- Type

data Member = Member
  { Member -> Name
memberName :: !Name,
    Member -> Description
memberDescription :: !Description,
    Member -> DeclLoc
memberDeclLoc :: !DeclLoc,
    Member -> Maybe Word64
memberLoc :: !(Maybe Word64),
    Member -> TypeRef
memberType :: !TypeRef,
    Member -> Bool
memberArtificial :: !Bool,
    Member -> Maybe Word64
memberByteSize :: !(Maybe Word64),
    Member -> Maybe Word64
memberBitOffset :: !(Maybe Word64),
    Member -> Maybe Word64
memberBitSize :: !(Maybe Word64)
  }
  deriving (Int -> Member -> String -> String
[Member] -> String -> String
Member -> String
(Int -> Member -> String -> String)
-> (Member -> String)
-> ([Member] -> String -> String)
-> Show Member
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Member -> String -> String
showsPrec :: Int -> Member -> String -> String
$cshow :: Member -> String
show :: Member -> String
$cshowList :: [Member] -> String -> String
showList :: [Member] -> String -> String
Show)

data StructDecl = StructDecl
  { StructDecl -> Name
structName :: !Name,
    StructDecl -> Description
structDescription :: !Description,
    StructDecl -> Word64
structByteSize :: !Word64,
    StructDecl -> DeclLoc
structLoc :: !DeclLoc,
    StructDecl -> [Member]
structMembers :: ![Member]
  }
  deriving (Int -> StructDecl -> String -> String
[StructDecl] -> String -> String
StructDecl -> String
(Int -> StructDecl -> String -> String)
-> (StructDecl -> String)
-> ([StructDecl] -> String -> String)
-> Show StructDecl
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> StructDecl -> String -> String
showsPrec :: Int -> StructDecl -> String -> String
$cshow :: StructDecl -> String
show :: StructDecl -> String
$cshowList :: [StructDecl] -> String -> String
showList :: [StructDecl] -> String -> String
Show)

data UnionDecl = UnionDecl
  { UnionDecl -> Name
unionName :: !Name,
    UnionDecl -> Description
unionDescription :: !Description,
    UnionDecl -> Word64
unionByteSize :: !Word64,
    UnionDecl -> DeclLoc
unionLoc :: !DeclLoc,
    UnionDecl -> [Member]
unionMembers :: ![Member]
  }
  deriving (Int -> UnionDecl -> String -> String
[UnionDecl] -> String -> String
UnionDecl -> String
(Int -> UnionDecl -> String -> String)
-> (UnionDecl -> String)
-> ([UnionDecl] -> String -> String)
-> Show UnionDecl
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UnionDecl -> String -> String
showsPrec :: Int -> UnionDecl -> String -> String
$cshow :: UnionDecl -> String
show :: UnionDecl -> String
$cshowList :: [UnionDecl] -> String -> String
showList :: [UnionDecl] -> String -> String
Show)

data EnumDecl = EnumDecl
  { EnumDecl -> Name
enumDeclName :: !Name,
    EnumDecl -> Description
enumDeclDescription :: !Description,
    EnumDecl -> Word64
enumDeclByteSize :: !Word64,
    EnumDecl -> DeclLoc
enumDeclLoc :: !DeclLoc,
    -- | The underlying type of an enum.
    EnumDecl -> Maybe TypeRef
enumDeclType :: !(Maybe TypeRef),
    EnumDecl -> [Enumerator]
enumDeclCases :: ![Enumerator]
  }
  deriving (Int -> EnumDecl -> String -> String
[EnumDecl] -> String -> String
EnumDecl -> String
(Int -> EnumDecl -> String -> String)
-> (EnumDecl -> String)
-> ([EnumDecl] -> String -> String)
-> Show EnumDecl
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> EnumDecl -> String -> String
showsPrec :: Int -> EnumDecl -> String -> String
$cshow :: EnumDecl -> String
show :: EnumDecl -> String
$cshowList :: [EnumDecl] -> String -> String
showList :: [EnumDecl] -> String -> String
Show)

data SubroutineTypeDecl = SubroutineTypeDecl
  { SubroutineTypeDecl -> Maybe Bool
fntypePrototyped :: !(Maybe Bool),
    SubroutineTypeDecl -> [Variable]
fntypeFormals :: ![Variable],
    SubroutineTypeDecl -> Maybe TypeRef
fntypeType :: !(Maybe TypeRef)
  }
  deriving (Int -> SubroutineTypeDecl -> String -> String
[SubroutineTypeDecl] -> String -> String
SubroutineTypeDecl -> String
(Int -> SubroutineTypeDecl -> String -> String)
-> (SubroutineTypeDecl -> String)
-> ([SubroutineTypeDecl] -> String -> String)
-> Show SubroutineTypeDecl
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SubroutineTypeDecl -> String -> String
showsPrec :: Int -> SubroutineTypeDecl -> String -> String
$cshow :: SubroutineTypeDecl -> String
show :: SubroutineTypeDecl -> String
$cshowList :: [SubroutineTypeDecl] -> String -> String
showList :: [SubroutineTypeDecl] -> String -> String
Show)

data Typedef = Typedef
  { Typedef -> Name
typedefName :: !Name,
    Typedef -> Description
typedefDescription :: !Description,
    Typedef -> DeclLoc
typedefLoc :: !DeclLoc,
    Typedef -> TypeRef
typedefType :: !TypeRef
  }
  deriving (Int -> Typedef -> String -> String
[Typedef] -> String -> String
Typedef -> String
(Int -> Typedef -> String -> String)
-> (Typedef -> String)
-> ([Typedef] -> String -> String)
-> Show Typedef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Typedef -> String -> String
showsPrec :: Int -> Typedef -> String -> String
$cshow :: Typedef -> String
show :: Typedef -> String
$cshowList :: [Typedef] -> String -> String
showList :: [Typedef] -> String -> String
Show)

parseMember :: FileVec -> DIE -> Parser Member
parseMember :: FileVec -> DIE -> Parser Member
parseMember FileVec
fileVec DIE
d = String -> DIE -> DIEParser Member -> Parser Member
forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
"parseMember" DIE
d (DIEParser Member -> Parser Member)
-> DIEParser Member -> Parser Member
forall a b. (a -> b) -> a -> b
$ do
  DW_TAG -> DIEParser ()
checkTag DW_TAG
DW_TAG_member
  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  TypeRef
tp <- DW_AT -> AttrParser TypeRef -> DIEParser TypeRef
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef
  Maybe Word64
memLoc <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_data_member_location AttrParser Word64
attributeAsUInt
  Bool
artificial <- DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_artificial Bool
False AttrParser Bool
attributeAsBool
  DeclLoc
dloc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec

  Maybe Word64
byteSize <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_byte_size AttrParser Word64
attributeAsUInt
  Maybe Word64
bitOff <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_bit_offset AttrParser Word64
attributeAsUInt
  Maybe Word64
bitSize <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_bit_size AttrParser Word64
attributeAsUInt

  Member -> DIEParser Member
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    (Member -> DIEParser Member) -> Member -> DIEParser Member
forall a b. (a -> b) -> a -> b
$! Member
      { memberName :: Name
memberName = Name
name,
        memberDescription :: Description
memberDescription = Description
desc,
        memberDeclLoc :: DeclLoc
memberDeclLoc = DeclLoc
dloc,
        memberLoc :: Maybe Word64
memberLoc = Maybe Word64
memLoc,
        memberType :: TypeRef
memberType = TypeRef
tp,
        memberArtificial :: Bool
memberArtificial = Bool
artificial,
        memberByteSize :: Maybe Word64
memberByteSize = Maybe Word64
byteSize,
        memberBitOffset :: Maybe Word64
memberBitOffset = Maybe Word64
bitOff,
        memberBitSize :: Maybe Word64
memberBitSize = Maybe Word64
bitSize
      }

attributeAsTypeRef :: AttrParser TypeRef
attributeAsTypeRef :: AttrParser TypeRef
attributeAsTypeRef Reader
_ (DW_ATVAL_REF DieID
r) = TypeRef -> ExceptT AttrError Identity TypeRef
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (DieID -> TypeRef
TypeRef DieID
r)
attributeAsTypeRef Reader
_ DW_ATVAL
_ = AttrError -> ExceptT AttrError Identity TypeRef
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> ExceptT AttrError Identity TypeRef)
-> AttrError -> ExceptT AttrError Identity TypeRef
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"type reference"

-- | A qualifier on a type.
data TypeQual
  = ConstQual
  | VolatileQual
  | RestrictQual
  deriving (Int -> TypeQual -> String -> String
[TypeQual] -> String -> String
TypeQual -> String
(Int -> TypeQual -> String -> String)
-> (TypeQual -> String)
-> ([TypeQual] -> String -> String)
-> Show TypeQual
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TypeQual -> String -> String
showsPrec :: Int -> TypeQual -> String -> String
$cshow :: TypeQual -> String
show :: TypeQual -> String
$cshowList :: [TypeQual] -> String -> String
showList :: [TypeQual] -> String -> String
Show)

-- | A type qualifier annotation.
data TypeQualAnn = TypeQualAnn
  { TypeQualAnn -> TypeQual
tqaTypeQual :: !TypeQual,
    TypeQualAnn -> Name
tqaName :: !Name,
    TypeQualAnn -> Description
tqaDescription :: !Description,
    TypeQualAnn -> DeclLoc
tqaDeclLoc :: !DeclLoc,
    TypeQualAnn -> Word64
tqaAlign :: !Word64,
    TypeQualAnn -> Maybe TypeRef
tqaType :: !(Maybe TypeRef)
  }
  deriving (Int -> TypeQualAnn -> String -> String
[TypeQualAnn] -> String -> String
TypeQualAnn -> String
(Int -> TypeQualAnn -> String -> String)
-> (TypeQualAnn -> String)
-> ([TypeQualAnn] -> String -> String)
-> Show TypeQualAnn
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TypeQualAnn -> String -> String
showsPrec :: Int -> TypeQualAnn -> String -> String
$cshow :: TypeQualAnn -> String
show :: TypeQualAnn -> String
$cshowList :: [TypeQualAnn] -> String -> String
showList :: [TypeQualAnn] -> String -> String
Show)

-- | A type form
data TypeApp
  = -- | A 1-byte boolean value (0 is false, nonzero is true)
    BoolType
  | -- | An unsigned integer with the given number of bytes (should be positive)
    -- The byte order is platform defined.
    UnsignedIntType !Int
  | -- | An signed integer with the given number of bytes (should be positive)
    -- The byte order is platform defined.
    SignedIntType !Int
  | -- | An IEEE single precision floating point value.
    FloatType
  | -- | An IEEE double precision floating point value.
    DoubleType
  | -- | A long double type.
    LongDoubleType
  | -- | A 1-byte unsigned character.
    UnsignedCharType
  | -- | A 1-byte signed character.
    SignedCharType
  | ArrayType !TypeRef ![Subrange TypeRef]
  | -- | @PointerType mw mtp@ describes a pointer where @mtp@ is
    -- the type that the pointer points to (or 'Nothing') to indicate
    -- this is a void pointer.  @mw@ is the number of bytes the pointer
    -- occupies or @Nothing@ to indicate that is omitted.
    PointerType !(Maybe Word64) !(Maybe TypeRef)
  | -- | Denotes a C struct
    StructType !StructDecl
  | -- | Denotes a C union
    UnionType !UnionDecl
  | EnumType !EnumDecl
  | SubroutinePtrType !SubroutineTypeDecl
  | TypedefType !Typedef
  | -- | Restrict modifier on type.
    TypeQualType !TypeQualAnn
  | -- | Subroutine type
    SubroutineTypeF !SubroutineTypeDecl
  deriving (Int -> TypeApp -> String -> String
[TypeApp] -> String -> String
TypeApp -> String
(Int -> TypeApp -> String -> String)
-> (TypeApp -> String)
-> ([TypeApp] -> String -> String)
-> Show TypeApp
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TypeApp -> String -> String
showsPrec :: Int -> TypeApp -> String -> String
$cshow :: TypeApp -> String
show :: TypeApp -> String
$cshowList :: [TypeApp] -> String -> String
showList :: [TypeApp] -> String -> String
Show)

-- | A type parser takes the file vector and returns either a `TypeF` or `Nothing`.
--
-- The nothing value is returned, because `DW_TAG_const_type` with no `DW_AT_type`
-- attribute.
type TypeParser = FileVec -> DIEParser TypeApp

parseBaseType :: TypeParser
parseBaseType :: TypeParser
parseBaseType FileVec
_ = do
  (Name
name, Description
_) <- DIEParser (Name, Description)
getNameAndDescription
  DW_ATE
enc <- DW_AT -> AttrParser DW_ATE -> DIEParser DW_ATE
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_encoding AttrParser DW_ATE
attributeAsBaseTypeEncoding
  Word64
size <- DW_AT -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_byte_size AttrParser Word64
attributeAsUInt
  case (Name
name, DW_ATE
enc, Word64
size) of
    (Name
_, DW_ATE
DW_ATE_boolean, Word64
1) -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$ TypeApp
BoolType
    (Name
_, DW_ATE
DW_ATE_signed, Word64
_) | Word64
size Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1 -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$ Int -> TypeApp
SignedIntType (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
size)
    (Name
_, DW_ATE
DW_ATE_unsigned, Word64
_) | Word64
size Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
1 -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$ Int -> TypeApp
UnsignedIntType (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
size)
    (Name
_, DW_ATE
DW_ATE_float, Word64
4) -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! TypeApp
FloatType
    (Name
_, DW_ATE
DW_ATE_float, Word64
8) -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! TypeApp
DoubleType
    (Name
"long double", DW_ATE
DW_ATE_float, Word64
16) -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! TypeApp
LongDoubleType
    (Name
_, DW_ATE
DW_ATE_signed_char, Word64
1) -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! TypeApp
SignedCharType
    (Name
_, DW_ATE
DW_ATE_unsigned_char, Word64
1) -> TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! TypeApp
UnsignedCharType
    (Name, DW_ATE, Word64)
_ -> String -> DIEParser TypeApp
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser TypeApp) -> String -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$ String
"Unsupported base type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DW_ATE -> String
forall a. Show a => a -> String
show DW_ATE
enc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
size

parsePointerType :: TypeParser
parsePointerType :: TypeParser
parsePointerType FileVec
_ = do
  Maybe TypeRef
mtp <- DW_AT -> AttrParser TypeRef -> DIEParser (Maybe TypeRef)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef
  Maybe Word64
w <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_byte_size AttrParser Word64
attributeAsUInt
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! Maybe Word64 -> Maybe TypeRef -> TypeApp
PointerType Maybe Word64
w Maybe TypeRef
mtp

parseStructureType :: TypeParser
parseStructureType :: TypeParser
parseStructureType FileVec
fileVec = do
  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  Word64
byteSize <- DW_AT -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_byte_size AttrParser Word64
attributeAsUInt
  DeclLoc
dloc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec

  [Member]
members <- DW_TAG -> (DIE -> Parser Member) -> DIEParser [Member]
forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
DW_TAG_member ((DIE -> Parser Member) -> DIEParser [Member])
-> (DIE -> Parser Member) -> DIEParser [Member]
forall a b. (a -> b) -> a -> b
$ FileVec -> DIE -> Parser Member
parseMember FileVec
fileVec

  let struct :: StructDecl
struct =
        StructDecl
          { structName :: Name
structName = Name
name,
            structDescription :: Description
structDescription = Description
desc,
            structByteSize :: Word64
structByteSize = Word64
byteSize,
            structLoc :: DeclLoc
structLoc = DeclLoc
dloc,
            structMembers :: [Member]
structMembers = [Member]
members
          }
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! StructDecl -> TypeApp
StructType StructDecl
struct

parseUnionType :: TypeParser
parseUnionType :: TypeParser
parseUnionType FileVec
fileVec = do
  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  Word64
byteSize <- DW_AT -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_byte_size AttrParser Word64
attributeAsUInt
  DeclLoc
dloc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec

  [Member]
members <- DW_TAG -> (DIE -> Parser Member) -> DIEParser [Member]
forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
DW_TAG_member ((DIE -> Parser Member) -> DIEParser [Member])
-> (DIE -> Parser Member) -> DIEParser [Member]
forall a b. (a -> b) -> a -> b
$ FileVec -> DIE -> Parser Member
parseMember FileVec
fileVec

  let u :: UnionDecl
u =
        UnionDecl
          { unionName :: Name
unionName = Name
name,
            unionDescription :: Description
unionDescription = Description
desc,
            unionByteSize :: Word64
unionByteSize = Word64
byteSize,
            unionLoc :: DeclLoc
unionLoc = DeclLoc
dloc,
            unionMembers :: [Member]
unionMembers = [Member]
members
          }
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! UnionDecl -> TypeApp
UnionType UnionDecl
u

parseTypedefType :: TypeParser
parseTypedefType :: TypeParser
parseTypedefType FileVec
fileVec = do
  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  DeclLoc
dloc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec
  TypeRef
tp <- DW_AT -> AttrParser TypeRef -> DIEParser TypeRef
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef

  let td :: Typedef
td =
        Typedef
          { typedefName :: Name
typedefName = Name
name,
            typedefDescription :: Description
typedefDescription = Description
desc,
            typedefLoc :: DeclLoc
typedefLoc = DeclLoc
dloc,
            typedefType :: TypeRef
typedefType = TypeRef
tp
          }
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! Typedef -> TypeApp
TypedefType Typedef
td

parseArrayType :: TypeParser
parseArrayType :: TypeParser
parseArrayType FileVec
_ = do
  TypeRef
eltType <- DW_AT -> AttrParser TypeRef -> DIEParser TypeRef
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef

  [Subrange TypeRef]
sr <- DW_TAG
-> (DIE -> Parser (Subrange TypeRef))
-> DIEParser [Subrange TypeRef]
forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
DW_TAG_subrange_type DIE -> Parser (Subrange TypeRef)
parseSubrange
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! TypeRef -> [Subrange TypeRef] -> TypeApp
ArrayType TypeRef
eltType [Subrange TypeRef]
sr

parseEnumerationType :: TypeParser
parseEnumerationType :: TypeParser
parseEnumerationType FileVec
fileVec = do
  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  Word64
byteSize <- DW_AT -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_byte_size AttrParser Word64
attributeAsUInt
  DeclLoc
dloc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec
  Maybe DW_ATE
_enc <- DW_AT -> AttrParser DW_ATE -> DIEParser (Maybe DW_ATE)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_encoding AttrParser DW_ATE
attributeAsBaseTypeEncoding
  Maybe TypeRef
underlyingType <- DW_AT -> AttrParser TypeRef -> DIEParser (Maybe TypeRef)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef
  [Enumerator]
cases <- DW_TAG -> (DIE -> Parser Enumerator) -> DIEParser [Enumerator]
forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
DW_TAG_enumerator DIE -> Parser Enumerator
parseEnumerator
  let e :: EnumDecl
e =
        EnumDecl
          { enumDeclName :: Name
enumDeclName = Name
name,
            enumDeclDescription :: Description
enumDeclDescription = Description
desc,
            enumDeclByteSize :: Word64
enumDeclByteSize = Word64
byteSize,
            enumDeclType :: Maybe TypeRef
enumDeclType = Maybe TypeRef
underlyingType,
            enumDeclLoc :: DeclLoc
enumDeclLoc = DeclLoc
dloc,
            enumDeclCases :: [Enumerator]
enumDeclCases = [Enumerator]
cases
          }
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! EnumDecl -> TypeApp
EnumType EnumDecl
e

-- | Parse a subroutine type.
parseSubroutineType :: TypeParser
parseSubroutineType :: TypeParser
parseSubroutineType FileVec
fileVec = do
  Maybe Bool
proto <- DW_AT -> AttrParser Bool -> DIEParser (Maybe Bool)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_prototyped AttrParser Bool
attributeAsBool
  [Variable]
formals <- FileVec -> DIEParser [Variable]
parseParameters FileVec
fileVec

  Maybe TypeRef
tp <- DW_AT -> AttrParser TypeRef -> DIEParser (Maybe TypeRef)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef

  let sub :: SubroutineTypeDecl
sub =
        SubroutineTypeDecl
          { fntypePrototyped :: Maybe Bool
fntypePrototyped = Maybe Bool
proto,
            fntypeFormals :: [Variable]
fntypeFormals = [Variable]
formals,
            fntypeType :: Maybe TypeRef
fntypeType = Maybe TypeRef
tp
          }
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! SubroutineTypeDecl -> TypeApp
SubroutineTypeF SubroutineTypeDecl
sub

parseTypeQualifier :: TypeQual -> TypeParser
parseTypeQualifier :: TypeQual -> TypeParser
parseTypeQualifier TypeQual
tq FileVec
fileVec = do
  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  DeclLoc
loc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec
  Word64
alignment <- DW_AT -> Word64 -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_alignment Word64
0 AttrParser Word64
attributeAsUInt
  Maybe TypeRef
mtp <- DW_AT -> AttrParser TypeRef -> DIEParser (Maybe TypeRef)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef
  let ann :: TypeQualAnn
ann =
        TypeQualAnn
          { tqaTypeQual :: TypeQual
tqaTypeQual = TypeQual
tq,
            tqaName :: Name
tqaName = Name
name,
            tqaDescription :: Description
tqaDescription = Description
desc,
            tqaDeclLoc :: DeclLoc
tqaDeclLoc = DeclLoc
loc,
            tqaAlign :: Word64
tqaAlign = Word64
alignment,
            tqaType :: Maybe TypeRef
tqaType = Maybe TypeRef
mtp
          }
  TypeApp -> DIEParser TypeApp
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TypeApp -> DIEParser TypeApp) -> TypeApp -> DIEParser TypeApp
forall a b. (a -> b) -> a -> b
$! TypeQualAnn -> TypeApp
TypeQualType TypeQualAnn
ann

typeParsers :: Map DW_TAG TypeParser
typeParsers :: Map DW_TAG TypeParser
typeParsers =
  [(DW_TAG, TypeParser)] -> Map DW_TAG TypeParser
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (,) DW_TAG
DW_TAG_base_type TypeParser
parseBaseType,
      (,) DW_TAG
DW_TAG_const_type (TypeQual -> TypeParser
parseTypeQualifier TypeQual
ConstQual),
      (,) DW_TAG
DW_TAG_volatile_type (TypeQual -> TypeParser
parseTypeQualifier TypeQual
VolatileQual),
      (,) DW_TAG
DW_TAG_restrict_type (TypeQual -> TypeParser
parseTypeQualifier TypeQual
RestrictQual),
      (,) DW_TAG
DW_TAG_pointer_type TypeParser
parsePointerType,
      (,) DW_TAG
DW_TAG_structure_type TypeParser
parseStructureType,
      (,) DW_TAG
DW_TAG_union_type TypeParser
parseUnionType,
      (,) DW_TAG
DW_TAG_typedef TypeParser
parseTypedefType,
      (,) DW_TAG
DW_TAG_array_type TypeParser
parseArrayType,
      (,) DW_TAG
DW_TAG_enumeration_type TypeParser
parseEnumerationType,
      (,) DW_TAG
DW_TAG_subroutine_type TypeParser
parseSubroutineType
    ]

type AbsType = (Either String TypeApp, [String])

-- | Parse a type given a vector identifying file vectors.
parseTypeMap ::
  Map TypeRef AbsType ->
  FileVec ->
  DIEParser (Map TypeRef AbsType)
parseTypeMap :: Map TypeRef AbsType -> FileVec -> DIEParser (Map TypeRef AbsType)
parseTypeMap Map TypeRef AbsType
preMap FileVec
fileVec = do
  (DW_TAG -> DIEParser ()) -> [DW_TAG] -> DIEParser ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DW_TAG -> DIEParser ()
ignoreChild (Map DW_TAG TypeParser -> [DW_TAG]
forall k a. Map k a -> [k]
Map.keys Map DW_TAG TypeParser
typeParsers)
  Reader
dr <- Parser Reader -> StateT DIEParserState Parser Reader
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Reader -> StateT DIEParserState Parser Reader)
-> Parser Reader -> StateT DIEParserState Parser Reader
forall a b. (a -> b) -> a -> b
$ ReaderT ParserState (WarnT String Identity) Reader -> Parser Reader
forall r. ReaderT ParserState (WarnT String Identity) r -> Parser r
Parser (ReaderT ParserState (WarnT String Identity) Reader
 -> Parser Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
-> Parser Reader
forall a b. (a -> b) -> a -> b
$ (ParserState -> Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks ParserState -> Reader
readerInfo
  Map DW_TAG [DIE]
childMap <- (DIEParserState -> Map DW_TAG [DIE])
-> StateT DIEParserState Parser (Map DW_TAG [DIE])
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> Map DW_TAG [DIE]
dpsChildrenMap
  let insDIE ::
        TypeParser ->
        Map TypeRef AbsType ->
        DIE ->
        Map TypeRef AbsType
      insDIE :: TypeParser -> Map TypeRef AbsType -> DIE -> Map TypeRef AbsType
insDIE TypeParser
act Map TypeRef AbsType
m DIE
d =
        TypeRef -> AbsType -> Map TypeRef AbsType -> Map TypeRef AbsType
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
          (DieID -> TypeRef
TypeRef (DIE -> DieID
dieId DIE
d))
          (Reader -> Parser TypeApp -> AbsType
forall r. Reader -> Parser r -> (Either String r, [String])
runParser Reader
dr (String -> DIE -> DIEParser TypeApp -> Parser TypeApp
forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
"parseTypeF" DIE
d (TypeParser
act FileVec
fileVec)))
          Map TypeRef AbsType
m

  let insTagChildren ::
        Map TypeRef AbsType ->
        DW_TAG ->
        TypeParser ->
        Map TypeRef AbsType
      insTagChildren :: Map TypeRef AbsType -> DW_TAG -> TypeParser -> Map TypeRef AbsType
insTagChildren Map TypeRef AbsType
m DW_TAG
tag TypeParser
act =
        (Map TypeRef AbsType -> DIE -> Map TypeRef AbsType)
-> Map TypeRef AbsType -> [DIE] -> Map TypeRef AbsType
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (TypeParser -> Map TypeRef AbsType -> DIE -> Map TypeRef AbsType
insDIE TypeParser
act) Map TypeRef AbsType
m ([DIE] -> DW_TAG -> Map DW_TAG [DIE] -> [DIE]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] DW_TAG
tag Map DW_TAG [DIE]
childMap)

  Map TypeRef AbsType -> DIEParser (Map TypeRef AbsType)
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Map TypeRef AbsType -> DIEParser (Map TypeRef AbsType))
-> Map TypeRef AbsType -> DIEParser (Map TypeRef AbsType)
forall a b. (a -> b) -> a -> b
$! (Map TypeRef AbsType
 -> DW_TAG -> TypeParser -> Map TypeRef AbsType)
-> Map TypeRef AbsType
-> Map DW_TAG TypeParser
-> Map TypeRef AbsType
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map TypeRef AbsType -> DW_TAG -> TypeParser -> Map TypeRef AbsType
insTagChildren Map TypeRef AbsType
preMap Map DW_TAG TypeParser
typeParsers

------------------------------------------------------------------------
-- Location

data DwarfExpr = DwarfExpr !Dwarf.Reader !BS.ByteString

instance Eq DwarfExpr where
  DwarfExpr Reader
_ ByteString
x == :: DwarfExpr -> DwarfExpr -> Bool
== DwarfExpr Reader
_ ByteString
y = ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
y

instance Ord DwarfExpr where
  compare :: DwarfExpr -> DwarfExpr -> Ordering
compare (DwarfExpr Reader
_ ByteString
x) (DwarfExpr Reader
_ ByteString
y) = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
x ByteString
y

instance Show DwarfExpr where
  show :: DwarfExpr -> String
show (DwarfExpr Reader
dr ByteString
bs) =
    case Reader
-> ByteString -> Either ([DW_OP], ByteOffset, String) [DW_OP]
Dwarf.parseDW_OPs Reader
dr ByteString
bs of
      Left ([DW_OP]
_, ByteOffset
_, String
msg) -> String
msg
      Right [DW_OP]
r -> [DW_OP] -> String
forall a. Show a => a -> String
show [DW_OP]
r

-- | Provides a way of computing the location of a variable.
data Location
  = ComputedLoc !DwarfExpr
  | OffsetLoc !Word64
  deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, Eq Location
Eq Location =>
(Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$c< :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> Location
Ord)

attributeAsLocation :: AttrParser Location
attributeAsLocation :: AttrParser Location
attributeAsLocation Reader
dr = \case
  DW_ATVAL_BLOB ByteString
b -> Location -> Except AttrError Location
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (DwarfExpr -> Location
ComputedLoc (Reader -> ByteString -> DwarfExpr
DwarfExpr Reader
dr ByteString
b))
  DW_ATVAL_UINT Word64
w -> Location -> Except AttrError Location
forall a. a -> ExceptT AttrError Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Word64 -> Location
OffsetLoc Word64
w)
  DW_ATVAL
_ -> AttrError -> Except AttrError Location
forall a. AttrError -> ExceptT AttrError Identity a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (AttrError -> Except AttrError Location)
-> AttrError -> Except AttrError Location
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrError
IncorrectTypeFor ByteString
"Location"

instance Pretty Location where
  pretty :: forall ann. Location -> Doc ann
pretty (ComputedLoc (DwarfExpr Reader
dr ByteString
bs)) =
    case Reader
-> ByteString -> Either ([DW_OP], ByteOffset, String) [DW_OP]
Dwarf.parseDW_OPs Reader
dr ByteString
bs of
      Left ([DW_OP]
_, ByteOffset
_, String
msg) -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
msg
      Right [DW_OP]
ops -> [DW_OP] -> Doc ann
forall ann. [DW_OP] -> Doc ann
ppOps [DW_OP]
ops
  pretty (OffsetLoc Word64
w) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String
"offset 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
w String
"")

------------------------------------------------------------------------
-- Variable

-- | A reference to a variable
newtype VariableRef = VariableRef DieID
  deriving (VariableRef -> VariableRef -> Bool
(VariableRef -> VariableRef -> Bool)
-> (VariableRef -> VariableRef -> Bool) -> Eq VariableRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VariableRef -> VariableRef -> Bool
== :: VariableRef -> VariableRef -> Bool
$c/= :: VariableRef -> VariableRef -> Bool
/= :: VariableRef -> VariableRef -> Bool
Eq, Eq VariableRef
Eq VariableRef =>
(VariableRef -> VariableRef -> Ordering)
-> (VariableRef -> VariableRef -> Bool)
-> (VariableRef -> VariableRef -> Bool)
-> (VariableRef -> VariableRef -> Bool)
-> (VariableRef -> VariableRef -> Bool)
-> (VariableRef -> VariableRef -> VariableRef)
-> (VariableRef -> VariableRef -> VariableRef)
-> Ord VariableRef
VariableRef -> VariableRef -> Bool
VariableRef -> VariableRef -> Ordering
VariableRef -> VariableRef -> VariableRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VariableRef -> VariableRef -> Ordering
compare :: VariableRef -> VariableRef -> Ordering
$c< :: VariableRef -> VariableRef -> Bool
< :: VariableRef -> VariableRef -> Bool
$c<= :: VariableRef -> VariableRef -> Bool
<= :: VariableRef -> VariableRef -> Bool
$c> :: VariableRef -> VariableRef -> Bool
> :: VariableRef -> VariableRef -> Bool
$c>= :: VariableRef -> VariableRef -> Bool
>= :: VariableRef -> VariableRef -> Bool
$cmax :: VariableRef -> VariableRef -> VariableRef
max :: VariableRef -> VariableRef -> VariableRef
$cmin :: VariableRef -> VariableRef -> VariableRef
min :: VariableRef -> VariableRef -> VariableRef
Ord)

instance Pretty VariableRef where
  pretty :: forall ann. VariableRef -> Doc ann
pretty (VariableRef (DieID Word64
w)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
w String
"")

data Variable = Variable
  { Variable -> DieID
varDieID :: !DieID,
    Variable -> Name
varName :: !Name,
    Variable -> Description
varDescription :: !Description,
    -- | Indicates if this variable is just a declaration
    Variable -> Bool
varDecl :: !Bool,
    Variable -> DeclLoc
varDeclLoc :: !DeclLoc,
    Variable -> Maybe TypeRef
varType :: !(Maybe TypeRef),
    Variable -> Maybe Location
varLocation :: !(Maybe Location),
    Variable -> Maybe ConstValue
varConstValue :: !(Maybe ConstValue),
    -- | A variable reference if this variable comes from an inlined function.
    Variable -> Maybe VariableRef
varOrigin :: !(Maybe VariableRef)
  }

instance Pretty Variable where
  pretty :: forall ann. Variable -> Doc ann
pretty Variable
v =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ Doc ann
"name:    " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty (Variable -> Name
varName Variable
v),
        DeclLoc -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DeclLoc -> Doc ann
pretty (Variable -> DeclLoc
varDeclLoc Variable
v),
        Doc ann
"type:    " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe TypeRef -> Doc ann
forall ann. Maybe TypeRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Variable -> Maybe TypeRef
varType Variable
v),
        Doc ann -> (Location -> Doc ann) -> Maybe Location -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Doc ann
"") (\Location
l -> Doc ann
"location:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Location -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Location -> Doc ann
pretty Location
l) (Variable -> Maybe Location
varLocation Variable
v)
      ]

instance Show Variable where
  show :: Variable -> String
show = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (Variable -> Doc Any) -> Variable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variable -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. Variable -> Doc ann
pretty

------------------------------------------------------------------------
-- Variable

parseVariableOrParameter :: String -> FileVec -> DIE -> Parser Variable
parseVariableOrParameter :: String -> FileVec -> DIE -> Parser Variable
parseVariableOrParameter String
nm FileVec
fileVec DIE
d =
  String -> DIE -> DIEParser Variable -> Parser Variable
forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
nm DIE
d (DIEParser Variable -> Parser Variable)
-> DIEParser Variable -> Parser Variable
forall a b. (a -> b) -> a -> b
$ do
    Maybe Location
mloc <- DW_AT -> AttrParser Location -> DIEParser (Maybe Location)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_location AttrParser Location
attributeAsLocation
    (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
    DeclLoc
dloc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec
    Maybe TypeRef
mvarType <- DW_AT -> AttrParser TypeRef -> DIEParser (Maybe TypeRef)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef

    Maybe ConstValue
constVal <- DIEParser (Maybe ConstValue)
getConstValue

    Bool
decl <- DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_declaration Bool
False AttrParser Bool
attributeAsBool
    Maybe Bool
_exte <- DW_AT -> AttrParser Bool -> DIEParser (Maybe Bool)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_external AttrParser Bool
attributeAsBool

    DW_AT -> DIEParser ()
ignoreAttribute DW_AT
DW_AT_artificial
    DW_AT -> DIEParser ()
ignoreAttribute DW_AT
DW_AT_specification
    Maybe DieID
originDieID <- DW_AT -> AttrParser DieID -> DIEParser (Maybe DieID)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_abstract_origin AttrParser DieID
attributeAsDieID

    Variable -> DIEParser Variable
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
      (Variable -> DIEParser Variable) -> Variable -> DIEParser Variable
forall a b. (a -> b) -> a -> b
$! Variable
        { varDieID :: DieID
varDieID = DIE -> DieID
dieId DIE
d,
          varName :: Name
varName = Name
name,
          varDescription :: Description
varDescription = Description
desc,
          varDecl :: Bool
varDecl = Bool
decl,
          varDeclLoc :: DeclLoc
varDeclLoc = DeclLoc
dloc,
          varType :: Maybe TypeRef
varType = Maybe TypeRef
mvarType,
          varLocation :: Maybe Location
varLocation = Maybe Location
mloc,
          varConstValue :: Maybe ConstValue
varConstValue = Maybe ConstValue
constVal,
          varOrigin :: Maybe VariableRef
varOrigin = DieID -> VariableRef
VariableRef (DieID -> VariableRef) -> Maybe DieID -> Maybe VariableRef
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DieID
originDieID
        }

parseVariables :: FileVec -> DIEParser [Variable]
parseVariables :: FileVec -> DIEParser [Variable]
parseVariables FileVec
fileVec = do
  DW_TAG -> (DIE -> Parser Variable) -> DIEParser [Variable]
forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
DW_TAG_variable ((DIE -> Parser Variable) -> DIEParser [Variable])
-> (DIE -> Parser Variable) -> DIEParser [Variable]
forall a b. (a -> b) -> a -> b
$
    String -> FileVec -> DIE -> Parser Variable
parseVariableOrParameter String
"parseVariable" FileVec
fileVec

parseParameters :: FileVec -> DIEParser [Variable]
parseParameters :: FileVec -> DIEParser [Variable]
parseParameters FileVec
fileVec = do
  DW_TAG -> (DIE -> Parser Variable) -> DIEParser [Variable]
forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
DW_TAG_formal_parameter ((DIE -> Parser Variable) -> DIEParser [Variable])
-> (DIE -> Parser Variable) -> DIEParser [Variable]
forall a b. (a -> b) -> a -> b
$
    String -> FileVec -> DIE -> Parser Variable
parseVariableOrParameter String
"parseParameter" FileVec
fileVec

------------------------------------------------------------------------
-- Subprogram

-- | A reference to a subprogram.
newtype SubprogramRef = SubprogramRef DieID
  deriving (SubprogramRef -> SubprogramRef -> Bool
(SubprogramRef -> SubprogramRef -> Bool)
-> (SubprogramRef -> SubprogramRef -> Bool) -> Eq SubprogramRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubprogramRef -> SubprogramRef -> Bool
== :: SubprogramRef -> SubprogramRef -> Bool
$c/= :: SubprogramRef -> SubprogramRef -> Bool
/= :: SubprogramRef -> SubprogramRef -> Bool
Eq, Eq SubprogramRef
Eq SubprogramRef =>
(SubprogramRef -> SubprogramRef -> Ordering)
-> (SubprogramRef -> SubprogramRef -> Bool)
-> (SubprogramRef -> SubprogramRef -> Bool)
-> (SubprogramRef -> SubprogramRef -> Bool)
-> (SubprogramRef -> SubprogramRef -> Bool)
-> (SubprogramRef -> SubprogramRef -> SubprogramRef)
-> (SubprogramRef -> SubprogramRef -> SubprogramRef)
-> Ord SubprogramRef
SubprogramRef -> SubprogramRef -> Bool
SubprogramRef -> SubprogramRef -> Ordering
SubprogramRef -> SubprogramRef -> SubprogramRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubprogramRef -> SubprogramRef -> Ordering
compare :: SubprogramRef -> SubprogramRef -> Ordering
$c< :: SubprogramRef -> SubprogramRef -> Bool
< :: SubprogramRef -> SubprogramRef -> Bool
$c<= :: SubprogramRef -> SubprogramRef -> Bool
<= :: SubprogramRef -> SubprogramRef -> Bool
$c> :: SubprogramRef -> SubprogramRef -> Bool
> :: SubprogramRef -> SubprogramRef -> Bool
$c>= :: SubprogramRef -> SubprogramRef -> Bool
>= :: SubprogramRef -> SubprogramRef -> Bool
$cmax :: SubprogramRef -> SubprogramRef -> SubprogramRef
max :: SubprogramRef -> SubprogramRef -> SubprogramRef
$cmin :: SubprogramRef -> SubprogramRef -> SubprogramRef
min :: SubprogramRef -> SubprogramRef -> SubprogramRef
Ord)

instance Pretty SubprogramRef where
  pretty :: forall ann. SubprogramRef -> Doc ann
pretty (SubprogramRef (DieID Word64
d)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word64
d String
"")

data SubprogramDef = SubprogramDef
  { SubprogramDef -> Maybe Word64
subLowPC :: !(Maybe Word64),
    SubprogramDef -> Maybe Word64
subHighPC :: !(Maybe Word64),
    SubprogramDef -> Maybe DwarfExpr
subFrameBase :: !(Maybe DwarfExpr),
    SubprogramDef -> Maybe Bool
subGNUAllCallSites :: !(Maybe Bool)
  }

instance Pretty SubprogramDef where
  pretty :: forall ann. SubprogramDef -> Doc ann
pretty SubprogramDef
d =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ Doc ann
"low_pc:     " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> (Word64 -> String) -> Maybe Word64 -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"UNDEF" (Word64 -> String -> String
forall a. Integral a => a -> String -> String
`showHex` String
"") (SubprogramDef -> Maybe Word64
subLowPC SubprogramDef
d)),
        Doc ann
"high_pc:    " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> (Word64 -> String) -> Maybe Word64 -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"UNDEF" (Word64 -> String -> String
forall a. Integral a => a -> String -> String
`showHex` String
"") (SubprogramDef -> Maybe Word64
subHighPC SubprogramDef
d)),
        Doc ann
"frame_base: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe DwarfExpr -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (SubprogramDef -> Maybe DwarfExpr
subFrameBase SubprogramDef
d),
        Doc ann
"GNU_all_call_sites: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe Bool -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (SubprogramDef -> Maybe Bool
subGNUAllCallSites SubprogramDef
d)
      ]

-- | Get `DW_AT_GNU_all_tail_call_sites`
getAllTailCallSites :: DIEParser Bool
getAllTailCallSites :: DIEParser Bool
getAllTailCallSites = DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_GNU_all_tail_call_sites Bool
False AttrParser Bool
attributeAsBool

parseSubprogramDef :: DIEParser SubprogramDef
parseSubprogramDef :: DIEParser SubprogramDef
parseSubprogramDef = do
  Reader
dr <- Parser Reader -> StateT DIEParserState Parser Reader
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Reader -> StateT DIEParserState Parser Reader)
-> Parser Reader -> StateT DIEParserState Parser Reader
forall a b. (a -> b) -> a -> b
$ ReaderT ParserState (WarnT String Identity) Reader -> Parser Reader
forall r. ReaderT ParserState (WarnT String Identity) r -> Parser r
Parser (ReaderT ParserState (WarnT String Identity) Reader
 -> Parser Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
-> Parser Reader
forall a b. (a -> b) -> a -> b
$ (ParserState -> Reader)
-> ReaderT ParserState (WarnT String Identity) Reader
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks ParserState -> Reader
readerInfo
  Maybe Word64
lowPC <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_low_pc AttrParser Word64
attributeAsUInt
  Maybe Word64
highPC <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_high_pc AttrParser Word64
attributeAsUInt
  Maybe ByteString
frameBase <- DW_AT -> AttrParser ByteString -> DIEParser (Maybe ByteString)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_frame_base AttrParser ByteString
attributeAsBlob
  Maybe Bool
callSites <- DW_AT -> AttrParser Bool -> DIEParser (Maybe Bool)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_GNU_all_call_sites AttrParser Bool
attributeAsBool
  DW_TAG -> DIEParser ()
ignoreChild DW_TAG
DW_TAG_lexical_block
  DW_TAG -> DIEParser ()
ignoreChild DW_TAG
DW_TAG_GNU_call_site
  DW_TAG -> DIEParser ()
ignoreChild DW_TAG
DW_TAG_inlined_subroutine
  SubprogramDef -> DIEParser SubprogramDef
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (SubprogramDef -> DIEParser SubprogramDef)
-> SubprogramDef -> DIEParser SubprogramDef
forall a b. (a -> b) -> a -> b
$
    SubprogramDef
      { subLowPC :: Maybe Word64
subLowPC = Maybe Word64
lowPC,
        subHighPC :: Maybe Word64
subHighPC = Maybe Word64
highPC,
        subFrameBase :: Maybe DwarfExpr
subFrameBase = Reader -> ByteString -> DwarfExpr
DwarfExpr Reader
dr (ByteString -> DwarfExpr) -> Maybe ByteString -> Maybe DwarfExpr
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
frameBase,
        subGNUAllCallSites :: Maybe Bool
subGNUAllCallSites = Maybe Bool
callSites
      }

data Subprogram = Subprogram
  { Subprogram -> Name
subName :: !Name,
    Subprogram -> Description
subDescription :: !Description,
    Subprogram -> ByteString
subLinkageName :: !BS.ByteString,
    Subprogram -> Bool
subExternal :: !Bool,
    -- | Origin for inlined functions.
    Subprogram -> Maybe SubprogramRef
subOrigin :: !(Maybe SubprogramRef),
    -- | Indicates this is a declaration and not a defining declaration.
    Subprogram -> Bool
subIsDeclaration :: !Bool,
    Subprogram -> Maybe Word64
subEntryPC :: !(Maybe Word64),
    Subprogram -> Bool
subArtificial :: !Bool,
    Subprogram -> Bool
subGNUAllTailCallSites :: !Bool,
    Subprogram -> DeclLoc
subDeclLoc :: !DeclLoc,
    Subprogram -> Bool
subPrototyped :: !Bool,
    Subprogram -> Maybe SubprogramDef
subDef :: !(Maybe SubprogramDef),
    Subprogram -> Map VariableRef Variable
subVars :: !(Map VariableRef Variable),
    -- | Maps variable ref to subprogram variable.
    --
    -- Note. Parameters offsets are ordered so in-order
    -- traversal of map is order of parameters.
    Subprogram -> Map VariableRef Variable
subParamMap :: !(Map VariableRef Variable),
    Subprogram -> Bool
subUnspecifiedParams :: !Bool,
    Subprogram -> Maybe TypeRef
subRetType :: !(Maybe TypeRef),
    -- | Flag indicating function declared with
    -- "noreturn" attribute
    Subprogram -> Bool
subNoreturn :: !Bool,
    -- | Type map for resolving types in subprogram.
    Subprogram -> Map TypeRef AbsType
subTypeMap :: !(Map TypeRef AbsType)
  }

instance Pretty Subprogram where
  pretty :: forall ann. Subprogram -> Doc ann
pretty Subprogram
sub =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ Doc ann
"name:       " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty (Subprogram -> Name
subName Subprogram
sub),
        Doc ann
"external:   " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (Subprogram -> Bool
subExternal Subprogram
sub),
        DeclLoc -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DeclLoc -> Doc ann
pretty (Subprogram -> DeclLoc
subDeclLoc Subprogram
sub),
        Doc ann
"prototyped: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Bool -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (Subprogram -> Bool
subPrototyped Subprogram
sub),
        Doc ann
-> (SubprogramDef -> Doc ann) -> Maybe SubprogramDef -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Doc ann
"") SubprogramDef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SubprogramDef -> Doc ann
pretty (Subprogram -> Maybe SubprogramDef
subDef Subprogram
sub),
        String -> [Doc ann] -> Doc ann
forall ann. String -> [Doc ann] -> Doc ann
ppList String
"variables" (Variable -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Variable -> Doc ann
pretty (Variable -> Doc ann) -> [Variable] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Map VariableRef Variable -> [Variable]
forall k a. Map k a -> [a]
Map.elems (Subprogram -> Map VariableRef Variable
subVars Subprogram
sub)),
        String -> [Doc ann] -> Doc ann
forall ann. String -> [Doc ann] -> Doc ann
ppList String
"parameters" (Variable -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Variable -> Doc ann
pretty (Variable -> Doc ann) -> [Variable] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Map VariableRef Variable -> [Variable]
forall k a. Map k a -> [a]
Map.elems (Subprogram -> Map VariableRef Variable
subParamMap Subprogram
sub)),
        Doc ann
"return type: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe TypeRef -> Doc ann
forall ann. Maybe TypeRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Subprogram -> Maybe TypeRef
subRetType Subprogram
sub)
      ]

instance Show Subprogram where
  show :: Subprogram -> String
show = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (Subprogram -> Doc Any) -> Subprogram -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subprogram -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. Subprogram -> Doc ann
pretty

isInlined :: DW_INL -> Parser Bool
isInlined :: DW_INL -> Parser Bool
isInlined DW_INL
inl =
  case DW_INL
inl of
    DW_INL
DW_INL_not_inlined -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False
    DW_INL
DW_INL_inlined -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True
    DW_INL
DW_INL_declared_not_inlined -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False
    DW_INL
DW_INL_declared_inlined -> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True
    DW_INL
_ -> do
      String -> Parser ()
forall s (m :: Type -> Type). WarnMonad s m => s -> m ()
warn String
"Unexpected inline attribute."
      Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False

-- | For some reason, DW_AT_linkage_name is duplicated in some elf files,
-- so we handle this specially.
getLinkageName :: DIEParser BS.ByteString
getLinkageName :: StateT DIEParserState Parser ByteString
getLinkageName = do
  let attrName :: DW_AT
attrName = DW_AT
DW_AT_linkage_name
  DW_AT -> DIEParser ()
ignoreAttribute DW_AT
attrName
  Map DW_AT [DW_ATVAL]
m <- (DIEParserState -> Map DW_AT [DW_ATVAL])
-> StateT DIEParserState Parser (Map DW_AT [DW_ATVAL])
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> Map DW_AT [DW_ATVAL]
dpsAttributeMap
  case [DW_ATVAL] -> DW_AT -> Map DW_AT [DW_ATVAL] -> [DW_ATVAL]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] DW_AT
attrName Map DW_AT [DW_ATVAL]
m of
    [] -> do
      ByteString -> StateT DIEParserState Parser ByteString
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
BS.empty
    DW_ATVAL
v : [DW_ATVAL]
r -> do
      DIE
d <- (DIEParserState -> DIE) -> StateT DIEParserState Parser DIE
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets DIEParserState -> DIE
dpsDIE
      ByteString
linkageName <- Parser ByteString -> StateT DIEParserState Parser ByteString
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser ByteString -> StateT DIEParserState Parser ByteString)
-> Parser ByteString -> StateT DIEParserState Parser ByteString
forall a b. (a -> b) -> a -> b
$ DW_AT -> AttrParser ByteString -> DW_ATVAL -> Parser ByteString
forall r. DW_AT -> AttrParser r -> DW_ATVAL -> Parser r
convertAttribute DW_AT
attrName AttrParser ByteString
attributeAsString DW_ATVAL
v
      [DW_ATVAL] -> (DW_ATVAL -> DIEParser ()) -> DIEParser ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DW_ATVAL]
r ((DW_ATVAL -> DIEParser ()) -> DIEParser ())
-> (DW_ATVAL -> DIEParser ()) -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ \DW_ATVAL
rv -> do
        case DW_ATVAL
rv of
          DW_ATVAL_STRING ByteString
rvs | ByteString
rvs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
linkageName -> () -> DIEParser ()
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
          DW_ATVAL
_ -> String -> DIEParser ()
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser ()) -> String -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Found distinct attributes for %s in %d." (DW_AT -> String
forall a. Show a => a -> String
show DW_AT
attrName) (DIE -> String
forall a. Show a => a -> String
show DIE
d)
      ByteString -> StateT DIEParserState Parser ByteString
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
linkageName

getInlineAttribute :: DIEParser DW_INL
getInlineAttribute :: DIEParser DW_INL
getInlineAttribute =
  DW_AT -> DW_INL -> AttrParser DW_INL -> DIEParser DW_INL
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_inline DW_INL
DW_INL_not_inlined ((Word64 -> DW_INL) -> AttrParser Word64 -> AttrParser DW_INL
forall a b. (a -> b) -> AttrParser a -> AttrParser b
mapAttr Word64 -> DW_INL
DW_INL AttrParser Word64
attributeAsUInt)

-- | Parse a subprogram
--
-- Tag has type `DW_TAG_subprogram`
parseSubprogram ::
  FileVec ->
  Map TypeRef AbsType ->
  DIE ->
  Parser Subprogram
parseSubprogram :: FileVec -> Map TypeRef AbsType -> DIE -> Parser Subprogram
parseSubprogram FileVec
fileVec Map TypeRef AbsType
typeMap DIE
d = String -> DIE -> DIEParser Subprogram -> Parser Subprogram
forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
"parseSubprogram" DIE
d (DIEParser Subprogram -> Parser Subprogram)
-> DIEParser Subprogram -> Parser Subprogram
forall a b. (a -> b) -> a -> b
$ do
  DW_TAG -> DIEParser ()
checkTag DW_TAG
DW_TAG_subprogram
  Bool
ext <- DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_external Bool
False AttrParser Bool
attributeAsBool
  Bool
decl <- DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_declaration Bool
False AttrParser Bool
attributeAsBool

  DW_INL
inl <- DIEParser DW_INL
getInlineAttribute
  Bool
inlined <- Parser Bool -> DIEParser Bool
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Bool -> DIEParser Bool) -> Parser Bool -> DIEParser Bool
forall a b. (a -> b) -> a -> b
$ DW_INL -> Parser Bool
isInlined DW_INL
inl

  Maybe DieID
originDieID <- DW_AT -> AttrParser DieID -> DIEParser (Maybe DieID)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_abstract_origin AttrParser DieID
attributeAsDieID

  Maybe SubprogramDef
def <-
    if Bool
decl Bool -> Bool -> Bool
|| Bool
inlined
      then Maybe SubprogramDef
-> StateT DIEParserState Parser (Maybe SubprogramDef)
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe SubprogramDef
forall a. Maybe a
Nothing
      else do
        SubprogramDef -> Maybe SubprogramDef
forall a. a -> Maybe a
Just (SubprogramDef -> Maybe SubprogramDef)
-> DIEParser SubprogramDef
-> StateT DIEParserState Parser (Maybe SubprogramDef)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DIEParser SubprogramDef
parseSubprogramDef

  (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
  ByteString
linkageName <- StateT DIEParserState Parser ByteString
getLinkageName
  Bool
prototyped <- DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_prototyped Bool
False AttrParser Bool
attributeAsBool
  Bool
artificial <- DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_artificial Bool
False AttrParser Bool
attributeAsBool
  DeclLoc
dloc <- FileVec -> DIEParser DeclLoc
parseDeclLoc FileVec
fileVec

  Map TypeRef AbsType
typeMap' <- Map TypeRef AbsType -> FileVec -> DIEParser (Map TypeRef AbsType)
parseTypeMap Map TypeRef AbsType
typeMap FileVec
fileVec
  [Variable]
vars <- FileVec -> DIEParser [Variable]
parseVariables FileVec
fileVec
  -- DW_TAG_formal_paramters children
  [Variable]
params <- FileVec -> DIEParser [Variable]
parseParameters FileVec
fileVec
  Bool
hasUnspecifiedParams <- DW_TAG -> DIEParser Bool
hasChildren DW_TAG
DW_TAG_unspecified_parameters

  Maybe Word64
entryPC <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_entry_pc AttrParser Word64
attributeAsUInt

  Maybe TypeRef
retType <- DW_AT -> AttrParser TypeRef -> DIEParser (Maybe TypeRef)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_type AttrParser TypeRef
attributeAsTypeRef
  Bool
noreturn <- DW_AT -> Bool -> AttrParser Bool -> DIEParser Bool
forall v. DW_AT -> v -> AttrParser v -> DIEParser v
getAttributeWithDefault DW_AT
DW_AT_noreturn Bool
False AttrParser Bool
attributeAsBool

  Bool
allTailCallSites <- DIEParser Bool
getAllTailCallSites

  DW_AT -> DIEParser ()
ignoreAttribute DW_AT
DW_AT_type
  DW_TAG -> DIEParser ()
ignoreChild DW_TAG
DW_TAG_label
  DW_TAG -> DIEParser ()
ignoreChild DW_TAG
DW_TAG_lexical_block
  Subprogram -> DIEParser Subprogram
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    (Subprogram -> DIEParser Subprogram)
-> Subprogram -> DIEParser Subprogram
forall a b. (a -> b) -> a -> b
$! Subprogram
      { subName :: Name
subName = Name
name,
        subDescription :: Description
subDescription = Description
desc,
        subLinkageName :: ByteString
subLinkageName = ByteString
linkageName,
        subExternal :: Bool
subExternal = Bool
ext,
        subOrigin :: Maybe SubprogramRef
subOrigin = DieID -> SubprogramRef
SubprogramRef (DieID -> SubprogramRef) -> Maybe DieID -> Maybe SubprogramRef
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DieID
originDieID,
        subIsDeclaration :: Bool
subIsDeclaration = Bool
decl,
        subEntryPC :: Maybe Word64
subEntryPC = Maybe Word64
entryPC,
        subArtificial :: Bool
subArtificial = Bool
artificial,
        subGNUAllTailCallSites :: Bool
subGNUAllTailCallSites = Bool
allTailCallSites,
        subDeclLoc :: DeclLoc
subDeclLoc = DeclLoc
dloc,
        subPrototyped :: Bool
subPrototyped = Bool
prototyped,
        subDef :: Maybe SubprogramDef
subDef = Maybe SubprogramDef
def,
        subVars :: Map VariableRef Variable
subVars = [(VariableRef, Variable)] -> Map VariableRef Variable
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DieID -> VariableRef
VariableRef (Variable -> DieID
varDieID Variable
v), Variable
v) | Variable
v <- [Variable]
vars],
        subParamMap :: Map VariableRef Variable
subParamMap = [(VariableRef, Variable)] -> Map VariableRef Variable
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DieID -> VariableRef
VariableRef (Variable -> DieID
varDieID Variable
v), Variable
v) | Variable
v <- [Variable]
params],
        subUnspecifiedParams :: Bool
subUnspecifiedParams = Bool
hasUnspecifiedParams,
        subRetType :: Maybe TypeRef
subRetType = Maybe TypeRef
retType,
        subNoreturn :: Bool
subNoreturn = Bool
noreturn,
        subTypeMap :: Map TypeRef AbsType
subTypeMap = Map TypeRef AbsType
typeMap'
      }

-- CompileUnit

-- | The output of one compilation.
data CompileUnit = CompileUnit
  { CompileUnit -> CUContext
cuCtx :: !CUContext,
    CompileUnit -> ByteString
cuProducer :: !BS.ByteString,
    CompileUnit -> Maybe DW_LANG
cuLanguage :: Maybe DW_LANG,
    CompileUnit -> Name
cuName :: !Name,
    CompileUnit -> Description
cuDescription :: !Description,
    CompileUnit -> ByteString
cuCompDir :: !BS.ByteString,
    CompileUnit -> Maybe Word64
cuGNUMacros :: !(Maybe Word64),
    -- | Map from subprogram reference to a subprogram.
    CompileUnit -> Map SubprogramRef Subprogram
cuSubprogramMap :: !(Map SubprogramRef Subprogram),
    CompileUnit -> [Subprogram]
cuSubprograms :: ![Subprogram],
    -- | Global variables in this unit
    CompileUnit -> [Variable]
cuVariables :: ![Variable],
    CompileUnit -> Map TypeRef AbsType
cuTypeMap :: !(Map TypeRef AbsType),
    CompileUnit -> [Range]
cuRanges :: ![Dwarf.Range],
    CompileUnit -> [DW_LNE]
cuLNE :: ![DW_LNE],
    -- | File vector for file references.
    CompileUnit -> FileVec
cuFileVec :: !FileVec
  }

instance Show CompileUnit where
  show :: CompileUnit -> String
show = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (CompileUnit -> Doc Any) -> CompileUnit -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileUnit -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. CompileUnit -> Doc ann
pretty

instance Pretty CompileUnit where
  pretty :: forall ann. CompileUnit -> Doc ann
pretty CompileUnit
cu =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
      [ Doc ann
"producer:    " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
BSC.unpack (CompileUnit -> ByteString
cuProducer CompileUnit
cu)),
        Doc ann
"language:    " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe DW_LANG -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (CompileUnit -> Maybe DW_LANG
cuLanguage CompileUnit
cu),
        Doc ann
"name:        " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty (CompileUnit -> Name
cuName CompileUnit
cu),
        Doc ann
"comp_dir:    " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ByteString -> String
BSC.unpack (CompileUnit -> ByteString
cuCompDir CompileUnit
cu)),
        Doc ann
"GNU_macros:  " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe Word64 -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (CompileUnit -> Maybe Word64
cuGNUMacros CompileUnit
cu),
        String -> [Doc ann] -> Doc ann
forall ann. String -> [Doc ann] -> Doc ann
ppList String
"variables" (Variable -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Variable -> Doc ann
pretty (Variable -> Doc ann) -> [Variable] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CompileUnit -> [Variable]
cuVariables CompileUnit
cu),
        String -> [Doc ann] -> Doc ann
forall ann. String -> [Doc ann] -> Doc ann
ppList String
"subprograms" (Subprogram -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Subprogram -> Doc ann
pretty (Subprogram -> Doc ann) -> [Subprogram] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CompileUnit -> [Subprogram]
cuSubprograms CompileUnit
cu),
        String -> [Doc ann] -> Doc ann
forall ann. String -> [Doc ann] -> Doc ann
ppList String
"ranges" (Range -> Doc ann
forall ann. Range -> Doc ann
ppRange (Range -> Doc ann) -> [Range] -> [Doc ann]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CompileUnit -> [Range]
cuRanges CompileUnit
cu)
      ]

ppList :: String -> [Doc ann] -> Doc ann
ppList :: forall ann. String -> [Doc ann] -> Doc ann
ppList String
nm [] = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
nm Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": []"
ppList String
nm [Doc ann]
l = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
nm Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat [Doc ann]
l)]

-- | Return subprogram in compile unit
lookupSubprogram :: SubprogramRef -> CompileUnit -> Maybe Subprogram
lookupSubprogram :: SubprogramRef -> CompileUnit -> Maybe Subprogram
lookupSubprogram SubprogramRef
r CompileUnit
cu = SubprogramRef -> Map SubprogramRef Subprogram -> Maybe Subprogram
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SubprogramRef
r (CompileUnit -> Map SubprogramRef Subprogram
cuSubprogramMap CompileUnit
cu)

-- Section 7.20 - Address Range Table
-- Returns the ranges that belong to a CU
getAddressRangeTable ::
  Dwarf.Endianess ->
  Encoding ->
  BS.ByteString ->
  Parser [Dwarf.Range]
getAddressRangeTable :: Endianess -> Encoding -> ByteString -> Parser [Range]
getAddressRangeTable Endianess
end Encoding
enc ByteString
bs = ByteString -> Get [Range] -> Parser [Range]
forall a. ByteString -> Get a -> Parser a
parseGet ByteString
bs ([Range] -> Get [Range]
go [])
  where
    readAddress :: Get Word64
readAddress = Endianess -> Encoding -> Get Word64
desrGetOffset Endianess
end Encoding
enc
    go :: [Range] -> Get [Range]
go [Range]
prev = do
      Range
r <- Word64 -> Word64 -> Range
Range (Word64 -> Word64 -> Range) -> Get Word64 -> Get (Word64 -> Range)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
readAddress Get (Word64 -> Range) -> Get Word64 -> Get Range
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Get Word64
readAddress
      if Range
r Range -> Range -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64 -> Word64 -> Range
Range Word64
0 Word64
0
        then [Range] -> Get [Range]
go (Range
r Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
: [Range]
prev)
        else [Range] -> Get [Range]
forall a. a -> Get a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Range] -> Get [Range]) -> [Range] -> Get [Range]
forall a b. (a -> b) -> a -> b
$! [Range] -> [Range]
forall a. [a] -> [a]
reverse [Range]
prev

parseCompileUnit ::
  Dwarf.Sections ->
  (CUContext, DIE) ->
  (Either String CompileUnit, [String])
parseCompileUnit :: Sections
-> (CUContext, DIE) -> (Either String CompileUnit, [String])
parseCompileUnit Sections
secs (CUContext
ctx, DIE
d) =
  Reader
-> Parser CompileUnit -> (Either String CompileUnit, [String])
forall r. Reader -> Parser r -> (Either String r, [String])
runParser (CUContext -> Reader
cuReader CUContext
ctx) (Parser CompileUnit -> (Either String CompileUnit, [String]))
-> Parser CompileUnit -> (Either String CompileUnit, [String])
forall a b. (a -> b) -> a -> b
$
    String -> DIE -> DIEParser CompileUnit -> Parser CompileUnit
forall r. String -> DIE -> DIEParser r -> Parser r
runDIEParser String
"parseCompileUnit" DIE
d (DIEParser CompileUnit -> Parser CompileUnit)
-> DIEParser CompileUnit -> Parser CompileUnit
forall a b. (a -> b) -> a -> b
$ do
      let contents :: Sections
contents = CUContext -> Sections
cuSections CUContext
ctx
      DW_TAG -> DIEParser ()
checkTag DW_TAG
DW_TAG_compile_unit
      let dr :: Reader
dr = CUContext -> Reader
cuReader CUContext
ctx
      let end :: Endianess
end = Reader -> Endianess
drEndianess Reader
dr
      let tgt :: TargetSize
tgt = Reader -> TargetSize
drTarget64 Reader
dr
      ByteString
prod <- DW_AT
-> AttrParser ByteString -> StateT DIEParserState Parser ByteString
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_producer AttrParser ByteString
attributeAsString
      Maybe DW_LANG
lang <- DW_AT -> AttrParser DW_LANG -> DIEParser (Maybe DW_LANG)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_language AttrParser DW_LANG
attributeAsLang
      (Name
name, Description
desc) <- DIEParser (Name, Description)
getNameAndDescription
      ByteString
compDir <- DW_AT
-> AttrParser ByteString -> StateT DIEParserState Parser ByteString
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_comp_dir AttrParser ByteString
attributeAsString
      -- Get offset into .debug_line for this compile units line number information
      Maybe Word64
mStmtOffset <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_stmt_list AttrParser Word64
attributeAsUInt
      (FileVec
fileVec, [DW_LNE]
lne) <-
        case Maybe Word64
mStmtOffset of
          Maybe Word64
Nothing -> (FileVec, [DW_LNE])
-> StateT DIEParserState Parser (FileVec, [DW_LNE])
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (FileVec
forall a. Vector a
V.empty, [])
          Just Word64
offset -> do
            ByteString
lines_bs <- Sections -> StateT DIEParserState Parser ByteString
forall (m :: Type -> Type). MonadFail m => Sections -> m ByteString
dsLineSection Sections
contents
            Bool -> DIEParser () -> DIEParser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
BS.length ByteString
lines_bs) (DIEParser () -> DIEParser ()) -> DIEParser () -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ do
              String -> DIEParser ()
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError String
"Illegal compile unit debug_line offset"
            let bs :: ByteString
bs = Int -> ByteString -> ByteString
BS.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset) ByteString
lines_bs
            ([ByteString]
fileList, [DW_LNE]
lne) <- Parser ([ByteString], [DW_LNE])
-> StateT DIEParserState Parser ([ByteString], [DW_LNE])
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser ([ByteString], [DW_LNE])
 -> StateT DIEParserState Parser ([ByteString], [DW_LNE]))
-> Parser ([ByteString], [DW_LNE])
-> StateT DIEParserState Parser ([ByteString], [DW_LNE])
forall a b. (a -> b) -> a -> b
$ ByteString
-> Get ([ByteString], [DW_LNE]) -> Parser ([ByteString], [DW_LNE])
forall a. ByteString -> Get a -> Parser a
parseGet ByteString
bs (Sections -> Endianess -> TargetSize -> Get ([ByteString], [DW_LNE])
getLNE Sections
secs Endianess
end TargetSize
tgt)
            (FileVec, [DW_LNE])
-> StateT DIEParserState Parser (FileVec, [DW_LNE])
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ByteString -> DwarfFilePath) -> Vector ByteString -> FileVec
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> DwarfFilePath
DwarfFilePath ([ByteString] -> Vector ByteString
forall a. [a] -> Vector a
V.fromList [ByteString]
fileList), [DW_LNE]
lne)

      [Range]
ranges <-
        if DW_AT -> DIE -> Bool
hasAttribute DW_AT
DW_AT_low_pc DIE
d
          then do
            Word64
lowPC <- DW_AT -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_low_pc AttrParser Word64
attributeAsUInt
            if DW_AT -> DIE -> Bool
hasAttribute DW_AT
DW_AT_high_pc DIE
d
              then do
                Word64
highPC <- DW_AT -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_high_pc AttrParser Word64
attributeAsUInt
                Bool -> DIEParser () -> DIEParser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DW_AT -> DIE -> Bool
hasAttribute DW_AT
DW_AT_ranges DIE
d) (DIEParser () -> DIEParser ()) -> DIEParser () -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ do
                  String -> DIEParser ()
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser ()) -> String -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected ranges"
                [Range] -> StateT DIEParserState Parser [Range]
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Range] -> StateT DIEParserState Parser [Range])
-> [Range] -> StateT DIEParserState Parser [Range]
forall a b. (a -> b) -> a -> b
$! [Word64 -> Word64 -> Range
Range Word64
lowPC (Word64
lowPC Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
highPC)]
              else do
                Word64
range_offset <- DW_AT -> AttrParser Word64 -> DIEParser Word64
forall v. DW_AT -> AttrParser v -> DIEParser v
getSingleAttribute DW_AT
DW_AT_ranges AttrParser Word64
attributeAsUInt
                ByteString
ranges <- Sections -> StateT DIEParserState Parser ByteString
forall (m :: Type -> Type). MonadFail m => Sections -> m ByteString
dsRangesSection Sections
contents
                Parser [Range] -> StateT DIEParserState Parser [Range]
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser [Range] -> StateT DIEParserState Parser [Range])
-> Parser [Range] -> StateT DIEParserState Parser [Range]
forall a b. (a -> b) -> a -> b
$
                  Endianess -> Encoding -> ByteString -> Parser [Range]
getAddressRangeTable Endianess
end (Reader -> Encoding
drEncoding Reader
dr) (ByteString -> Parser [Range]) -> ByteString -> Parser [Range]
forall a b. (a -> b) -> a -> b
$
                    Int -> ByteString -> ByteString
BS.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
range_offset) ByteString
ranges
          else do
            Bool -> DIEParser () -> DIEParser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DW_AT -> DIE -> Bool
hasAttribute DW_AT
DW_AT_high_pc DIE
d) (DIEParser () -> DIEParser ()) -> DIEParser () -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ do
              String -> DIEParser ()
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser ()) -> String -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected high_pc\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
d
            Bool -> DIEParser () -> DIEParser ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (DW_AT -> DIE -> Bool
hasAttribute DW_AT
DW_AT_ranges DIE
d) (DIEParser () -> DIEParser ()) -> DIEParser () -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ do
              String -> DIEParser ()
forall a. String -> StateT DIEParserState Parser a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> DIEParser ()) -> String -> DIEParser ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected ranges\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DIE -> String
forall a. Show a => a -> String
show DIE
d
            [Range] -> StateT DIEParserState Parser [Range]
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []
      -- The compile unit context already gets updated to use these during a parse
      DW_AT -> DIEParser ()
ignoreAttribute DW_AT
DW_AT_str_offsets_base
      DW_AT -> DIEParser ()
ignoreAttribute DW_AT
DW_AT_addr_base
      Maybe Word64
gnuMacros <- DW_AT -> AttrParser Word64 -> DIEParser (Maybe Word64)
forall v. DW_AT -> AttrParser v -> DIEParser (Maybe v)
getMaybeAttribute DW_AT
DW_AT_GNU_macros AttrParser Word64
attributeAsUInt
      -- Type map for children
      Map TypeRef AbsType
typeMap <- Map TypeRef AbsType -> FileVec -> DIEParser (Map TypeRef AbsType)
parseTypeMap Map TypeRef AbsType
forall k a. Map k a
Map.empty FileVec
fileVec

      [DIE]
subprogramDies <- DW_TAG -> (DIE -> Parser DIE) -> DIEParser [DIE]
forall v. DW_TAG -> (DIE -> Parser v) -> DIEParser [v]
parseChildrenList DW_TAG
DW_TAG_subprogram DIE -> Parser DIE
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

      [Subprogram]
subprograms <- Parser [Subprogram] -> StateT DIEParserState Parser [Subprogram]
forall (m :: Type -> Type) a.
Monad m =>
m a -> StateT DIEParserState m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser [Subprogram] -> StateT DIEParserState Parser [Subprogram])
-> Parser [Subprogram] -> StateT DIEParserState Parser [Subprogram]
forall a b. (a -> b) -> a -> b
$ (DIE -> Parser Subprogram) -> [DIE] -> Parser [Subprogram]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (FileVec -> Map TypeRef AbsType -> DIE -> Parser Subprogram
parseSubprogram FileVec
fileVec Map TypeRef AbsType
typeMap) [DIE]
subprogramDies
      let subMap :: Map SubprogramRef Subprogram
subMap = [(SubprogramRef, Subprogram)] -> Map SubprogramRef Subprogram
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SubprogramRef, Subprogram)] -> Map SubprogramRef Subprogram)
-> [(SubprogramRef, Subprogram)] -> Map SubprogramRef Subprogram
forall a b. (a -> b) -> a -> b
$ (DIE -> Subprogram -> (SubprogramRef, Subprogram))
-> [DIE] -> [Subprogram] -> [(SubprogramRef, Subprogram)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\DIE
d' Subprogram
s -> (DieID -> SubprogramRef
SubprogramRef (DIE -> DieID
dieId DIE
d'), Subprogram
s)) [DIE]
subprogramDies [Subprogram]
subprograms
      [Variable]
variables <- FileVec -> DIEParser [Variable]
parseVariables FileVec
fileVec

      DW_TAG -> DIEParser ()
ignoreChild DW_TAG
DW_TAG_dwarf_procedure

      CompileUnit -> DIEParser CompileUnit
forall a. a -> StateT DIEParserState Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
        (CompileUnit -> DIEParser CompileUnit)
-> CompileUnit -> DIEParser CompileUnit
forall a b. (a -> b) -> a -> b
$! CompileUnit
          { cuCtx :: CUContext
cuCtx = CUContext
ctx,
            cuProducer :: ByteString
cuProducer = ByteString
prod,
            cuLanguage :: Maybe DW_LANG
cuLanguage = Maybe DW_LANG
lang,
            cuName :: Name
cuName = Name
name,
            cuDescription :: Description
cuDescription = Description
desc,
            cuCompDir :: ByteString
cuCompDir = ByteString
compDir,
            cuGNUMacros :: Maybe Word64
cuGNUMacros = Maybe Word64
gnuMacros,
            cuSubprogramMap :: Map SubprogramRef Subprogram
cuSubprogramMap = Map SubprogramRef Subprogram
subMap,
            cuSubprograms :: [Subprogram]
cuSubprograms = [Subprogram]
subprograms,
            cuVariables :: [Variable]
cuVariables = [Variable]
variables,
            cuTypeMap :: Map TypeRef AbsType
cuTypeMap = Map TypeRef AbsType
typeMap,
            cuRanges :: [Range]
cuRanges = [Range]
ranges,
            cuLNE :: [DW_LNE]
cuLNE = [DW_LNE]
lne,
            cuFileVec :: FileVec
cuFileVec = FileVec
fileVec
          }

------------------------------------------------------------------------
-- dwarfCompileUnits

getCompileUnit :: Dwarf.Sections -> CUContext -> (Either String CompileUnit, [String])
getCompileUnit :: Sections -> CUContext -> (Either String CompileUnit, [String])
getCompileUnit Sections
secs CUContext
ctx =
  case CUContext -> Either String DIE
cuFirstDie CUContext
ctx of
    Left String
e -> (String -> Either String CompileUnit
forall a b. a -> Either a b
Left String
e, [])
    Right DIE
d -> Sections
-> (CUContext, DIE) -> (Either String CompileUnit, [String])
parseCompileUnit Sections
secs (CUContext
ctx, DIE
d)

firstCUContext :: Endianness -> Dwarf.Sections -> Maybe (Either String CUContext)
firstCUContext :: Endianness -> Sections -> Maybe (Either String CUContext)
firstCUContext Endianness
end Sections
sections = do
  let dwEnd :: Endianess
dwEnd = case Endianness
end of
        Endianness
LittleEndian -> Endianess
Dwarf.LittleEndian
        Endianness
BigEndian -> Endianess
Dwarf.BigEndian
  Endianess -> Sections -> Maybe (Either String CUContext)
Dwarf.firstCUContext Endianess
dwEnd Sections
sections

{-# DEPRECATED dwarfCompileUnits "Use firstCUContext, nextCUContext and getCompileUnit" #-}

-- | Return dwarf information out of buffers.
dwarfCompileUnits ::
  Endianness ->
  Dwarf.Sections ->
  ([String], [CompileUnit])
dwarfCompileUnits :: Endianness -> Sections -> ([String], [CompileUnit])
dwarfCompileUnits Endianness
end Sections
sections = do
  let go ::
        [String] ->
        [CompileUnit] ->
        Maybe (Either String CUContext) ->
        ([String], [CompileUnit])
      go :: [String]
-> [CompileUnit]
-> Maybe (Either String CUContext)
-> ([String], [CompileUnit])
go [String]
prevWarn [CompileUnit]
cus Maybe (Either String CUContext)
Nothing = ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
prevWarn, [CompileUnit] -> [CompileUnit]
forall a. [a] -> [a]
reverse [CompileUnit]
cus)
      go [String]
prevWarn [CompileUnit]
cus (Just (Left String
e)) = ([String] -> [String]
forall a. [a] -> [a]
reverse (String
e String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prevWarn), [CompileUnit] -> [CompileUnit]
forall a. [a] -> [a]
reverse [CompileUnit]
cus)
      go [String]
prevWarn [CompileUnit]
cus (Just (Right CUContext
ctx)) =
        case Sections -> CUContext -> (Either String CompileUnit, [String])
getCompileUnit Sections
sections CUContext
ctx of
          (Left String
msg, [String]
warnings) ->
            [String]
-> [CompileUnit]
-> Maybe (Either String CUContext)
-> ([String], [CompileUnit])
go ([String]
warnings [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
msg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prevWarn) [CompileUnit]
cus (CUContext -> Maybe (Either String CUContext)
nextCUContext CUContext
ctx)
          (Right CompileUnit
cu, [String]
warnings) ->
            [String]
-> [CompileUnit]
-> Maybe (Either String CUContext)
-> ([String], [CompileUnit])
go ([String]
warnings [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
prevWarn) (CompileUnit
cu CompileUnit -> [CompileUnit] -> [CompileUnit]
forall a. a -> [a] -> [a]
: [CompileUnit]
cus) (CUContext -> Maybe (Either String CUContext)
nextCUContext CUContext
ctx)
   in [String]
-> [CompileUnit]
-> Maybe (Either String CUContext)
-> ([String], [CompileUnit])
go [] [] (Endianness -> Sections -> Maybe (Either String CUContext)
firstCUContext Endianness
end Sections
sections)

------------------------------------------------------------------------
-- dwarfInfoFromElf

-- | Elf informaton
tryGetElfSection :: Elf.Elf v -> BS.ByteString -> Maybe BS.ByteString
tryGetElfSection :: forall (v :: Nat). Elf v -> ByteString -> Maybe ByteString
tryGetElfSection Elf v
e ByteString
nm =
  case ByteString -> Elf v -> [ElfSection (ElfWordType v)]
forall (w :: Nat).
ByteString -> Elf w -> [ElfSection (ElfWordType w)]
Elf.findSectionByName ByteString
nm Elf v
e of
    [] -> Maybe ByteString
forall a. Maybe a
Nothing
    -- We would like to warn about duplicate sections in this function
    --  but are restricted by the galois-dwarf API: https://github.com/GaloisInc/dwarf/issues/23
    ElfSection (ElfWordType v)
s : [ElfSection (ElfWordType v)]
_ -> do
      ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ElfSection (ElfWordType v) -> ByteString
forall w. ElfSection w -> ByteString
Elf.elfSectionData ElfSection (ElfWordType v)
s

-- | Return dwarf information out of an Elf file.
dwarfInfoFromElf :: Elf.Elf v -> ([String], [CompileUnit])
dwarfInfoFromElf :: forall (v :: Nat). Elf v -> ([String], [CompileUnit])
dwarfInfoFromElf Elf v
e = do
  case ByteString -> Elf v -> [ElfSection (ElfWordType v)]
forall (w :: Nat).
ByteString -> Elf w -> [ElfSection (ElfWordType w)]
Elf.findSectionByName ByteString
".debug_info" Elf v
e of
    [] -> ([], [])
    [ElfSection (ElfWordType v)]
_ ->
      let end :: Endianness
end =
            case Elf v -> ElfData
forall (w :: Nat). Elf w -> ElfData
Elf.elfData Elf v
e of
              ElfData
Elf.ELFDATA2LSB -> Endianness
LittleEndian
              ElfData
Elf.ELFDATA2MSB -> Endianness
BigEndian
          sections :: Sections
sections = (ByteString -> Maybe ByteString) -> Sections
mkSections (Elf v -> ByteString -> Maybe ByteString
forall (v :: Nat). Elf v -> ByteString -> Maybe ByteString
tryGetElfSection Elf v
e)
          ([String]
cuWarn, [CompileUnit]
cu) = Endianness -> Sections -> ([String], [CompileUnit])
dwarfCompileUnits Endianness
end Sections
sections
       in ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
cuWarn, [CompileUnit]
cu)

-- | This returns all the variables in the given compile units.
dwarfGlobals :: [CompileUnit] -> [Variable]
dwarfGlobals :: [CompileUnit] -> [Variable]
dwarfGlobals [CompileUnit]
units = ((Location, Variable) -> Variable)
-> [(Location, Variable)] -> [Variable]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Location, Variable) -> Variable
forall a b. (a, b) -> b
snd (((Location, Variable) -> Location)
-> [(Location, Variable)] -> [(Location, Variable)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Location, Variable) -> Location
forall a b. (a, b) -> a
fst [(Location, Variable)]
l)
  where
    l :: [(Location, Variable)]
l =
      [ (Location
w, Variable
var)
        | CompileUnit
cu <- [CompileUnit]
units,
          Variable
var <- CompileUnit -> [Variable]
cuVariables CompileUnit
cu,
          Location
w <- Maybe Location -> [Location]
forall a. Maybe a -> [a]
maybeToList (Variable -> Maybe Location
varLocation Variable
var)
      ]