{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Data.LLVM.BitCode.IR.Metadata (
parseMetadataBlock
, parseMetadataKindEntry
, PartialUnnamedMd(..)
, finalizePartialUnnamedMd
, finalizePValMd
, dedupMetadata
, InstrMdAttachments
, PFnMdAttachments
, PKindMd
, PGlobalAttachments
) where
import Data.LLVM.BitCode.Bitstream
import Data.LLVM.BitCode.IR.Constants
import Data.LLVM.BitCode.Match
import Data.LLVM.BitCode.Parse
import Data.LLVM.BitCode.Record
import Text.LLVM.AST
import Text.LLVM.Labels
import qualified Codec.Binary.UTF8.String as UTF8 (decode)
import Control.Applicative ((<|>))
import Control.Exception (throw)
import Control.Monad (foldM, guard, mplus, when)
import Data.Bits (shiftR, testBit, shiftL, (.&.), (.|.), bit, complement)
import Data.Data (Data)
import Data.Typeable (Typeable)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as Char8 (unpack)
import Data.Either (partitionEithers)
import Data.Generics.Uniplate.Data
import qualified Data.IntMap as IntMap
import Data.List (mapAccumL, foldl')
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Word (Word8,Word32,Word64)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack, callStack)
import Data.Bifunctor (bimap)
data MetadataTable = MetadataTable
{ MetadataTable -> MdTable
mtEntries :: MdTable
, MetadataTable -> Int
mtNextNode :: !Int
, MetadataTable -> IntMap (Bool, Bool, Int)
mtNodes :: IntMap.IntMap (Bool, Bool, Int)
} deriving (Int -> MetadataTable -> ShowS
[MetadataTable] -> ShowS
MetadataTable -> String
(Int -> MetadataTable -> ShowS)
-> (MetadataTable -> String)
-> ([MetadataTable] -> ShowS)
-> Show MetadataTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataTable -> ShowS
showsPrec :: Int -> MetadataTable -> ShowS
$cshow :: MetadataTable -> String
show :: MetadataTable -> String
$cshowList :: [MetadataTable] -> ShowS
showList :: [MetadataTable] -> ShowS
Show)
emptyMetadataTable ::
Int ->
MdTable -> MetadataTable
emptyMetadataTable :: Int -> MdTable -> MetadataTable
emptyMetadataTable Int
globals MdTable
es = MetadataTable
{ mtEntries :: MdTable
mtEntries = MdTable
es
, mtNextNode :: Int
mtNextNode = Int
globals
, mtNodes :: IntMap (Bool, Bool, Int)
mtNodes = IntMap (Bool, Bool, Int)
forall a. IntMap a
IntMap.empty
}
metadata :: PValMd -> Typed PValue
metadata :: PValMd -> Typed PValue
metadata = Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Metadata) (PValue -> Typed PValue)
-> (PValMd -> PValue) -> PValMd -> Typed PValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PValMd -> PValue
forall lab. ValMd' lab -> Value' lab
ValMd
addMetadata :: PValMd -> MetadataTable -> (Int,MetadataTable)
addMetadata :: PValMd -> MetadataTable -> (Int, MetadataTable)
addMetadata PValMd
val MetadataTable
mt = (Int
ix, MetadataTable
mt { mtEntries = es' })
where
(Int
ix,MdTable
es') = Typed PValue -> MdTable -> (Int, MdTable)
addValue' (PValMd -> Typed PValue
metadata PValMd
val) (MetadataTable -> MdTable
mtEntries MetadataTable
mt)
addMdValue :: Typed PValue -> MetadataTable -> MetadataTable
addMdValue :: Typed PValue -> MetadataTable -> MetadataTable
addMdValue Typed PValue
tv MetadataTable
mt = MetadataTable
mt { mtEntries = addValue tv' (mtEntries mt) }
where
tv' :: Typed PValue
tv' = Typed { typedType :: Type
typedType = PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Metadata
, typedValue :: PValue
typedValue = PValMd -> PValue
forall lab. ValMd' lab -> Value' lab
ValMd (Typed PValue -> PValMd
forall lab. Typed (Value' lab) -> ValMd' lab
ValMdValue Typed PValue
tv)
}
nameNode :: Bool -> Bool -> Int -> MetadataTable -> MetadataTable
nameNode :: Bool -> Bool -> Int -> MetadataTable -> MetadataTable
nameNode Bool
fnLocal Bool
isDistinct Int
ix MetadataTable
mt = MetadataTable
mt
{ mtNodes = IntMap.insert ix (fnLocal,isDistinct,mtNextNode mt) (mtNodes mt)
, mtNextNode = mtNextNode mt + 1
}
addString :: String -> PartialMetadata -> PartialMetadata
addString :: String -> PartialMetadata -> PartialMetadata
addString String
str PartialMetadata
pm =
let (Int
ix, MetadataTable
mt) = PValMd -> MetadataTable -> (Int, MetadataTable)
addMetadata (String -> PValMd
forall lab. String -> ValMd' lab
ValMdString String
str) (PartialMetadata -> MetadataTable
pmEntries PartialMetadata
pm)
in PartialMetadata
pm { pmEntries = mt
, pmStrings = Map.insert ix str (pmStrings pm)
}
addStrings :: [String] -> PartialMetadata -> PartialMetadata
addStrings :: [String] -> PartialMetadata -> PartialMetadata
addStrings [String]
strs PartialMetadata
pm = (PartialMetadata -> String -> PartialMetadata)
-> PartialMetadata -> [String] -> PartialMetadata
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((String -> PartialMetadata -> PartialMetadata)
-> PartialMetadata -> String -> PartialMetadata
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> PartialMetadata -> PartialMetadata
addString) PartialMetadata
pm [String]
strs
addLoc :: Bool -> PDebugLoc -> MetadataTable -> MetadataTable
addLoc :: Bool -> PDebugLoc -> MetadataTable -> MetadataTable
addLoc Bool
isDistinct PDebugLoc
loc MetadataTable
mt = Bool -> Bool -> Int -> MetadataTable -> MetadataTable
nameNode Bool
False Bool
isDistinct Int
ix MetadataTable
mt'
where
(Int
ix,MetadataTable
mt') = PValMd -> MetadataTable -> (Int, MetadataTable)
addMetadata (PDebugLoc -> PValMd
forall lab. DebugLoc' lab -> ValMd' lab
ValMdLoc PDebugLoc
loc) MetadataTable
mt
addDebugInfo
:: Bool
-> DebugInfo' Int
-> MetadataTable
-> MetadataTable
addDebugInfo :: Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct DebugInfo' Int
di MetadataTable
mt = Bool -> Bool -> Int -> MetadataTable -> MetadataTable
nameNode Bool
False Bool
isDistinct Int
ix MetadataTable
mt'
where
(Int
ix,MetadataTable
mt') = PValMd -> MetadataTable -> (Int, MetadataTable)
addMetadata (DebugInfo' Int -> PValMd
forall lab. DebugInfo' lab -> ValMd' lab
ValMdDebugInfo DebugInfo' Int
di) MetadataTable
mt
addInlineDebugInfo :: DebugInfo' Int -> MetadataTable -> MetadataTable
addInlineDebugInfo :: DebugInfo' Int -> MetadataTable -> MetadataTable
addInlineDebugInfo DebugInfo' Int
di MetadataTable
mt = MetadataTable
mt { mtEntries = addValue tv (mtEntries mt) }
where
tv :: Typed PValue
tv = Typed { typedType :: Type
typedType = PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Metadata
, typedValue :: PValue
typedValue = PValMd -> PValue
forall lab. ValMd' lab -> Value' lab
ValMd (DebugInfo' Int -> PValMd
forall lab. DebugInfo' lab -> ValMd' lab
ValMdDebugInfo DebugInfo' Int
di)
}
addNode :: Bool -> [Maybe PValMd] -> MetadataTable -> MetadataTable
addNode :: Bool -> [Maybe PValMd] -> MetadataTable -> MetadataTable
addNode Bool
isDistinct [Maybe PValMd]
vals MetadataTable
mt = Bool -> Bool -> Int -> MetadataTable -> MetadataTable
nameNode Bool
False Bool
isDistinct Int
ix MetadataTable
mt'
where
(Int
ix,MetadataTable
mt') = PValMd -> MetadataTable -> (Int, MetadataTable)
addMetadata ([Maybe PValMd] -> PValMd
forall lab. [Maybe (ValMd' lab)] -> ValMd' lab
ValMdNode [Maybe PValMd]
vals) MetadataTable
mt
addOldNode :: Bool -> [Typed PValue] -> MetadataTable -> MetadataTable
addOldNode :: Bool -> [Typed PValue] -> MetadataTable -> MetadataTable
addOldNode Bool
fnLocal [Typed PValue]
vals MetadataTable
mt = Bool -> Bool -> Int -> MetadataTable -> MetadataTable
nameNode Bool
fnLocal Bool
False Int
ix MetadataTable
mt'
where
(Int
ix,MetadataTable
mt') = PValMd -> MetadataTable -> (Int, MetadataTable)
addMetadata ([Maybe PValMd] -> PValMd
forall lab. [Maybe (ValMd' lab)] -> ValMd' lab
ValMdNode [ PValMd -> Maybe PValMd
forall a. a -> Maybe a
Just (Typed PValue -> PValMd
forall lab. Typed (Value' lab) -> ValMd' lab
ValMdValue Typed PValue
tv) | Typed PValue
tv <- [Typed PValue]
vals ]) MetadataTable
mt
mdForwardRef :: [String] -> MetadataTable -> Int -> PValMd
mdForwardRef :: [String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt Int
ix = PValMd -> Maybe PValMd -> PValMd
forall a. a -> Maybe a -> a
fromMaybe PValMd
fallback Maybe PValMd
forall {lab}. Maybe (ValMd' lab)
nodeRef
where
nodeRef :: Maybe (ValMd' lab)
nodeRef = (Bool, Bool, Int) -> ValMd' lab
forall {b} {lab}. (Bool, b, Int) -> ValMd' lab
reference ((Bool, Bool, Int) -> ValMd' lab)
-> Maybe (Bool, Bool, Int) -> Maybe (ValMd' lab)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> IntMap (Bool, Bool, Int) -> Maybe (Bool, Bool, Int)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
ix (MetadataTable -> IntMap (Bool, Bool, Int)
mtNodes MetadataTable
mt)
fallback :: PValMd
fallback = case HasCallStack => [String] -> Int -> MdTable -> Typed PValue
[String] -> Int -> MdTable -> Typed PValue
forwardRef [String]
cxt Int
ix (MetadataTable -> MdTable
mtEntries MetadataTable
mt) of
Typed { typedValue :: forall a. Typed a -> a
typedValue = ValMd PValMd
md } -> PValMd
md
Typed PValue
tv -> Typed PValue -> PValMd
forall lab. Typed (Value' lab) -> ValMd' lab
ValMdValue Typed PValue
tv
reference :: (Bool, b, Int) -> ValMd' lab
reference (Bool
False, b
_, Int
r) = Int -> ValMd' lab
forall lab. Int -> ValMd' lab
ValMdRef Int
r
reference (Bool
_ , b
_, Int
r) =
let explanation :: String
explanation = String
"Illegal forward reference into function-local metadata."
in BadForwardRef -> ValMd' lab
forall a e. Exception e => e -> a
throw (CallStack -> [String] -> String -> Int -> BadForwardRef
BadValueRef CallStack
HasCallStack => CallStack
callStack [String]
cxt String
explanation Int
r)
mdForwardRefOrNull :: [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull :: [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull [String]
cxt MetadataTable
mt Int
ix | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = PValMd -> Maybe PValMd
forall a. a -> Maybe a
Just ([String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
| Bool
otherwise = Maybe PValMd
forall a. Maybe a
Nothing
mdNodeRef :: HasCallStack
=> [String] -> MetadataTable -> Int -> Int
mdNodeRef :: HasCallStack => [String] -> MetadataTable -> Int -> Int
mdNodeRef [String]
cxt MetadataTable
mt Int
ix = Int -> ((Bool, Bool, Int) -> Int) -> Maybe (Bool, Bool, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
forall {a}. a
except (Bool, Bool, Int) -> Int
forall {a} {b} {c}. (a, b, c) -> c
prj (Int -> IntMap (Bool, Bool, Int) -> Maybe (Bool, Bool, Int)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
ix (MetadataTable -> IntMap (Bool, Bool, Int)
mtNodes MetadataTable
mt))
where explanation :: String
explanation = String
"Bad forward reference into mtNodes"
except :: a
except = BadForwardRef -> a
forall a e. Exception e => e -> a
throw (CallStack -> [String] -> String -> Int -> BadForwardRef
BadValueRef CallStack
HasCallStack => CallStack
callStack [String]
cxt String
explanation Int
ix)
prj :: (a, b, c) -> c
prj (a
_, b
_, c
x) = c
x
mdString :: HasCallStack
=> [String] -> PartialMetadata -> Int -> String
mdString :: HasCallStack => [String] -> PartialMetadata -> Int -> String
mdString [String]
cxt PartialMetadata
partialMeta Int
ix =
let explanation :: String
explanation = String
"Null value when metadata string was expected"
in String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (BadForwardRef -> String
forall a e. Exception e => e -> a
throw (CallStack -> [String] -> String -> Int -> BadForwardRef
BadValueRef CallStack
HasCallStack => CallStack
callStack [String]
cxt String
explanation Int
ix))
(HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
cxt PartialMetadata
partialMeta Int
ix)
mdStringOrNull :: HasCallStack
=> [String]
-> PartialMetadata
-> Int
-> Maybe String
mdStringOrNull :: HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
cxt PartialMetadata
partialMeta Int
ix =
Int -> Map Int String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (PartialMetadata -> Map Int String
pmStrings PartialMetadata
partialMeta) Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
case [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull [String]
cxt (PartialMetadata -> MetadataTable
pmEntries PartialMetadata
partialMeta) Int
ix of
Maybe PValMd
Nothing -> Maybe String
forall a. Maybe a
Nothing
Just (ValMdString String
str) -> String -> Maybe String
forall a. a -> Maybe a
Just String
str
Just PValMd
_ ->
let explanation :: String
explanation = String
"Non-string metadata when string was expected"
in BadForwardRef -> Maybe String
forall a e. Exception e => e -> a
throw (CallStack -> [String] -> String -> Int -> BadForwardRef
BadTypeRef CallStack
HasCallStack => CallStack
callStack [String]
cxt String
explanation Int
ix)
mdStringOrEmpty :: HasCallStack
=> [String]
-> PartialMetadata
-> Int
-> String
mdStringOrEmpty :: HasCallStack => [String] -> PartialMetadata -> Int -> String
mdStringOrEmpty [String]
cxt PartialMetadata
partialMeta = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> (Int -> Maybe String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
cxt PartialMetadata
partialMeta
mkMdRefTable :: MetadataTable -> MdRefTable
mkMdRefTable :: MetadataTable -> MdRefTable
mkMdRefTable MetadataTable
mt = ((Bool, Bool, Int) -> Maybe Int)
-> IntMap (Bool, Bool, Int) -> MdRefTable
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe (Bool, Bool, Int) -> Maybe Int
forall {m :: * -> *} {b} {b}.
(Monad m, Alternative m) =>
(Bool, b, b) -> m b
step (MetadataTable -> IntMap (Bool, Bool, Int)
mtNodes MetadataTable
mt)
where
step :: (Bool, b, b) -> m b
step (Bool
fnLocal,b
_,b
ix) = do
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
fnLocal)
b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
ix
data PartialMetadata = PartialMetadata
{ PartialMetadata -> MetadataTable
pmEntries :: MetadataTable
, PartialMetadata -> Map String [Int]
pmNamedEntries :: Map.Map String [Int]
, PartialMetadata -> Maybe String
pmNextName :: Maybe String
, PartialMetadata -> InstrMdAttachments
pmInstrAttachments :: InstrMdAttachments
, PartialMetadata -> PFnMdAttachments
pmFnAttachments :: PFnMdAttachments
, PartialMetadata -> PGlobalAttachments
pmGlobalAttachments:: PGlobalAttachments
, PartialMetadata -> Map Int String
pmStrings :: Map Int String
} deriving (Int -> PartialMetadata -> ShowS
[PartialMetadata] -> ShowS
PartialMetadata -> String
(Int -> PartialMetadata -> ShowS)
-> (PartialMetadata -> String)
-> ([PartialMetadata] -> ShowS)
-> Show PartialMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialMetadata -> ShowS
showsPrec :: Int -> PartialMetadata -> ShowS
$cshow :: PartialMetadata -> String
show :: PartialMetadata -> String
$cshowList :: [PartialMetadata] -> ShowS
showList :: [PartialMetadata] -> ShowS
Show)
emptyPartialMetadata ::
Int ->
MdTable -> PartialMetadata
emptyPartialMetadata :: Int -> MdTable -> PartialMetadata
emptyPartialMetadata Int
globals MdTable
es = PartialMetadata
{ pmEntries :: MetadataTable
pmEntries = Int -> MdTable -> MetadataTable
emptyMetadataTable Int
globals MdTable
es
, pmNamedEntries :: Map String [Int]
pmNamedEntries = Map String [Int]
forall k a. Map k a
Map.empty
, pmNextName :: Maybe String
pmNextName = Maybe String
forall a. Maybe a
Nothing
, pmInstrAttachments :: InstrMdAttachments
pmInstrAttachments = InstrMdAttachments
forall k a. Map k a
Map.empty
, pmFnAttachments :: PFnMdAttachments
pmFnAttachments = PFnMdAttachments
forall k a. Map k a
Map.empty
, pmGlobalAttachments :: PGlobalAttachments
pmGlobalAttachments = PGlobalAttachments
forall k a. Map k a
Map.empty
, pmStrings :: Map Int String
pmStrings = Map Int String
forall k a. Map k a
Map.empty
}
updateMetadataTable :: (MetadataTable -> MetadataTable)
-> (PartialMetadata -> PartialMetadata)
updateMetadataTable :: (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable MetadataTable -> MetadataTable
f PartialMetadata
pm = PartialMetadata
pm { pmEntries = f (pmEntries pm) }
addGlobalAttachments ::
Symbol ->
(Map.Map KindMd PValMd) ->
(PartialMetadata -> PartialMetadata)
addGlobalAttachments :: Symbol -> Map String PValMd -> PartialMetadata -> PartialMetadata
addGlobalAttachments Symbol
sym Map String PValMd
mds PartialMetadata
pm =
PartialMetadata
pm { pmGlobalAttachments = Map.insert sym mds (pmGlobalAttachments pm)
}
setNextName :: String -> PartialMetadata -> PartialMetadata
setNextName :: String -> PartialMetadata -> PartialMetadata
setNextName String
name PartialMetadata
pm = PartialMetadata
pm { pmNextName = Just name }
addFnAttachment :: PFnMdAttachments -> PartialMetadata -> PartialMetadata
addFnAttachment :: PFnMdAttachments -> PartialMetadata -> PartialMetadata
addFnAttachment PFnMdAttachments
att PartialMetadata
pm =
PartialMetadata
pm { pmFnAttachments = Map.union att (pmFnAttachments pm) }
addInstrAttachment :: Int -> [(KindMd,PValMd)]
-> PartialMetadata -> PartialMetadata
addInstrAttachment :: Int -> [(String, PValMd)] -> PartialMetadata -> PartialMetadata
addInstrAttachment Int
instr [(String, PValMd)]
md PartialMetadata
pm =
PartialMetadata
pm { pmInstrAttachments = Map.insert instr md (pmInstrAttachments pm) }
nameMetadata :: [Int] -> PartialMetadata -> Parse PartialMetadata
nameMetadata :: [Int] -> PartialMetadata -> Parse PartialMetadata
nameMetadata [Int]
val PartialMetadata
pm = case PartialMetadata -> Maybe String
pmNextName PartialMetadata
pm of
Just String
name -> PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! PartialMetadata
pm
{ pmNextName = Nothing
, pmNamedEntries = Map.insert name val (pmNamedEntries pm)
}
Maybe String
Nothing -> String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected a metadata name"
dedupMetadata :: Seq PartialUnnamedMd -> Seq PartialUnnamedMd
dedupMetadata :: Seq PartialUnnamedMd -> Seq PartialUnnamedMd
dedupMetadata Seq PartialUnnamedMd
pumd = Map PValMd Int -> PartialUnnamedMd -> PartialUnnamedMd
helper (Seq PartialUnnamedMd -> Map PValMd Int
mkPartialUnnamedMdMap Seq PartialUnnamedMd
pumd) (PartialUnnamedMd -> PartialUnnamedMd)
-> Seq PartialUnnamedMd -> Seq PartialUnnamedMd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq PartialUnnamedMd
pumd
where helper :: Map PValMd Int -> PartialUnnamedMd -> PartialUnnamedMd
helper Map PValMd Int
pumdMap PartialUnnamedMd
pum =
let pumdMap' :: Map PValMd Int
pumdMap' = PValMd -> Map PValMd Int -> Map PValMd Int
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (PartialUnnamedMd -> PValMd
pumValues PartialUnnamedMd
pum) Map PValMd Int
pumdMap
in PartialUnnamedMd
pum { pumValues = maybeTransform pumdMap' (pumValues pum) }
maybeTransform :: Map PValMd Int -> PValMd -> PValMd
maybeTransform :: Map PValMd Int -> PValMd -> PValMd
maybeTransform Map PValMd Int
pumdMap v :: PValMd
v@(ValMdNode [Maybe PValMd]
_) = (PValMd -> PValMd) -> PValMd -> PValMd
forall on. Uniplate on => (on -> on) -> on -> on
transform (Map PValMd Int -> PValMd -> PValMd
trans Map PValMd Int
pumdMap) PValMd
v
maybeTransform Map PValMd Int
pumdMap v :: PValMd
v@(ValMdLoc PDebugLoc
_) = (PValMd -> PValMd) -> PValMd -> PValMd
forall on. Uniplate on => (on -> on) -> on -> on
transform (Map PValMd Int -> PValMd -> PValMd
trans Map PValMd Int
pumdMap) PValMd
v
maybeTransform Map PValMd Int
pumdMap v :: PValMd
v@(ValMdDebugInfo DebugInfo' Int
_) = (PValMd -> PValMd) -> PValMd -> PValMd
forall on. Uniplate on => (on -> on) -> on -> on
transform (Map PValMd Int -> PValMd -> PValMd
trans Map PValMd Int
pumdMap) PValMd
v
maybeTransform Map PValMd Int
_ PValMd
v = PValMd
v
trans :: Map PValMd Int -> PValMd -> PValMd
trans :: Map PValMd Int -> PValMd -> PValMd
trans Map PValMd Int
pumdMap PValMd
v = case PValMd -> Map PValMd Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PValMd
v Map PValMd Int
pumdMap of
Just Int
idex -> Int -> PValMd
forall lab. Int -> ValMd' lab
ValMdRef Int
idex
Maybe Int
Nothing -> PValMd
v
mkPartialUnnamedMdMap :: Seq PartialUnnamedMd -> Map PValMd Int
mkPartialUnnamedMdMap :: Seq PartialUnnamedMd -> Map PValMd Int
mkPartialUnnamedMdMap =
(Map PValMd Int -> PartialUnnamedMd -> Map PValMd Int)
-> Map PValMd Int -> Seq PartialUnnamedMd -> Map PValMd Int
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map PValMd Int
mp PartialUnnamedMd
part -> PValMd -> Int -> Map PValMd Int -> Map PValMd Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (PartialUnnamedMd -> PValMd
pumValues PartialUnnamedMd
part) (PartialUnnamedMd -> Int
pumIndex PartialUnnamedMd
part) Map PValMd Int
mp) Map PValMd Int
forall k a. Map k a
Map.empty
namedEntries :: PartialMetadata -> Seq NamedMd
namedEntries :: PartialMetadata -> Seq NamedMd
namedEntries = [NamedMd] -> Seq NamedMd
forall a. [a] -> Seq a
Seq.fromList
([NamedMd] -> Seq NamedMd)
-> (PartialMetadata -> [NamedMd]) -> PartialMetadata -> Seq NamedMd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [Int]) -> NamedMd) -> [(String, [Int])] -> [NamedMd]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [Int] -> NamedMd) -> (String, [Int]) -> NamedMd
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [Int] -> NamedMd
NamedMd)
([(String, [Int])] -> [NamedMd])
-> (PartialMetadata -> [(String, [Int])])
-> PartialMetadata
-> [NamedMd]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String [Int] -> [(String, [Int])]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map String [Int] -> [(String, [Int])])
-> (PartialMetadata -> Map String [Int])
-> PartialMetadata
-> [(String, [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialMetadata -> Map String [Int]
pmNamedEntries
data PartialUnnamedMd = PartialUnnamedMd
{ PartialUnnamedMd -> Int
pumIndex :: Int
, PartialUnnamedMd -> PValMd
pumValues :: PValMd
, PartialUnnamedMd -> Bool
pumDistinct :: Bool
} deriving (Typeable PartialUnnamedMd
Typeable PartialUnnamedMd =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PartialUnnamedMd -> c PartialUnnamedMd)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PartialUnnamedMd)
-> (PartialUnnamedMd -> Constr)
-> (PartialUnnamedMd -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PartialUnnamedMd))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PartialUnnamedMd))
-> ((forall b. Data b => b -> b)
-> PartialUnnamedMd -> PartialUnnamedMd)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r)
-> (forall u.
(forall d. Data d => d -> u) -> PartialUnnamedMd -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PartialUnnamedMd -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd)
-> Data PartialUnnamedMd
PartialUnnamedMd -> Constr
PartialUnnamedMd -> DataType
(forall b. Data b => b -> b)
-> PartialUnnamedMd -> PartialUnnamedMd
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PartialUnnamedMd -> u
forall u. (forall d. Data d => d -> u) -> PartialUnnamedMd -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PartialUnnamedMd
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PartialUnnamedMd -> c PartialUnnamedMd
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PartialUnnamedMd)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PartialUnnamedMd)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PartialUnnamedMd -> c PartialUnnamedMd
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PartialUnnamedMd -> c PartialUnnamedMd
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PartialUnnamedMd
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PartialUnnamedMd
$ctoConstr :: PartialUnnamedMd -> Constr
toConstr :: PartialUnnamedMd -> Constr
$cdataTypeOf :: PartialUnnamedMd -> DataType
dataTypeOf :: PartialUnnamedMd -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PartialUnnamedMd)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PartialUnnamedMd)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PartialUnnamedMd)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PartialUnnamedMd)
$cgmapT :: (forall b. Data b => b -> b)
-> PartialUnnamedMd -> PartialUnnamedMd
gmapT :: (forall b. Data b => b -> b)
-> PartialUnnamedMd -> PartialUnnamedMd
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PartialUnnamedMd -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PartialUnnamedMd -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PartialUnnamedMd -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PartialUnnamedMd -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PartialUnnamedMd -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PartialUnnamedMd -> m PartialUnnamedMd
Data, PartialUnnamedMd -> PartialUnnamedMd -> Bool
(PartialUnnamedMd -> PartialUnnamedMd -> Bool)
-> (PartialUnnamedMd -> PartialUnnamedMd -> Bool)
-> Eq PartialUnnamedMd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
== :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
$c/= :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
/= :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
Eq, Eq PartialUnnamedMd
Eq PartialUnnamedMd =>
(PartialUnnamedMd -> PartialUnnamedMd -> Ordering)
-> (PartialUnnamedMd -> PartialUnnamedMd -> Bool)
-> (PartialUnnamedMd -> PartialUnnamedMd -> Bool)
-> (PartialUnnamedMd -> PartialUnnamedMd -> Bool)
-> (PartialUnnamedMd -> PartialUnnamedMd -> Bool)
-> (PartialUnnamedMd -> PartialUnnamedMd -> PartialUnnamedMd)
-> (PartialUnnamedMd -> PartialUnnamedMd -> PartialUnnamedMd)
-> Ord PartialUnnamedMd
PartialUnnamedMd -> PartialUnnamedMd -> Bool
PartialUnnamedMd -> PartialUnnamedMd -> Ordering
PartialUnnamedMd -> PartialUnnamedMd -> PartialUnnamedMd
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 :: PartialUnnamedMd -> PartialUnnamedMd -> Ordering
compare :: PartialUnnamedMd -> PartialUnnamedMd -> Ordering
$c< :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
< :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
$c<= :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
<= :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
$c> :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
> :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
$c>= :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
>= :: PartialUnnamedMd -> PartialUnnamedMd -> Bool
$cmax :: PartialUnnamedMd -> PartialUnnamedMd -> PartialUnnamedMd
max :: PartialUnnamedMd -> PartialUnnamedMd -> PartialUnnamedMd
$cmin :: PartialUnnamedMd -> PartialUnnamedMd -> PartialUnnamedMd
min :: PartialUnnamedMd -> PartialUnnamedMd -> PartialUnnamedMd
Ord, (forall x. PartialUnnamedMd -> Rep PartialUnnamedMd x)
-> (forall x. Rep PartialUnnamedMd x -> PartialUnnamedMd)
-> Generic PartialUnnamedMd
forall x. Rep PartialUnnamedMd x -> PartialUnnamedMd
forall x. PartialUnnamedMd -> Rep PartialUnnamedMd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PartialUnnamedMd -> Rep PartialUnnamedMd x
from :: forall x. PartialUnnamedMd -> Rep PartialUnnamedMd x
$cto :: forall x. Rep PartialUnnamedMd x -> PartialUnnamedMd
to :: forall x. Rep PartialUnnamedMd x -> PartialUnnamedMd
Generic, Int -> PartialUnnamedMd -> ShowS
[PartialUnnamedMd] -> ShowS
PartialUnnamedMd -> String
(Int -> PartialUnnamedMd -> ShowS)
-> (PartialUnnamedMd -> String)
-> ([PartialUnnamedMd] -> ShowS)
-> Show PartialUnnamedMd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialUnnamedMd -> ShowS
showsPrec :: Int -> PartialUnnamedMd -> ShowS
$cshow :: PartialUnnamedMd -> String
show :: PartialUnnamedMd -> String
$cshowList :: [PartialUnnamedMd] -> ShowS
showList :: [PartialUnnamedMd] -> ShowS
Show, Typeable)
finalizePartialUnnamedMd :: PartialUnnamedMd -> Finalize UnnamedMd
finalizePartialUnnamedMd :: PartialUnnamedMd -> Finalize UnnamedMd
finalizePartialUnnamedMd PartialUnnamedMd
pum = ValMd -> UnnamedMd
mkUnnamedMd (ValMd -> UnnamedMd) -> Finalize ValMd -> Finalize UnnamedMd
forall a b. (a -> b) -> Finalize a -> Finalize b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` PValMd -> Finalize ValMd
finalizePValMd (PartialUnnamedMd -> PValMd
pumValues PartialUnnamedMd
pum)
where
mkUnnamedMd :: ValMd -> UnnamedMd
mkUnnamedMd ValMd
v = UnnamedMd
{ umIndex :: Int
umIndex = PartialUnnamedMd -> Int
pumIndex PartialUnnamedMd
pum
, umValues :: ValMd
umValues = ValMd
v
, umDistinct :: Bool
umDistinct = PartialUnnamedMd -> Bool
pumDistinct PartialUnnamedMd
pum
}
finalizePValMd :: PValMd -> Finalize ValMd
finalizePValMd :: PValMd -> Finalize ValMd
finalizePValMd = (Maybe Symbol -> Int -> Finalize BlockLabel)
-> PValMd -> Finalize ValMd
forall (f :: * -> *) (m :: * -> *) a b.
(HasLabel f, Applicative m) =>
(Maybe Symbol -> a -> m b) -> f a -> m (f b)
forall (m :: * -> *) a b.
Applicative m =>
(Maybe Symbol -> a -> m b) -> ValMd' a -> m (ValMd' b)
relabel ((Int -> Finalize BlockLabel)
-> Maybe Symbol -> Int -> Finalize BlockLabel
forall a b. a -> b -> a
const Int -> Finalize BlockLabel
requireBbEntryName)
unnamedEntries :: PartialMetadata -> (Seq PartialUnnamedMd, Seq PartialUnnamedMd)
unnamedEntries :: PartialMetadata -> (Seq PartialUnnamedMd, Seq PartialUnnamedMd)
unnamedEntries PartialMetadata
pm = ([PartialUnnamedMd] -> Seq PartialUnnamedMd)
-> ([PartialUnnamedMd] -> Seq PartialUnnamedMd)
-> ([PartialUnnamedMd], [PartialUnnamedMd])
-> (Seq PartialUnnamedMd, Seq PartialUnnamedMd)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [PartialUnnamedMd] -> Seq PartialUnnamedMd
forall a. [a] -> Seq a
Seq.fromList [PartialUnnamedMd] -> Seq PartialUnnamedMd
forall a. [a] -> Seq a
Seq.fromList ([Either PartialUnnamedMd PartialUnnamedMd]
-> ([PartialUnnamedMd], [PartialUnnamedMd])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (((Int, (Bool, Bool, Int))
-> Maybe (Either PartialUnnamedMd PartialUnnamedMd))
-> [(Int, (Bool, Bool, Int))]
-> [Either PartialUnnamedMd PartialUnnamedMd]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int, (Bool, Bool, Int))
-> Maybe (Either PartialUnnamedMd PartialUnnamedMd)
resolveNode (IntMap (Bool, Bool, Int) -> [(Int, (Bool, Bool, Int))]
forall a. IntMap a -> [(Int, a)]
IntMap.toList (MetadataTable -> IntMap (Bool, Bool, Int)
mtNodes MetadataTable
mt))))
where
mt :: MetadataTable
mt = PartialMetadata -> MetadataTable
pmEntries PartialMetadata
pm
resolveNode :: (Int, (Bool, Bool, Int))
-> Maybe (Either PartialUnnamedMd PartialUnnamedMd)
resolveNode :: (Int, (Bool, Bool, Int))
-> Maybe (Either PartialUnnamedMd PartialUnnamedMd)
resolveNode (Int
ref,(Bool
fnLocal,Bool
d,Int
ix)) =
((if Bool
fnLocal then PartialUnnamedMd -> Either PartialUnnamedMd PartialUnnamedMd
forall a b. b -> Either a b
Right else PartialUnnamedMd -> Either PartialUnnamedMd PartialUnnamedMd
forall a b. a -> Either a b
Left) (PartialUnnamedMd -> Either PartialUnnamedMd PartialUnnamedMd)
-> Maybe PartialUnnamedMd
-> Maybe (Either PartialUnnamedMd PartialUnnamedMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Bool -> Int -> Maybe PartialUnnamedMd
lookupNode Int
ref Bool
d Int
ix)
lookupNode :: Int -> Bool -> Int -> Maybe PartialUnnamedMd
lookupNode :: Int -> Bool -> Int -> Maybe PartialUnnamedMd
lookupNode Int
ref Bool
d Int
ix = do
Typed PValue
tv <- Int -> MdTable -> Maybe (Typed PValue)
lookupValueTableAbs Int
ref (MetadataTable -> MdTable
mtEntries MetadataTable
mt)
case Typed PValue
tv of
Typed { typedValue :: forall a. Typed a -> a
typedValue = ValMd PValMd
v } ->
PartialUnnamedMd -> Maybe PartialUnnamedMd
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PartialUnnamedMd -> Maybe PartialUnnamedMd)
-> PartialUnnamedMd -> Maybe PartialUnnamedMd
forall a b. (a -> b) -> a -> b
$! PartialUnnamedMd
{ pumIndex :: Int
pumIndex = Int
ix
, pumValues :: PValMd
pumValues = PValMd
v
, pumDistinct :: Bool
pumDistinct = Bool
d
}
Typed PValue
_ -> String -> Maybe PartialUnnamedMd
forall a. HasCallStack => String -> a
error String
"Impossible: Only ValMds are stored in mtEntries"
type InstrMdAttachments = Map.Map Int [(KindMd,PValMd)]
type PKindMd = Int
type PFnMdAttachments = Map.Map PKindMd PValMd
type PGlobalAttachments = Map.Map Symbol (Map.Map KindMd PValMd)
type ParsedMetadata =
( Seq NamedMd
, (Seq PartialUnnamedMd, Seq PartialUnnamedMd)
, InstrMdAttachments
, PFnMdAttachments
, PGlobalAttachments
)
parsedMetadata :: PartialMetadata -> ParsedMetadata
parsedMetadata :: PartialMetadata -> ParsedMetadata
parsedMetadata PartialMetadata
pm =
( PartialMetadata -> Seq NamedMd
namedEntries PartialMetadata
pm
, PartialMetadata -> (Seq PartialUnnamedMd, Seq PartialUnnamedMd)
unnamedEntries PartialMetadata
pm
, PartialMetadata -> InstrMdAttachments
pmInstrAttachments PartialMetadata
pm
, PartialMetadata -> PFnMdAttachments
pmFnAttachments PartialMetadata
pm
, PartialMetadata -> PGlobalAttachments
pmGlobalAttachments PartialMetadata
pm
)
parseMetadataBlock ::
Int ->
ValueTable -> [Entry] -> Parse ParsedMetadata
parseMetadataBlock :: Int -> MdTable -> [Entry] -> Parse ParsedMetadata
parseMetadataBlock Int
globals MdTable
vt [Entry]
es = String -> Parse ParsedMetadata -> Parse ParsedMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_BLOCK" (Parse ParsedMetadata -> Parse ParsedMetadata)
-> Parse ParsedMetadata -> Parse ParsedMetadata
forall a b. (a -> b) -> a -> b
$ do
MdTable
ms <- Parse MdTable
getMdTable
let pm0 :: PartialMetadata
pm0 = Int -> MdTable -> PartialMetadata
emptyPartialMetadata Int
globals MdTable
ms
rec PartialMetadata
pm <- (PartialMetadata -> Entry -> Parse PartialMetadata)
-> PartialMetadata -> [Entry] -> Parse PartialMetadata
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (MdTable
-> MetadataTable
-> PartialMetadata
-> Entry
-> Parse PartialMetadata
parseMetadataEntry MdTable
vt (PartialMetadata -> MetadataTable
pmEntries PartialMetadata
pm)) PartialMetadata
pm0 [Entry]
es
let entries :: MetadataTable
entries = PartialMetadata -> MetadataTable
pmEntries PartialMetadata
pm
MdTable -> Parse ()
setMdTable (MetadataTable -> MdTable
mtEntries MetadataTable
entries)
MdRefTable -> Parse ()
setMdRefs (MetadataTable -> MdRefTable
mkMdRefTable MetadataTable
entries)
ParsedMetadata -> Parse ParsedMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> ParsedMetadata
parsedMetadata PartialMetadata
pm)
parseMetadataEntry :: ValueTable -> MetadataTable -> PartialMetadata -> Entry
-> Parse PartialMetadata
parseMetadataEntry :: MdTable
-> MetadataTable
-> PartialMetadata
-> Entry
-> Parse PartialMetadata
parseMetadataEntry MdTable
vt MetadataTable
mt PartialMetadata
pm (Match Entry Record
fromEntry -> Just Record
r) =
let msg :: [String]
msg = [ String
"Are you sure you're using a supported version of LLVM/Clang?"
, String
"Check here: https://github.com/GaloisInc/llvm-pretty-bc-parser"
]
assertRecordSizeBetween :: Int -> Int -> f ()
assertRecordSizeBetween Int
lb Int
ub =
let len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
in Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb Bool -> Bool -> Bool
|| Int
ub Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"Invalid record size: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
, String
"Expected size between " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lb String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ub
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
msg
assertRecordSizeIn :: t Int -> f ()
assertRecordSizeIn t Int
ns =
let len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
in Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Int
len Int -> t Int -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
ns)) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"Invalid record size: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
, String
"Expected one of: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t Int -> String
forall a. Show a => a -> String
show t Int
ns
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
msg
assertRecordSizeAtLeast :: Int -> f ()
assertRecordSizeAtLeast Int
lb =
let len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
in Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"Invalid record size: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
, String
"Expected size of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lb String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or greater"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
msg
ron :: Int -> Parse (Maybe PValMd)
ron Int
n = do [String]
ctx <- Parse [String]
getContext
[String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull [String]
ctx MetadataTable
mt (Int -> Maybe PValMd) -> Parse Int -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
n Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
in case Record -> Int
recordCode Record
r of
Int
1 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_STRING" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
String
str <- ([DIEmissionKind] -> String)
-> Parse [DIEmissionKind] -> Parse String
forall a b. (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DIEmissionKind] -> String
UTF8.decode (Record
-> Int -> Match Field DIEmissionKind -> Parse [DIEmissionKind]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Match Field DIEmissionKind
char) Parse String -> Parse String -> Parse String
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Record -> LookupField String
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field String
string
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! String -> PartialMetadata -> PartialMetadata
addString String
str PartialMetadata
pm
Int
2 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_VALUE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
2]
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
Type
ty <- Int -> Parse Type
getType (Int -> Parse Type) -> Parse Int -> Parse Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LookupField Int
forall {a}. LookupField a
field Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Type
ty Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Metadata Bool -> Bool -> Bool
|| Type
ty Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Void)
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid record")
[String]
cxt <- Parse [String]
getContext
Int
ix <- LookupField Int
forall {a}. LookupField a
field Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let tv :: Typed PValue
tv = HasCallStack => [String] -> Int -> MdTable -> Typed PValue
[String] -> Int -> MdTable -> Typed PValue
forwardRef [String]
cxt Int
ix MdTable
vt
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable (Typed PValue -> MetadataTable -> MetadataTable
addMdValue Typed PValue
tv) PartialMetadata
pm
Int
3 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_NODE" (Bool
-> MetadataTable
-> Record
-> PartialMetadata
-> Parse PartialMetadata
parseMetadataNode Bool
False MetadataTable
mt Record
r PartialMetadata
pm)
Int
4 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_NAME" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
String
name <- ([DIEmissionKind] -> String)
-> Parse [DIEmissionKind] -> Parse String
forall a b. (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DIEmissionKind] -> String
UTF8.decode (Record
-> Int -> Match Field DIEmissionKind -> Parse [DIEmissionKind]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Match Field DIEmissionKind
char) Parse String -> Parse String -> Parse String
forall a. Parse a -> Parse a -> Parse a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Record -> LookupField String
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field String
cstring
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! String -> PartialMetadata -> PartialMetadata
setNextName String
name PartialMetadata
pm
Int
5 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_DISTINCT_NODE" (Bool
-> MetadataTable
-> Record
-> PartialMetadata
-> Parse PartialMetadata
parseMetadataNode Bool
True MetadataTable
mt Record
r PartialMetadata
pm)
Int
6 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_KIND" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int
kind <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
String
name <- [DIEmissionKind] -> String
UTF8.decode ([DIEmissionKind] -> String)
-> Parse [DIEmissionKind] -> Parse String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record
-> Int -> Match Field DIEmissionKind -> Parse [DIEmissionKind]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
1 Match Field DIEmissionKind
char
Int -> String -> Parse ()
addKind Int
kind String
name
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialMetadata
pm
Int
7 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_LOCATION" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
5, Int
6]
let field :: LookupField a
field = Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r
[String]
cxt <- Parse [String]
getContext
Bool
isDistinct <- LookupField Bool
forall {a}. LookupField a
field Int
0 Match Field Bool
nonzero
Word32
dlLine <- LookupField Word32
forall {a}. LookupField a
field Int
1 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
dlCol <- LookupField Word32
forall {a}. LookupField a
field Int
2 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
PValMd
dlScope <- [String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt (Int -> PValMd) -> Parse Int -> Parse PValMd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LookupField Int
forall {a}. LookupField a
field Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dlIA <- [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull [String]
cxt MetadataTable
mt (Int -> Maybe PValMd) -> Parse Int -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LookupField Int
forall {a}. LookupField a
field Int
4 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Bool
dlImplicit <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5
then Bool -> Parse Bool
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
5 Match Field Bool
nonzero
let loc :: PDebugLoc
loc = DebugLoc {Bool
Maybe PValMd
Word32
PValMd
dlLine :: Word32
dlCol :: Word32
dlScope :: PValMd
dlIA :: Maybe PValMd
dlImplicit :: Bool
dlLine :: Word32
dlCol :: Word32
dlScope :: PValMd
dlIA :: Maybe PValMd
dlImplicit :: Bool
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable (Bool -> PDebugLoc -> MetadataTable -> MetadataTable
addLoc Bool
isDistinct PDebugLoc
loc) PartialMetadata
pm
Int
8 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_OLD_NODE" (Bool
-> MdTable
-> MetadataTable
-> Record
-> PartialMetadata
-> Parse PartialMetadata
parseMetadataOldNode Bool
False MdTable
vt MetadataTable
mt Record
r PartialMetadata
pm)
Int
9 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_OLD_FN_NODE" (Bool
-> MdTable
-> MetadataTable
-> Record
-> PartialMetadata
-> Parse PartialMetadata
parseMetadataOldNode Bool
True MdTable
vt MetadataTable
mt Record
r PartialMetadata
pm)
Int
10 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_NAMED_NODE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int]
mdIds <- Record -> Int -> Match Field Int -> Parse [Int]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[String]
cxt <- Parse [String]
getContext
let ids :: [Int]
ids = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (HasCallStack => [String] -> MetadataTable -> Int -> Int
[String] -> MetadataTable -> Int -> Int
mdNodeRef [String]
cxt MetadataTable
mt) [Int]
mdIds
[Int] -> PartialMetadata -> Parse PartialMetadata
nameMetadata [Int]
ids PartialMetadata
pm
Int
11 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_ATTACHMENT" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
let recordSize :: Int
recordSize = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
recordSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid record")
if Int
recordSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"function attachment" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
PFnMdAttachments
att <- [(Int, PValMd)] -> PFnMdAttachments
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, PValMd)] -> PFnMdAttachments)
-> Parse [(Int, PValMd)] -> Parse PFnMdAttachments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> Int -> Parse [(Int, PValMd)]
parseAttachment Record
r Int
0
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! PFnMdAttachments -> PartialMetadata -> PartialMetadata
addFnAttachment PFnMdAttachments
att PartialMetadata
pm
else String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"instruction attachment" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int
inst <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[(Int, PValMd)]
patt <- Record -> Int -> Parse [(Int, PValMd)]
parseAttachment Record
r Int
1
[(String, PValMd)]
att <- ((Int, PValMd) -> Parse (String, PValMd))
-> [(Int, PValMd)] -> Parse [(String, PValMd)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Int
k,PValMd
md) -> (,PValMd
md) (String -> (String, PValMd))
-> Parse String -> Parse (String, PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parse String
getKind Int
k) [(Int, PValMd)]
patt
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! Int -> [(String, PValMd)] -> PartialMetadata -> PartialMetadata
addInstrAttachment Int
inst [(String, PValMd)]
att PartialMetadata
pm
Int
12 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_GENERIC_DEBUG" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not yet implemented"
Int
13 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_SUBRANGE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
3, Int
5]
Word32
field0 <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Word32
unsigned
let isDistinct :: Bool
isDistinct = Word32
field0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
1
let format :: Word32
format = Word32
field0 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
let asValMdInt64 :: Integer -> Maybe (ValMd' lab)
asValMdInt64 Integer
x = ValMd' lab -> Maybe (ValMd' lab)
forall a. a -> Maybe a
Just (ValMd' lab -> Maybe (ValMd' lab))
-> ValMd' lab -> Maybe (ValMd' lab)
forall a b. (a -> b) -> a -> b
$ Typed (Value' lab) -> ValMd' lab
forall lab. Typed (Value' lab) -> ValMd' lab
ValMdValue
(Typed (Value' lab) -> ValMd' lab)
-> Typed (Value' lab) -> ValMd' lab
forall a b. (a -> b) -> a -> b
$ Typed { typedType :: Type
typedType = PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType (PrimType -> Type) -> PrimType -> Type
forall a b. (a -> b) -> a -> b
$ Word32 -> PrimType
Integer Word32
64
, typedValue :: Value' lab
typedValue = Integer -> Value' lab
forall lab. Integer -> Value' lab
ValInteger Integer
x
}
DISubrange' Int
diNode <- case Word32
format of
Word32
2 -> do Maybe PValMd
disrCount <- Int -> Parse (Maybe PValMd)
ron Int
1
Maybe PValMd
disrLowerBound <- Int -> Parse (Maybe PValMd)
ron Int
2
Maybe PValMd
disrUpperBound <- Int -> Parse (Maybe PValMd)
ron Int
3
Maybe PValMd
disrStride <- Int -> Parse (Maybe PValMd)
ron Int
4
DISubrange' Int -> Parse (DISubrange' Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (DISubrange' Int -> Parse (DISubrange' Int))
-> DISubrange' Int -> Parse (DISubrange' Int)
forall a b. (a -> b) -> a -> b
$ DISubrange {Maybe PValMd
disrCount :: Maybe PValMd
disrLowerBound :: Maybe PValMd
disrUpperBound :: Maybe PValMd
disrStride :: Maybe PValMd
disrCount :: Maybe PValMd
disrLowerBound :: Maybe PValMd
disrUpperBound :: Maybe PValMd
disrStride :: Maybe PValMd
..}
Word32
1 -> do Maybe PValMd
disrCount <- Int -> Parse (Maybe PValMd)
ron Int
1
Maybe PValMd
disrLowerBound <- Int -> Parse (Maybe PValMd)
ron Int
2
let disrUpperBound :: Maybe a
disrUpperBound = Maybe a
forall a. Maybe a
Nothing
let disrStride :: Maybe a
disrStride = Maybe a
forall a. Maybe a
Nothing
DISubrange' Int -> Parse (DISubrange' Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (DISubrange' Int -> Parse (DISubrange' Int))
-> DISubrange' Int -> Parse (DISubrange' Int)
forall a b. (a -> b) -> a -> b
$ DISubrange {Maybe PValMd
forall a. Maybe a
disrCount :: Maybe PValMd
disrLowerBound :: Maybe PValMd
disrUpperBound :: Maybe PValMd
disrStride :: Maybe PValMd
disrCount :: Maybe PValMd
disrLowerBound :: Maybe PValMd
disrUpperBound :: forall a. Maybe a
disrStride :: forall a. Maybe a
..}
Word32
0 -> do Maybe PValMd
disrCount <- Integer -> Maybe PValMd
forall {lab}. Integer -> Maybe (ValMd' lab)
asValMdInt64 (Integer -> Maybe PValMd) -> Parse Integer -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Integer
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Integer
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
disrLowerBound <- Integer -> Maybe PValMd
forall {lab}. Integer -> Maybe (ValMd' lab)
asValMdInt64 (Integer -> Maybe PValMd)
-> (Int64 -> Integer) -> Int64 -> Maybe PValMd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe PValMd) -> Parse Int64 -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int64
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int64
signedInt64
let disrUpperBound :: Maybe a
disrUpperBound = Maybe a
forall a. Maybe a
Nothing
let disrStride :: Maybe a
disrStride = Maybe a
forall a. Maybe a
Nothing
DISubrange' Int -> Parse (DISubrange' Int)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (DISubrange' Int -> Parse (DISubrange' Int))
-> DISubrange' Int -> Parse (DISubrange' Int)
forall a b. (a -> b) -> a -> b
$ DISubrange {Maybe PValMd
forall a. Maybe a
disrCount :: Maybe PValMd
disrLowerBound :: Maybe PValMd
disrUpperBound :: Maybe PValMd
disrStride :: Maybe PValMd
disrCount :: Maybe PValMd
disrLowerBound :: Maybe PValMd
disrUpperBound :: forall a. Maybe a
disrStride :: forall a. Maybe a
..}
Word32
_ -> String -> Parse (DISubrange' Int)
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parse (DISubrange' Int))
-> String -> Parse (DISubrange' Int)
forall a b. (a -> b) -> a -> b
$ String
"Unknown format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
format
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DISubrange' Int -> DebugInfo' Int
forall lab. DISubrange' lab -> DebugInfo' lab
DebugInfoSubrange DISubrange' Int
diNode)) PartialMetadata
pm
Int
14 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_ENUMERATOR" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> f ()
assertRecordSizeAtLeast Int
3
[String]
ctx <- Parse [String]
getContext
Int
flags <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let isDistinct :: Bool
isDistinct = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Int
flags :: Int) Int
0
isUnsigned :: Bool
isUnsigned = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Int
flags :: Int) Int
1
isBigInt :: Bool
isBigInt = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Int
flags :: Int) Int
2
String
name <- HasCallStack => [String] -> PartialMetadata -> Int -> String
[String] -> PartialMetadata -> Int -> String
mdString [String]
ctx PartialMetadata
pm (Int -> String) -> Parse Int -> Parse String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Integer
value <-
if Bool
isBigInt
then Record -> Int -> Parse Integer
parseWideInteger Record
r Int
3
else Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer) -> Parse Int64 -> Parse Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int64
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Int64
signedInt64
let diEnum :: DebugInfo' lab
diEnum = String -> Integer -> Bool -> DebugInfo' lab
forall lab. String -> Integer -> Bool -> DebugInfo' lab
DebugInfoEnumerator String
name Integer
value Bool
isUnsigned
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable (Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct DebugInfo' Int
forall {lab}. DebugInfo' lab
diEnum) PartialMetadata
pm
Int
15 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_BASIC_TYPE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
6, Int
7]
[String]
ctx <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
DwarfTag
dibtTag <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
String
dibtName <- HasCallStack => [String] -> PartialMetadata -> Int -> String
[String] -> PartialMetadata -> Int -> String
mdString [String]
ctx PartialMetadata
pm (Int -> String) -> Parse Int -> Parse String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Word64
dibtSize <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
3 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word64
dibtAlign <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
DwarfTag
dibtEncoding <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
5 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe Word32
dibtFlags <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6
then Maybe Word32 -> Parse (Maybe Word32)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
forall a. Maybe a
Nothing
else Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Parse Word32 -> Parse (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
6 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let dibt :: DIBasicType
dibt = DIBasicType {String
Maybe Word32
DwarfTag
Word64
dibtTag :: DwarfTag
dibtName :: String
dibtSize :: Word64
dibtAlign :: Word64
dibtEncoding :: DwarfTag
dibtFlags :: Maybe Word32
dibtTag :: DwarfTag
dibtName :: String
dibtSize :: Word64
dibtAlign :: Word64
dibtEncoding :: DwarfTag
dibtFlags :: Maybe Word32
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DIBasicType -> DebugInfo' Int
forall lab. DIBasicType -> DebugInfo' lab
DebugInfoBasicType DIBasicType
dibt)) PartialMetadata
pm
Int
16 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_FILE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
3, Int
5]
[String]
ctx <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
String
difFilename <- HasCallStack => [String] -> PartialMetadata -> Int -> String
[String] -> PartialMetadata -> Int -> String
mdStringOrEmpty [String]
ctx PartialMetadata
pm (Int -> String) -> Parse Int -> Parse String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
String
difDirectory <- HasCallStack => [String] -> PartialMetadata -> Int -> String
[String] -> PartialMetadata -> Int -> String
mdStringOrEmpty [String]
ctx PartialMetadata
pm (Int -> String) -> Parse Int -> Parse String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let diFile :: DIFile
diFile = DIFile {String
difFilename :: String
difDirectory :: String
difFilename :: String
difDirectory :: String
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DIFile -> DebugInfo' Int
forall lab. DIFile -> DebugInfo' lab
DebugInfoFile DIFile
diFile)) PartialMetadata
pm
Int
17 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_DERIVED_TYPE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
12 Int
15
[String]
ctx <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
DwarfTag
didtTag <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
didtName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
didtFile <- Int -> Parse (Maybe PValMd)
ron Int
3
Word32
didtLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
didtScope <- Int -> Parse (Maybe PValMd)
ron Int
5
Maybe PValMd
didtBaseType <- Int -> Parse (Maybe PValMd)
ron Int
6
Word64
didtSize <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
7 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word64
didtAlign <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
8 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word64
didtOffset <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
9 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
didtFlags <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
10 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
didtExtraData <- Int -> Parse (Maybe PValMd)
ron Int
11
Maybe Word32
didtDwarfAddressSpace <-
if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
12
then Maybe Word32 -> Parse (Maybe Word32)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
forall a. Maybe a
Nothing
else do Word32
v <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
12 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
if Word32
v Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
then Maybe Word32 -> Parse (Maybe Word32)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
else Maybe Word32 -> Parse (Maybe Word32)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> Parse (Maybe Word32))
-> Maybe Word32 -> Parse (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Word32 -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ Word32
v Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1
Maybe PValMd
didtAnnotations <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
13
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
13
let didt :: DIDerivedType' Int
didt = DIDerivedType {Maybe String
Maybe Word32
Maybe PValMd
DwarfTag
Word32
Word64
didtTag :: DwarfTag
didtName :: Maybe String
didtFile :: Maybe PValMd
didtLine :: Word32
didtScope :: Maybe PValMd
didtBaseType :: Maybe PValMd
didtSize :: Word64
didtAlign :: Word64
didtOffset :: Word64
didtFlags :: Word32
didtExtraData :: Maybe PValMd
didtDwarfAddressSpace :: Maybe Word32
didtAnnotations :: Maybe PValMd
didtTag :: DwarfTag
didtName :: Maybe String
didtFile :: Maybe PValMd
didtLine :: Word32
didtScope :: Maybe PValMd
didtBaseType :: Maybe PValMd
didtSize :: Word64
didtAlign :: Word64
didtOffset :: Word64
didtFlags :: Word32
didtExtraData :: Maybe PValMd
didtDwarfAddressSpace :: Maybe Word32
didtAnnotations :: Maybe PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DIDerivedType' Int -> DebugInfo' Int
forall lab. DIDerivedType' lab -> DebugInfo' lab
DebugInfoDerivedType DIDerivedType' Int
didt)) PartialMetadata
pm
Int
18 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_COMPOSITE_TYPE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
16 Int
22
[String]
ctx <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
DwarfTag
dictTag <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
dictName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dictFile <- Int -> Parse (Maybe PValMd)
ron Int
3
Word32
dictLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dictScope <- Int -> Parse (Maybe PValMd)
ron Int
5
Maybe PValMd
dictBaseType <- Int -> Parse (Maybe PValMd)
ron Int
6
Word64
dictSize <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
7 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word64
dictAlign <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
8 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word64
dictOffset <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
9 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
dictFlags <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
10 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dictElements <- Int -> Parse (Maybe PValMd)
ron Int
11
DwarfTag
dictRuntimeLang <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
12 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dictVTableHolder <- Int -> Parse (Maybe PValMd)
ron Int
13
Maybe PValMd
dictTemplateParams <- Int -> Parse (Maybe PValMd)
ron Int
14
Maybe String
dictIdentifier <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
15 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dictDiscriminator <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
16
Maybe PValMd
dictDataLocation <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
17
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
17
Maybe PValMd
dictAssociated <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
18
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
18
Maybe PValMd
dictAllocated <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
19
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
19
Maybe PValMd
dictRank <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
20
Maybe PValMd
dictAnnotations <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
21
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
21
let dict :: DICompositeType' Int
dict = DICompositeType {Maybe String
Maybe PValMd
DwarfTag
Word32
Word64
dictTag :: DwarfTag
dictName :: Maybe String
dictFile :: Maybe PValMd
dictLine :: Word32
dictScope :: Maybe PValMd
dictBaseType :: Maybe PValMd
dictSize :: Word64
dictAlign :: Word64
dictOffset :: Word64
dictFlags :: Word32
dictElements :: Maybe PValMd
dictRuntimeLang :: DwarfTag
dictVTableHolder :: Maybe PValMd
dictTemplateParams :: Maybe PValMd
dictIdentifier :: Maybe String
dictDiscriminator :: Maybe PValMd
dictDataLocation :: Maybe PValMd
dictAssociated :: Maybe PValMd
dictAllocated :: Maybe PValMd
dictRank :: Maybe PValMd
dictAnnotations :: Maybe PValMd
dictTag :: DwarfTag
dictName :: Maybe String
dictFile :: Maybe PValMd
dictLine :: Word32
dictScope :: Maybe PValMd
dictBaseType :: Maybe PValMd
dictSize :: Word64
dictAlign :: Word64
dictOffset :: Word64
dictFlags :: Word32
dictElements :: Maybe PValMd
dictRuntimeLang :: DwarfTag
dictVTableHolder :: Maybe PValMd
dictTemplateParams :: Maybe PValMd
dictIdentifier :: Maybe String
dictDiscriminator :: Maybe PValMd
dictDataLocation :: Maybe PValMd
dictAssociated :: Maybe PValMd
dictAllocated :: Maybe PValMd
dictRank :: Maybe PValMd
dictAnnotations :: Maybe PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DICompositeType' Int -> DebugInfo' Int
forall lab. DICompositeType' lab -> DebugInfo' lab
DebugInfoCompositeType DICompositeType' Int
dict)) PartialMetadata
pm
Int
19 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_SUBROUTINE_TYPE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
3 Int
4
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
Word32
distFlags <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
distTypeArray <- Int -> Parse (Maybe PValMd)
ron Int
2
let dist :: DISubroutineType' Int
dist = DISubroutineType {Maybe PValMd
Word32
distFlags :: Word32
distTypeArray :: Maybe PValMd
distFlags :: Word32
distTypeArray :: Maybe PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DISubroutineType' Int -> DebugInfo' Int
forall lab. DISubroutineType' lab -> DebugInfo' lab
DebugInfoSubroutineType DISubroutineType' Int
dist)) PartialMetadata
pm
Int
20 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_COMPILE_UNIT" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
14 Int
22
let recordSize :: Int
recordSize = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
[String]
ctx <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
DwarfTag
dicuLanguage <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dicuFile <- Int -> Parse (Maybe PValMd)
ron Int
2
Maybe String
dicuProducer <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Bool
dicuIsOptimized <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Bool
nonzero
Maybe String
dicuFlags <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
5 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
DwarfTag
dicuRuntimeVersion <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
6 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
dicuSplitDebugFilename <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
7 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
DIEmissionKind
dicuEmissionKind <- Record -> LookupField DIEmissionKind
forall a. Record -> LookupField a
parseField Record
r Int
8 Match Field DIEmissionKind
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dicuEnums <- Int -> Parse (Maybe PValMd)
ron Int
9
Maybe PValMd
dicuRetainedTypes <- Int -> Parse (Maybe PValMd)
ron Int
10
Maybe PValMd
dicuSubprograms <- Int -> Parse (Maybe PValMd)
ron Int
11
Maybe PValMd
dicuGlobals <- Int -> Parse (Maybe PValMd)
ron Int
12
Maybe PValMd
dicuImports <- Int -> Parse (Maybe PValMd)
ron Int
13
Maybe PValMd
dicuMacros <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
15
then Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
else Int -> Parse (Maybe PValMd)
ron Int
15
Word64
dicuDWOId <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
14
then Word64 -> Parse Word64
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
else Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
14 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Bool
dicuSplitDebugInlining <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16
then Bool -> Parse Bool
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
16 Match Field Bool
nonzero
Bool
dicuDebugInfoForProf <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
17
then Bool -> Parse Bool
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
17 Match Field Bool
nonzero
Word64
dicuNameTableKind <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
18
then Word64 -> Parse Word64
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
else Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
18 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Bool
dicuRangesBaseAddress <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
19
then Bool -> Parse Bool
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
19 Match Field Bool
nonzero
Maybe String
dicuSysRoot <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20
then Maybe String -> Parse (Maybe String)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
else HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
20 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
dicuSDK <- if Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
21
then Maybe String -> Parse (Maybe String)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
else HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
21 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let dicu :: DICompileUnit' Int
dicu = DICompileUnit {Bool
Maybe String
Maybe PValMd
DIEmissionKind
DwarfTag
Word64
dicuLanguage :: DwarfTag
dicuFile :: Maybe PValMd
dicuProducer :: Maybe String
dicuIsOptimized :: Bool
dicuFlags :: Maybe String
dicuRuntimeVersion :: DwarfTag
dicuSplitDebugFilename :: Maybe String
dicuEmissionKind :: DIEmissionKind
dicuEnums :: Maybe PValMd
dicuRetainedTypes :: Maybe PValMd
dicuSubprograms :: Maybe PValMd
dicuGlobals :: Maybe PValMd
dicuImports :: Maybe PValMd
dicuMacros :: Maybe PValMd
dicuDWOId :: Word64
dicuSplitDebugInlining :: Bool
dicuDebugInfoForProf :: Bool
dicuNameTableKind :: Word64
dicuRangesBaseAddress :: Bool
dicuSysRoot :: Maybe String
dicuSDK :: Maybe String
dicuLanguage :: DwarfTag
dicuFile :: Maybe PValMd
dicuProducer :: Maybe String
dicuIsOptimized :: Bool
dicuFlags :: Maybe String
dicuRuntimeVersion :: DwarfTag
dicuSplitDebugFilename :: Maybe String
dicuEmissionKind :: DIEmissionKind
dicuEnums :: Maybe PValMd
dicuRetainedTypes :: Maybe PValMd
dicuSubprograms :: Maybe PValMd
dicuGlobals :: Maybe PValMd
dicuImports :: Maybe PValMd
dicuMacros :: Maybe PValMd
dicuDWOId :: Word64
dicuSplitDebugInlining :: Bool
dicuDebugInfoForProf :: Bool
dicuNameTableKind :: Word64
dicuRangesBaseAddress :: Bool
dicuSysRoot :: Maybe String
dicuSDK :: Maybe String
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DICompileUnit' Int -> DebugInfo' Int
forall lab. DICompileUnit' lab -> DebugInfo' lab
DebugInfoCompileUnit DICompileUnit' Int
dicu)) PartialMetadata
pm
Int
21 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_SUBPROGRAM" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
18 Int
21
Word64
version <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
let hasSPFlags :: Bool
hasSPFlags = (Word64
version Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
0x4 :: Word64)) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0;
(Word32
diFlags0, Word32
spFlags0) <-
if Bool
hasSPFlags then
(,) (Word32 -> Word32 -> (Word32, Word32))
-> Parse Word32 -> Parse (Word32 -> (Word32, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
11 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric Parse (Word32 -> (Word32, Word32))
-> Parse Word32 -> Parse (Word32, Word32)
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
9 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
else
(,) (Word32 -> Word32 -> (Word32, Word32))
-> Parse Word32 -> Parse (Word32 -> (Word32, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric Parse (Word32 -> (Word32, Word32))
-> Parse Word32 -> Parse (Word32, Word32)
forall a b. Parse (a -> b) -> Parse a -> Parse b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> Parse Word32
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0
let diFlagMainSubprogram :: Word32
diFlagMainSubprogram = Int -> Word32
forall a. Bits a => Int -> a
bit Int
21 :: Word32
hasOldMainSubprogramFlag :: Bool
hasOldMainSubprogramFlag = (Word32
diFlags0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
diFlagMainSubprogram) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
spFlagIsLocal :: Word32
spFlagIsLocal = Int -> Word32
forall a. Bits a => Int -> a
bit Int
2
spFlagIsDefinition :: Word32
spFlagIsDefinition = Int -> Word32
forall a. Bits a => Int -> a
bit Int
3
spFlagIsOptimized :: Word32
spFlagIsOptimized = Int -> Word32
forall a. Bits a => Int -> a
bit Int
4
spFlagIsMain :: Word32
spFlagIsMain = Int -> Word32
forall a. Bits a => Int -> a
bit Int
8
dispFlags :: Word32
dispFlags :: Word32
dispFlags
| Bool
hasOldMainSubprogramFlag = Word32
diFlags0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
diFlagMainSubprogram
| Bool
otherwise = Word32
diFlags0
spFlags :: Word32
spFlags :: Word32
spFlags
| Bool
hasOldMainSubprogramFlag = Word32
spFlags0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
spFlagIsMain
| Bool
otherwise = Word32
spFlags0
(Bool
dispIsLocal, Bool
dispIsDefinition, Bool
dispIsOptimized, DIEmissionKind
dispVirtuality, Bool
_isMain) <-
if Bool
hasSPFlags then
let spIsLocal :: Bool
spIsLocal = Word32
spFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
spFlagIsLocal Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
spIsDefinition :: Bool
spIsDefinition = Word32
spFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
spFlagIsDefinition Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
spIsOptimized :: Bool
spIsOptimized = Word32
spFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
spFlagIsOptimized Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
spIsMain :: Bool
spIsMain = Word32
spFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
spFlagIsMain Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
spVirtuality :: Word8
spVirtuality :: DIEmissionKind
spVirtuality = Word32 -> DIEmissionKind
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
spFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x3)
in (Bool, Bool, Bool, DIEmissionKind, Bool)
-> Parse (Bool, Bool, Bool, DIEmissionKind, Bool)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
spIsLocal, Bool
spIsDefinition, Bool
spIsOptimized, DIEmissionKind
spVirtuality, Bool
spIsMain)
else
do Bool
spIsLocal <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
7 Match Field Bool
nonzero
Bool
spIsDefinition <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
8 Match Field Bool
nonzero
Bool
spIsOptimized <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
14 Match Field Bool
nonzero
DIEmissionKind
spVirtuality <- Record -> LookupField DIEmissionKind
forall a. Record -> LookupField a
parseField Record
r Int
11 Match Field DIEmissionKind
forall a. (Num a, Bits a) => Match Field a
numeric
(Bool, Bool, Bool, DIEmissionKind, Bool)
-> Parse (Bool, Bool, Bool, DIEmissionKind, Bool)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
spIsLocal, Bool
spIsDefinition, Bool
spIsOptimized, DIEmissionKind
spVirtuality, Bool
hasOldMainSubprogramFlag)
let recordSize :: Int
recordSize = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
isDistinct :: Bool
isDistinct = (Word64
version Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0) Bool -> Bool -> Bool
|| (Word32
spFlags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
spFlagIsDefinition Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0)
hasUnit :: Bool
hasUnit = Word64
version Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
offsetA :: Int
offsetA
| Bool -> Bool
not Bool
hasSPFlags = Int
2
| Bool
otherwise = Int
0
offsetB :: Int
offsetB
| Bool -> Bool
not Bool
hasSPFlags Bool -> Bool -> Bool
&& Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
19 = Int
3
| Bool -> Bool
not Bool
hasSPFlags = Int
2
| Bool
otherwise = Int
0
hasThisAdjustment :: Bool
hasThisAdjustment
| Bool -> Bool
not Bool
hasSPFlags = Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
20
| Bool
otherwise = Bool
True
hasThrownTypes :: Bool
hasThrownTypes
| Bool -> Bool
not Bool
hasSPFlags = Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
21
| Bool
otherwise = Bool
True
hasAnnotations :: Bool
hasAnnotations
| Bool -> Bool
not Bool
hasSPFlags = Bool
False
| Bool
otherwise = Int
recordSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
19
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
hasSPFlags Bool -> Bool -> Bool
&& Bool
hasUnit)
(Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
19 Int
21)
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasSPFlags Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasUnit)
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DISubprogram record has subprogram flags, but does not have unit. Invalid record.")
[String]
ctx <- Parse [String]
getContext
let optFwdRef :: Bool -> Int -> Parse (Maybe PValMd)
optFwdRef Bool
b Int
n =
if Bool
b
then [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull [String]
ctx MetadataTable
mt (Int -> Maybe PValMd) -> Parse Int -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
n Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
else Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
Maybe PValMd
dispScope <- Int -> Parse (Maybe PValMd)
ron Int
1
Maybe String
dispName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
dispLinkageName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dispFile <- Int -> Parse (Maybe PValMd)
ron Int
4
Word32
dispLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
5 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dispType <- Int -> Parse (Maybe PValMd)
ron Int
6
Word32
dispScopeLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetA) Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dispContainingType <- Int -> Parse (Maybe PValMd)
ron (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetA)
Word32
dispVirtualIndex <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetA) Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Int64
dispThisAdjustment <- if Bool
hasThisAdjustment
then Record -> LookupField Int64
forall a. Record -> LookupField a
parseField Record
r (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetB) Match Field Int64
forall a. (Num a, Bits a) => Match Field a
numeric
else Int64 -> Parse Int64
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
Maybe PValMd
dispUnit <- Bool -> Int -> Parse (Maybe PValMd)
optFwdRef Bool
hasUnit (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetB)
Maybe PValMd
dispTemplateParams <- Int -> Parse (Maybe PValMd)
ron (Int
13 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetB)
Maybe PValMd
dispDeclaration <- Int -> Parse (Maybe PValMd)
ron (Int
14 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetB)
Maybe PValMd
dispRetainedNodes <- Int -> Parse (Maybe PValMd)
ron (Int
15 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetB)
Maybe PValMd
dispThrownTypes <- Bool -> Int -> Parse (Maybe PValMd)
optFwdRef Bool
hasThrownTypes (Int
17 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetB)
Maybe PValMd
dispAnnotations <- Bool -> Int -> Parse (Maybe PValMd)
optFwdRef Bool
hasAnnotations (Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offsetB)
let disp :: DISubprogram' Int
disp = DISubprogram {Bool
Int64
Maybe String
Maybe PValMd
DIEmissionKind
Word32
dispFlags :: Word32
dispIsLocal :: Bool
dispIsDefinition :: Bool
dispIsOptimized :: Bool
dispVirtuality :: DIEmissionKind
dispScope :: Maybe PValMd
dispName :: Maybe String
dispLinkageName :: Maybe String
dispFile :: Maybe PValMd
dispLine :: Word32
dispType :: Maybe PValMd
dispScopeLine :: Word32
dispContainingType :: Maybe PValMd
dispVirtualIndex :: Word32
dispThisAdjustment :: Int64
dispUnit :: Maybe PValMd
dispTemplateParams :: Maybe PValMd
dispDeclaration :: Maybe PValMd
dispRetainedNodes :: Maybe PValMd
dispThrownTypes :: Maybe PValMd
dispAnnotations :: Maybe PValMd
dispScope :: Maybe PValMd
dispName :: Maybe String
dispLinkageName :: Maybe String
dispFile :: Maybe PValMd
dispLine :: Word32
dispType :: Maybe PValMd
dispIsLocal :: Bool
dispIsDefinition :: Bool
dispScopeLine :: Word32
dispContainingType :: Maybe PValMd
dispVirtuality :: DIEmissionKind
dispVirtualIndex :: Word32
dispThisAdjustment :: Int64
dispFlags :: Word32
dispIsOptimized :: Bool
dispUnit :: Maybe PValMd
dispTemplateParams :: Maybe PValMd
dispDeclaration :: Maybe PValMd
dispRetainedNodes :: Maybe PValMd
dispThrownTypes :: Maybe PValMd
dispAnnotations :: Maybe PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DISubprogram' Int -> DebugInfo' Int
forall lab. DISubprogram' lab -> DebugInfo' lab
DebugInfoSubprogram DISubprogram' Int
disp)) PartialMetadata
pm
Int
22 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_LEXICAL_BLOCK" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
5]
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
Maybe PValMd
dilbScope <- Int -> Parse (Maybe PValMd)
ron Int
1
Maybe PValMd
dilbFile <- Int -> Parse (Maybe PValMd)
ron Int
2
Word32
dilbLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
3 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
DwarfTag
dilbColumn <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
let dilb :: DILexicalBlock' Int
dilb = DILexicalBlock {Maybe PValMd
DwarfTag
Word32
dilbScope :: Maybe PValMd
dilbFile :: Maybe PValMd
dilbLine :: Word32
dilbColumn :: DwarfTag
dilbScope :: Maybe PValMd
dilbFile :: Maybe PValMd
dilbLine :: Word32
dilbColumn :: DwarfTag
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DILexicalBlock' Int -> DebugInfo' Int
forall lab. DILexicalBlock' lab -> DebugInfo' lab
DebugInfoLexicalBlock DILexicalBlock' Int
dilb)) PartialMetadata
pm
Int
23 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_LEXICAL_BLOCK_FILE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
4]
[String]
cxt <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
PValMd
dilbfScope <- [String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt (Int -> PValMd) -> Parse Int -> Parse PValMd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dilbfFile <- Int -> Parse (Maybe PValMd)
ron Int
2
Word32
dilbfDiscriminator <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
3 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let dilbf :: DILexicalBlockFile' Int
dilbf = DILexicalBlockFile {Maybe PValMd
Word32
PValMd
dilbfScope :: PValMd
dilbfFile :: Maybe PValMd
dilbfDiscriminator :: Word32
dilbfScope :: PValMd
dilbfFile :: Maybe PValMd
dilbfDiscriminator :: Word32
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DILexicalBlockFile' Int -> DebugInfo' Int
forall lab. DILexicalBlockFile' lab -> DebugInfo' lab
DebugInfoLexicalBlockFile DILexicalBlockFile' Int
dilbf)) PartialMetadata
pm
Int
24 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_NAMESPACE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
3, Int
5]
let isNew :: Bool
isNew =
case [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) of
Int
3 -> Bool
True
Int
5 -> Bool
False
Int
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"Impossible (METADATA_NAMESPACE)"
let nameIdx :: Int
nameIdx = if Bool
isNew then Int
2 else Int
3
[String]
cxt <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
Maybe String
dinsName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
cxt PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
nameIdx Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
PValMd
dinsScope <- [String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt (Int -> PValMd) -> Parse Int -> Parse PValMd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
PValMd
dinsFile <- if Bool
isNew
then PValMd -> Parse PValMd
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PValMd
forall lab. String -> ValMd' lab
ValMdString String
"")
else [String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt (Int -> PValMd) -> Parse Int -> Parse PValMd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
dinsLine <- if Bool
isNew then Word32 -> Parse Word32
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0 else Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let dins :: DINameSpace' Int
dins = DINameSpace {Maybe String
Word32
PValMd
dinsName :: Maybe String
dinsScope :: PValMd
dinsFile :: PValMd
dinsLine :: Word32
dinsName :: Maybe String
dinsScope :: PValMd
dinsFile :: PValMd
dinsLine :: Word32
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DINameSpace' Int -> DebugInfo' Int
forall lab. DINameSpace' lab -> DebugInfo' lab
DebugInfoNameSpace DINameSpace' Int
dins)) PartialMetadata
pm
Int
25 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_TEMPLATE_TYPE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
3, Int
4]
let recordLength :: Int
recordLength = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
let hasIsDefault :: Bool
hasIsDefault | Int
recordLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = Bool
False
| Int
recordLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Bool
True
| Bool
otherwise = String -> Bool
forall a. HasCallStack => String -> a
error String
"Impossible (METADATA_TEMPLATE_TYPE)"
[String]
cxt <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
Maybe String
dittpName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
cxt PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dittpType <- Int -> Parse (Maybe PValMd)
ron Int
2
Maybe Bool
dittpIsDefault <- if Bool
hasIsDefault
then Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Parse Bool -> Parse (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
3 Match Field Bool
boolean
else Maybe Bool -> Parse (Maybe Bool)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
let dittp :: DITemplateTypeParameter' Int
dittp = DITemplateTypeParameter {Maybe Bool
Maybe String
Maybe PValMd
dittpName :: Maybe String
dittpType :: Maybe PValMd
dittpIsDefault :: Maybe Bool
dittpName :: Maybe String
dittpType :: Maybe PValMd
dittpIsDefault :: Maybe Bool
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DITemplateTypeParameter' Int -> DebugInfo' Int
forall lab. DITemplateTypeParameter' lab -> DebugInfo' lab
DebugInfoTemplateTypeParameter DITemplateTypeParameter' Int
dittp)) PartialMetadata
pm
Int
26 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_TEMPLATE_VALUE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
5, Int
6]
let recordLength :: Int
recordLength = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
let hasIsDefault :: Bool
hasIsDefault | Int
recordLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = Bool
False
| Int
recordLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = Bool
True
| Bool
otherwise = String -> Bool
forall a. HasCallStack => String -> a
error String
"Impossible (METADATA_TEMPLATE_TYPE)"
[String]
cxt <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
DwarfTag
ditvpTag <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
ditvpName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
cxt PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
ditvpType <- Int -> Parse (Maybe PValMd)
ron Int
3
Maybe Bool
ditvpIsDefault <- if Bool
hasIsDefault
then Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Parse Bool -> Parse (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Bool
boolean
else Maybe Bool -> Parse (Maybe Bool)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
PValMd
ditvpValue <- [String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt (Int -> PValMd) -> Parse Int -> Parse PValMd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r (if Bool
hasIsDefault then Int
5 else Int
4) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let ditvp :: DITemplateValueParameter' Int
ditvp = DITemplateValueParameter {Maybe Bool
Maybe String
Maybe PValMd
DwarfTag
PValMd
ditvpTag :: DwarfTag
ditvpName :: Maybe String
ditvpType :: Maybe PValMd
ditvpIsDefault :: Maybe Bool
ditvpValue :: PValMd
ditvpTag :: DwarfTag
ditvpName :: Maybe String
ditvpType :: Maybe PValMd
ditvpIsDefault :: Maybe Bool
ditvpValue :: PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DITemplateValueParameter' Int -> DebugInfo' Int
forall lab. DITemplateValueParameter' lab -> DebugInfo' lab
DebugInfoTemplateValueParameter DITemplateValueParameter' Int
ditvp)) PartialMetadata
pm
Int
27 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_GLOBAL_VAR" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
11 Int
13
[String]
ctx <- Parse [String]
getContext
Int
field0 <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let isDistinct :: Bool
isDistinct = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
field0 Int
0
_version :: Int
_version = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
field0 Int
1 :: Int
Maybe PValMd
digvScope <- Int -> Parse (Maybe PValMd)
ron Int
1
Maybe String
digvName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
digvLinkageName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
ctx PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
3 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
digvFile <- Int -> Parse (Maybe PValMd)
ron Int
4
Word32
digvLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
5 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
digvType <- Int -> Parse (Maybe PValMd)
ron Int
6
Bool
digvIsLocal <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
7 Match Field Bool
nonzero
Bool
digvIsDefinition <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
8 Match Field Bool
nonzero
Maybe PValMd
digvVariable <- Int -> Parse (Maybe PValMd)
ron Int
9
Maybe PValMd
digvDeclaration <- Int -> Parse (Maybe PValMd)
ron Int
10
Maybe Word32
digvAlignment <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11
then Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Parse Word32 -> Parse (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
11 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
else Maybe Word32 -> Parse (Maybe Word32)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
forall a. Maybe a
Nothing
Maybe PValMd
digvAnnotations <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12
then Int -> Parse (Maybe PValMd)
ron Int
12
else Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
let digv :: DIGlobalVariable' Int
digv = DIGlobalVariable {Bool
Maybe String
Maybe Word32
Maybe PValMd
Word32
digvScope :: Maybe PValMd
digvName :: Maybe String
digvLinkageName :: Maybe String
digvFile :: Maybe PValMd
digvLine :: Word32
digvType :: Maybe PValMd
digvIsLocal :: Bool
digvIsDefinition :: Bool
digvVariable :: Maybe PValMd
digvDeclaration :: Maybe PValMd
digvAlignment :: Maybe Word32
digvAnnotations :: Maybe PValMd
digvScope :: Maybe PValMd
digvName :: Maybe String
digvLinkageName :: Maybe String
digvFile :: Maybe PValMd
digvLine :: Word32
digvType :: Maybe PValMd
digvIsLocal :: Bool
digvIsDefinition :: Bool
digvVariable :: Maybe PValMd
digvDeclaration :: Maybe PValMd
digvAlignment :: Maybe Word32
digvAnnotations :: Maybe PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DIGlobalVariable' Int -> DebugInfo' Int
forall lab. DIGlobalVariable' lab -> DebugInfo' lab
DebugInfoGlobalVariable DIGlobalVariable' Int
digv)) PartialMetadata
pm
Int
28 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_LOCAL_VAR" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
8 Int
10
[String]
ctx <- Parse [String]
getContext
Word32
field0 <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let isDistinct :: Bool
isDistinct = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Word32
field0 :: Word32) Int
0
hasAlignment :: Bool
hasAlignment = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Word32
field0 :: Word32) Int
1
hasTag :: Int
hasTag | Bool -> Bool
not Bool
hasAlignment Bool -> Bool -> Bool
&& [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8 = Int
1
| Bool
otherwise = Int
0
adj :: Int -> Int
adj Int
i = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hasTag
Maybe PValMd
dilvScope <- [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull (String
"dilvScope"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ctx) MetadataTable
mt
(Int -> Maybe PValMd) -> Parse Int -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r (Int -> Int
adj Int
1) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
dilvName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull (String
"dilvName" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ctx) PartialMetadata
pm
(Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r (Int -> Int
adj Int
2) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dilvFile <- [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull (String
"dilvFile" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ctx) MetadataTable
mt
(Int -> Maybe PValMd) -> Parse Int -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r (Int -> Int
adj Int
3) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
dilvLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int -> Int
adj Int
4) Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dilvType <- [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull (String
"dilvType" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ctx) MetadataTable
mt
(Int -> Maybe PValMd) -> Parse Int -> Parse (Maybe PValMd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r (Int -> Int
adj Int
5) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
DwarfTag
dilvArg <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r (Int -> Int
adj Int
6) Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Word32
dilvFlags <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r (Int -> Int
adj Int
7) Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe Word32
dilvAlignment <-
if Bool
hasAlignment
then do Word64
n <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
8 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Word64
n :: Word64) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32))
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Alignment value is too large")
Maybe Word32 -> Parse (Maybe Word32)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> Parse (Maybe Word32))
-> Maybe Word32 -> Parse (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n :: Word32)
else Maybe Word32 -> Parse (Maybe Word32)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
Maybe PValMd
dilvAnnotations <- if Bool
hasAlignment Bool -> Bool -> Bool
&& [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9
then Int -> Parse (Maybe PValMd)
ron Int
9
else Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
let dilv :: DILocalVariable' Int
dilv = DILocalVariable {Maybe String
Maybe Word32
Maybe PValMd
DwarfTag
Word32
dilvScope :: Maybe PValMd
dilvName :: Maybe String
dilvFile :: Maybe PValMd
dilvLine :: Word32
dilvType :: Maybe PValMd
dilvArg :: DwarfTag
dilvFlags :: Word32
dilvAlignment :: Maybe Word32
dilvAnnotations :: Maybe PValMd
dilvScope :: Maybe PValMd
dilvName :: Maybe String
dilvFile :: Maybe PValMd
dilvLine :: Word32
dilvType :: Maybe PValMd
dilvArg :: DwarfTag
dilvFlags :: Word32
dilvAlignment :: Maybe Word32
dilvAnnotations :: Maybe PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DILocalVariable' Int -> DebugInfo' Int
forall lab. DILocalVariable' lab -> DebugInfo' lab
DebugInfoLocalVariable DILocalVariable' Int
dilv)) PartialMetadata
pm
Int
29 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_EXPRESSION" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
DebugInfo' Int
diExpr <- DIExpression -> DebugInfo' Int
forall lab. DIExpression -> DebugInfo' lab
DebugInfoExpression (DIExpression -> DebugInfo' Int)
-> ([Word64] -> DIExpression) -> [Word64] -> DebugInfo' Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> DIExpression
DIExpression ([Word64] -> DebugInfo' Int)
-> Parse [Word64] -> Parse (DebugInfo' Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> Int -> Match Field Word64 -> Parse [Word64]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
1 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable (DebugInfo' Int -> MetadataTable -> MetadataTable
addInlineDebugInfo DebugInfo' Int
diExpr) PartialMetadata
pm
Int
30 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_OBJC_PROPERTY" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not yet implemented"
Int
31 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_IMPORTED_ENTITY" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
6, Int
7]
[String]
cxt <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
DwarfTag
diieTag <- Record -> LookupField DwarfTag
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field DwarfTag
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
diieScope <- Int -> Parse (Maybe PValMd)
ron Int
2
Maybe PValMd
diieEntity <- Int -> Parse (Maybe PValMd)
ron Int
3
Maybe PValMd
diieFile <- if [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
7
then Int -> Parse (Maybe PValMd)
ron Int
6
else Maybe PValMd -> Parse (Maybe PValMd)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PValMd
forall a. Maybe a
Nothing
Word32
diieLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe String
diieName <- HasCallStack => [String] -> PartialMetadata -> Int -> Maybe String
[String] -> PartialMetadata -> Int -> Maybe String
mdStringOrNull [String]
cxt PartialMetadata
pm (Int -> Maybe String) -> Parse Int -> Parse (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
5 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
let diie :: DIImportedEntity' Int
diie = DIImportedEntity {Maybe String
Maybe PValMd
DwarfTag
Word32
diieTag :: DwarfTag
diieScope :: Maybe PValMd
diieEntity :: Maybe PValMd
diieFile :: Maybe PValMd
diieLine :: Word32
diieName :: Maybe String
diieTag :: DwarfTag
diieScope :: Maybe PValMd
diieEntity :: Maybe PValMd
diieFile :: Maybe PValMd
diieLine :: Word32
diieName :: Maybe String
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DIImportedEntity' Int -> DebugInfo' Int
forall lab. DIImportedEntity' lab -> DebugInfo' lab
DebugInfoImportedEntity DIImportedEntity' Int
diie)) PartialMetadata
pm
Int
32 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_MODULE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not yet implemented"
Int
33 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_MACRO" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not yet implemented"
Int
34 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_MACRO_FILE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not yet implemented"
Int
35 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_STRINGS" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
3]
Int
count <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
offset <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
ByteString
bs <- Record -> LookupField ByteString
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field ByteString
fieldBlob
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid record: metadata strings with no strings")
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
S.length ByteString
bs)
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid record: metadata strings corrupt offset")
let (ByteString
bsLengths, ByteString
bsStrings) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
offset ByteString
bs
[Int]
lengths <- (String -> Parse [Int])
-> ([Int] -> Parse [Int]) -> Either String [Int] -> Parse [Int]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parse [Int]
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail [Int] -> Parse [Int]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [Int] -> Parse [Int])
-> Either String [Int] -> Parse [Int]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Either String [Int]
parseMetadataStringLengths Int
count ByteString
bsLengths
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
lengths Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
S.length ByteString
bsStrings)
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid record: metadata strings truncated")
let strings :: [String]
strings = (ByteString, [String]) -> [String]
forall a b. (a, b) -> b
snd ((ByteString -> Int -> (ByteString, String))
-> ByteString -> [Int] -> (ByteString, [String])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL ByteString -> Int -> (ByteString, String)
f ByteString
bsStrings [Int]
lengths)
where f :: ByteString -> Int -> (ByteString, String)
f ByteString
s Int
i = case Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
i ByteString
s of
(ByteString
str, ByteString
rest) -> (ByteString
rest, ByteString -> String
Char8.unpack ByteString
str)
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! [String] -> PartialMetadata -> PartialMetadata
addStrings [String]
strings PartialMetadata
pm
Int
36 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_GLOBAL_DECL_ATTACHMENT" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Bool -> Parse () -> Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)) Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
(String -> Parse ()
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid record")
Int
valueId <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Symbol
sym <- case Int -> MdTable -> Maybe (Typed PValue)
lookupValueTableAbs Int
valueId MdTable
vt of
Just (Typed { typedValue :: forall a. Typed a -> a
typedValue = ValSymbol Symbol
sym }) -> Symbol -> Parse Symbol
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
sym
Maybe (Typed PValue)
_ -> String -> Parse Symbol
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Non-global referenced"
Map String PValMd
refs <- MetadataTable -> Record -> Parse (Map String PValMd)
parseGlobalObjectAttachment MetadataTable
mt Record
r
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! Symbol -> Map String PValMd -> PartialMetadata -> PartialMetadata
addGlobalAttachments Symbol
sym Map String PValMd
refs PartialMetadata
pm
Int
37 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_GLOBAL_VAR_EXPR" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
3]
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
Maybe PValMd
digveVariable <- Int -> Parse (Maybe PValMd)
ron Int
1
Maybe PValMd
digveExpression <- Int -> Parse (Maybe PValMd)
ron Int
2
let digve :: DIGlobalVariableExpression' Int
digve = DIGlobalVariableExpression {Maybe PValMd
digveVariable :: Maybe PValMd
digveExpression :: Maybe PValMd
digveVariable :: Maybe PValMd
digveExpression :: Maybe PValMd
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DIGlobalVariableExpression' Int -> DebugInfo' Int
forall lab. DIGlobalVariableExpression' lab -> DebugInfo' lab
DebugInfoGlobalVariableExpression DIGlobalVariableExpression' Int
digve)) PartialMetadata
pm
Int
38 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_INDEX_OFFSET" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
2]
Word64
a <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
Word64
b <- Record -> LookupField Word64
forall a. Record -> LookupField a
parseField Record
r Int
1 Match Field Word64
forall a. (Num a, Bits a) => Match Field a
numeric
let _offset :: Word64
_offset = Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
b Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) :: Word64
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialMetadata
pm
Int
39 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_INDEX" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialMetadata
pm
Int
40 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_LABEL" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[Int] -> Parse ()
forall {f :: * -> *} {t :: * -> *}.
(Foldable t, MonadFail f, Show (t Int)) =>
t Int -> f ()
assertRecordSizeIn [Int
5]
[String]
cxt <- Parse [String]
getContext
Bool
isDistinct <- Record -> LookupField Bool
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Bool
nonzero
Maybe PValMd
dilScope <- Int -> Parse (Maybe PValMd)
ron Int
1
String
dilName <- HasCallStack => [String] -> PartialMetadata -> Int -> String
[String] -> PartialMetadata -> Int -> String
mdString [String]
cxt PartialMetadata
pm (Int -> String) -> Parse Int -> Parse String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
2 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Maybe PValMd
dilFile <- Int -> Parse (Maybe PValMd)
ron Int
3
Word32
dilLine <- Record -> LookupField Word32
forall a. Record -> LookupField a
parseField Record
r Int
4 Match Field Word32
forall a. (Num a, Bits a) => Match Field a
numeric
let dil :: DILabel' Int
dil = DILabel {String
Maybe PValMd
Word32
dilScope :: Maybe PValMd
dilName :: String
dilFile :: Maybe PValMd
dilLine :: Word32
dilScope :: Maybe PValMd
dilName :: String
dilFile :: Maybe PValMd
dilLine :: Word32
..}
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(Bool -> DebugInfo' Int -> MetadataTable -> MetadataTable
addDebugInfo Bool
isDistinct (DILabel' Int -> DebugInfo' Int
forall lab. DILabel' lab -> DebugInfo' lab
DebugInfoLabel DILabel' Int
dil)) PartialMetadata
pm
Int
41 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_STRING_TYPE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Parse PartialMetadata
forall a. Parse a
notImplemented
Int
44 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_COMMON_BLOCK" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Parse PartialMetadata
forall a. Parse a
notImplemented
Int
45 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_GENERIC_SUBRANGE" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
Parse PartialMetadata
forall a. Parse a
notImplemented
Int
46 -> String -> Parse PartialMetadata -> Parse PartialMetadata
forall a. String -> Parse a -> Parse a
label String
"METADATA_ARG_LIST" (Parse PartialMetadata -> Parse PartialMetadata)
-> Parse PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$ do
[String]
cxt <- Parse [String]
getContext
DIArgList' Int
dial <- [PValMd] -> DIArgList' Int
forall lab. [ValMd' lab] -> DIArgList' lab
DIArgList
([PValMd] -> DIArgList' Int)
-> Parse [PValMd] -> Parse (DIArgList' Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int -> PValMd) -> [Int] -> [PValMd]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt) ([Int] -> [PValMd]) -> Parse [Int] -> Parse [PValMd]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Record -> Int -> Match Field Int -> Parse [Int]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric)
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable
(DebugInfo' Int -> MetadataTable -> MetadataTable
addInlineDebugInfo (DIArgList' Int -> DebugInfo' Int
forall lab. DIArgList' lab -> DebugInfo' lab
DebugInfoArgList DIArgList' Int
dial)) PartialMetadata
pm
Int
code -> String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unknown record code: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code)
parseMetadataEntry MdTable
_ MetadataTable
_ PartialMetadata
pm (Match Entry DefineAbbrev
abbrevDef -> Just DefineAbbrev
_) =
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialMetadata
pm
parseMetadataEntry MdTable
_ MetadataTable
_ PartialMetadata
_ Entry
r =
String -> Parse PartialMetadata
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unexpected metadata entry: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Entry -> String
forall a. Show a => a -> String
show Entry
r)
parseAttachment :: Record -> Int -> Parse [(PKindMd,PValMd)]
parseAttachment :: Record -> Int -> Parse [(Int, PValMd)]
parseAttachment Record
r Int
l = Int -> [(Int, PValMd)] -> Parse [(Int, PValMd)]
forall {a}.
(Num a, Bits a) =>
Int -> [(a, PValMd)] -> Parse [(a, PValMd)]
loop ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) []
where
loop :: Int -> [(a, PValMd)] -> Parse [(a, PValMd)]
loop Int
n [(a, PValMd)]
acc | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l = [(a, PValMd)] -> Parse [(a, PValMd)]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return [(a, PValMd)]
acc
| Bool
otherwise = do
a
kind <- Record -> LookupField a
forall a. Record -> LookupField a
parseField Record
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Match Field a
forall a. (Num a, Bits a) => Match Field a
numeric
Typed PValMd
md <- Int -> Parse (Typed PValMd)
getMetadata (Int -> Parse (Typed PValMd)) -> Parse Int -> Parse (Typed PValMd)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
n Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int -> [(a, PValMd)] -> Parse [(a, PValMd)]
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) ((a
kind,Typed PValMd -> PValMd
forall a. Typed a -> a
typedValue Typed PValMd
md) (a, PValMd) -> [(a, PValMd)] -> [(a, PValMd)]
forall a. a -> [a] -> [a]
: [(a, PValMd)]
acc)
parseGlobalObjectAttachment :: MetadataTable -> Record -> Parse (Map.Map KindMd PValMd)
parseGlobalObjectAttachment :: MetadataTable -> Record -> Parse (Map String PValMd)
parseGlobalObjectAttachment MetadataTable
mt Record
r = String -> Parse (Map String PValMd) -> Parse (Map String PValMd)
forall a. String -> Parse a -> Parse a
label String
"parseGlobalObjectAttachment" (Parse (Map String PValMd) -> Parse (Map String PValMd))
-> Parse (Map String PValMd) -> Parse (Map String PValMd)
forall a b. (a -> b) -> a -> b
$
do [String]
cxt <- Parse [String]
getContext
[String] -> Map String PValMd -> Int -> Parse (Map String PValMd)
go [String]
cxt Map String PValMd
forall k a. Map k a
Map.empty Int
1
where
len :: Int
len = [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Record -> [Field]
recordFields Record
r)
go :: [String] -> Map String PValMd -> Int -> Parse (Map String PValMd)
go [String]
cxt Map String PValMd
acc Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len =
do String
kind <- Int -> Parse String
getKind (Int -> Parse String) -> Parse Int -> Parse String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
n Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
Int
i <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[String] -> Map String PValMd -> Int -> Parse (Map String PValMd)
go [String]
cxt (String -> PValMd -> Map String PValMd -> Map String PValMd
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
kind ([String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt Int
i) Map String PValMd
acc) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
go [String]
_ Map String PValMd
acc Int
_ =
Map String PValMd -> Parse (Map String PValMd)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return Map String PValMd
acc
parseMetadataNode :: Bool -> MetadataTable -> Record -> PartialMetadata
-> Parse PartialMetadata
parseMetadataNode :: Bool
-> MetadataTable
-> Record
-> PartialMetadata
-> Parse PartialMetadata
parseMetadataNode Bool
isDistinct MetadataTable
mt Record
r PartialMetadata
pm = do
[Int]
ixs <- Record -> Int -> Match Field Int -> Parse [Int]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[String]
cxt <- Parse [String]
getContext
let lkp :: Int -> Maybe PValMd
lkp = [String] -> MetadataTable -> Int -> Maybe PValMd
mdForwardRefOrNull [String]
cxt MetadataTable
mt
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable (Bool -> [Maybe PValMd] -> MetadataTable -> MetadataTable
addNode Bool
isDistinct ((Int -> Maybe PValMd) -> [Int] -> [Maybe PValMd]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Maybe PValMd
lkp [Int]
ixs)) PartialMetadata
pm
parseMetadataOldNode :: Bool -> ValueTable -> MetadataTable -> Record
-> PartialMetadata -> Parse PartialMetadata
parseMetadataOldNode :: Bool
-> MdTable
-> MetadataTable
-> Record
-> PartialMetadata
-> Parse PartialMetadata
parseMetadataOldNode Bool
fnLocal MdTable
vt MetadataTable
mt Record
r PartialMetadata
pm = do
[Typed PValue]
values <- [Int] -> Parse [Typed PValue]
loop ([Int] -> Parse [Typed PValue])
-> Parse [Int] -> Parse [Typed PValue]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Record -> Int -> Match Field Int -> Parse [Int]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialMetadata -> Parse PartialMetadata)
-> PartialMetadata -> Parse PartialMetadata
forall a b. (a -> b) -> a -> b
$! (MetadataTable -> MetadataTable)
-> PartialMetadata -> PartialMetadata
updateMetadataTable (Bool -> [Typed PValue] -> MetadataTable -> MetadataTable
addOldNode Bool
fnLocal [Typed PValue]
values) PartialMetadata
pm
where
loop :: [Int] -> Parse [Typed PValue]
loop [Int]
fs = case [Int]
fs of
Int
tyId:Int
valId:[Int]
rest -> do
[String]
cxt <- Parse [String]
getContext
Type
ty <- Int -> Parse Type
getType' Int
tyId
Typed PValue
val <- case Type
ty of
PrimType PrimType
Metadata -> Typed PValue -> Parse (Typed PValue)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue -> Parse (Typed PValue))
-> Typed PValue -> Parse (Typed PValue)
forall a b. (a -> b) -> a -> b
$ Type -> PValue -> Typed PValue
forall a. Type -> a -> Typed a
Typed (PrimType -> Type
forall ident. PrimType -> Type' ident
PrimType PrimType
Metadata)
(PValMd -> PValue
forall lab. ValMd' lab -> Value' lab
ValMd ([String] -> MetadataTable -> Int -> PValMd
mdForwardRef [String]
cxt MetadataTable
mt Int
valId))
Type
_ -> Typed PValue -> Parse (Typed PValue)
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (HasCallStack => [String] -> Int -> MdTable -> Typed PValue
[String] -> Int -> MdTable -> Typed PValue
forwardRef [String]
cxt Int
valId MdTable
vt)
[Typed PValue]
vals <- [Int] -> Parse [Typed PValue]
loop [Int]
rest
[Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed PValue
valTyped PValue -> [Typed PValue] -> [Typed PValue]
forall a. a -> [a] -> [a]
:[Typed PValue]
vals)
[] -> [Typed PValue] -> Parse [Typed PValue]
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Int]
_ -> String -> Parse [Typed PValue]
forall a. String -> Parse a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Malformed metadata node"
parseMetadataKindEntry :: Record -> Parse ()
parseMetadataKindEntry :: Record -> Parse ()
parseMetadataKindEntry Record
r = do
Int
kind <- Record -> LookupField Int
forall a. Record -> LookupField a
parseField Record
r Int
0 Match Field Int
forall a. (Num a, Bits a) => Match Field a
numeric
[DIEmissionKind]
name <- Record
-> Int -> Match Field DIEmissionKind -> Parse [DIEmissionKind]
forall a. Record -> Int -> Match Field a -> Parse [a]
parseFields Record
r Int
1 Match Field DIEmissionKind
char
Int -> String -> Parse ()
addKind Int
kind ([DIEmissionKind] -> String
UTF8.decode [DIEmissionKind]
name)