{-# 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)



-- Parsing State ---------------------------------------------------------------

data MetadataTable = MetadataTable
  { MetadataTable -> MdTable
mtEntries   :: MdTable
  , MetadataTable -> Int
mtNextNode  :: !Int
  , MetadataTable -> IntMap (Bool, Bool, Int)
mtNodes     :: IntMap.IntMap (Bool, Bool, Int)
                   -- ^ The entries in the map are: is the entry function local,
                   -- is the entry distinct, and the implicit id for the node.
  } 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 {- ^ globals seen so far -} ->
  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
  -- explicitly make a metadata value out of a normal value
  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

-- | A variant of 'addDebugInfo' that only inserts the 'DebugInfo' into the
-- 'mtEntries', not the 'mtNodes'. This has the effect of causing the
-- 'DebugInfo' /not/ to be added to any top-level metadata lists and instead
-- causing it to be printed inline wherever it occurs.
-- See @Note [Printing metadata inline]@.
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)
             }

-- | Add a new node, that might be distinct.
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)

-- | This preferentially fetches the string from the strict string table
-- (@pmStrings@), but will return a forward reference when it can't find it there.
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
  -- ^ Forward references to metadata strings are never actually
  -- forward references, string blocks (@METADATA_STRINGS@) always come first.
  -- So references to them don't need to be inside the @MonadFix@ like
  -- references into other 'pmEntries', allowing them to be strict.
  --
  -- See this comment:
  -- - https://github.com/llvm-mirror/llvm/blob/release_40/lib/Bitcode/Reader/MetadataLoader.cpp#L913
  -- - https://github.com/llvm-mirror/llvm/blob/release_60/lib/Bitcode/Reader/MetadataLoader.cpp#L1017
  } 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 {- ^ globals seen so far -} ->
  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 {- ^ name of the global to attach to ^ -} ->
  (Map.Map KindMd PValMd) {- ^ metadata references to attach ^ -} ->
  (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 =
  -- left-biased union, since the parser overwrites metadata as it encounters it
  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"

-- De-duplicating ---------------------------------------------------------------

-- | This function generically traverses the given unnamed metadata values.
-- When it encounters one with a 'PValMd' inside of it, it looks up that
-- value in the list. If found, it replaces the value with a reference to it.
--
-- Such de-duplication is necessary because the @fallback@ of
-- 'mdForwardRefOrNull' is often called when it is in fact unnecessary, just
-- because the appropriate references aren't available yet.
--
-- This function is concise at the cost of efficiency: In the worst case, every
-- metadata node contains a reference to every other metadata node, and the
-- cost is O(n^2*log(n)) where
-- * n^2 comes from looking at every 'PValMd' inside every 'PartialUnnamedMd'
-- * log(n) is the cost of looking them up in a 'Map'.
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 -- don't self-reference
          in PartialUnnamedMd
pum { pumValues = maybeTransform pumdMap' (pumValues pum) }

        -- | We avoid erroneously recursing into ValMdValues and exit early on
        -- a few other constructors de-duplication wouldn't affect.
        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

-- Finalizing ---------------------------------------------------------------

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)

-- | Partition unnamed entries into global and function local unnamed entries.
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

  -- TODO: is this silently eating errors with metadata that's not in the
  -- value table (when the lookupValueTableAbs fails)?
  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
  )

-- Metadata Parsing ------------------------------------------------------------

parseMetadataBlock ::
  Int {- ^ globals seen so far -} ->
  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)

-- | Parse an entry in the metadata block.
--
-- XXX this currently relies on the constant block having been parsed already.
-- Though most bitcode examples I've seen are ordered this way, it would be nice
-- to not have to rely on it.
--
-- Based on the function 'parseOneMetadata' in the LLVM source.
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

      -- Helper for a common pattern which appears below in the parsing
      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

  -- Note: the parsing cases below use a Monadic coding style, as opposed to an
  -- Applicative style (as was originally used) for performance reasons:
  -- Applicative record construction has quadratic size and corresponding
  -- performance impacts (the initial conversion from Applicative to Monadic
  -- saved 11s when parsing a 22MB bitcode file).
  --
  -- Additionally, this module uses RecordWildcards... a pragma that is not
  -- normally advisable but which does work to good effect in this situation to
  -- simplify the following and remove boilerplate intermediary assignments.

  in case Record -> Int
recordCode Record
r of
    -- [values]
    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

    -- [type num, value num]
    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


    -- [n x md num]
    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)

    -- [values]
    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

    -- [n x md num]
    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)

    -- [n x [id, name]]
    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

    -- [distinct, line, col, scope, inlined-at?]
    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
      -- TODO: broken in 3.7+; needs to be a DILocation rather than an
      -- MDLocation, but there appears to be no difference in the
      -- bitcode. /sigh/
      [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


    -- [n x (type num, value num)]
    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)

    -- [n x (type num, value num)]
    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)

    -- [n x mdnodes]
    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

    -- [m x [value, [n x [id, mdnode]]]
    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
      --isDistinct <- parseField r 0 numeric
      --tag <- parseField r 1 numeric
      --version <- parseField r 2 numeric
      --header <- parseField r 3 string
      -- TODO: parse all remaining fields
      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
      -- The format field determines what set of fields are contained in this
      -- record and what their types are (see
      -- https://github.com/llvm/llvm-project/blob/bbe8cd13/llvm/lib/Bitcode/Reader/MetadataLoader.cpp#L1437-L1444).
      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

    -- [isBigInt|isUnsigned|distinct, value, name]
    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
          -- LLVM 12 or later
          then Record -> Int -> Parse Integer
parseWideInteger Record
r Int
3
          -- Pre-LLVM 12
          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

    -- [distinct, filename, directory]
    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
      -- While upstream LLVM currently imposes a maximum of 14 records per
      -- entry, we raise this to 15 for the sake of parsing Apple LLVM.
      -- See Note [Apple LLVM].
      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  -- field not present
        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
                -- dwarf address space is encoded in bitcode as +1; a value of
                -- zero means there is no dwarf address space present:
                -- https://github.com/llvm/llvm-project/blob/bbe8cd1/llvm/lib/Bitcode/Reader/MetadataLoader.cpp#L1544-L1548
                -- The AST representation is the actual address space, or Nothing
                -- if there is no address space (indistinguishable from "field
                -- not present" for LLVM 4 and earlier).
                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
      -- this one is a bit funky:
      -- https://github.com/llvm/llvm-project/blob/release/10.x/llvm/lib/Bitcode/Reader/MetadataLoader.cpp#L1486

      Int -> Int -> Parse ()
forall {f :: * -> *}. MonadFail f => Int -> Int -> f ()
assertRecordSizeBetween Int
18 Int
21

      -- A "version" is encoded in the high-order bits of the isDistinct field.
      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

          -- CF https://github.com/llvm/llvm-project/blob/release/10.x/llvm/include/llvm/IR/DebugInfoFlags.def
          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

      -- TODO, isMain isn't exposed via DISubprogram
      (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

          -- this doesn't seem to be used in our parser...
          --hasFn
          --  | not hasSPFlags && recordSize >= 19 = not hasUnit
          --  | otherwise = False

          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

      -- Some additional sanity checking
      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

      -- Forward references that depend on the 'version'
      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
..}

      -- TODO: in the LLVM parser, it then goes into the metadata table
      -- and updates function entries to point to subprograms. Is that
      -- neccessary for us?
      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)" -- see assertion
      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)" -- see assertion
      [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)" -- see assertion
      [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
      -- this one is a bit funky:
      -- https://github.com/llvm-mirror/llvm/blob/release_38/lib/Bitcode/Reader/BitcodeReader.cpp#L2308
      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
      {-
      Although DIExpressions store an `isDistinct` field in LLVM bitcode, it is
      never used in practice. This is because DIExpressions are always printed
      inline in definitions, and since the `distinct` keyword is only printed in
      top-level metadata lists, there is no way for `distinct` to be printed
      before a DIExpression. See also Note [Printing metadata inline].
      -}
      -- isDistinct <- parseField r 0 nonzero
      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
      -- TODO
      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
      -- cxt <- getContext
      -- isDistinct <- parseField r 0 numeric
      -- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
      -- parseField r 2 string
      -- parseField r 3 string
      -- parseField r 4 string
      -- parseField r 5 string
      -- TODO
      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
      -- isDistinct <- parseField r 0 numeric
      -- parseField r 1 numeric
      -- parseField r 2 numeric
      -- parseField r 3 string
      -- parseField r 4 string
      -- TODO
      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
      -- cxt <- getContext
      -- isDistinct <- parseField r 0 numeric
      -- parseField r 1 numeric
      -- parseField r 2 numeric
      -- mdForwardRefOrNull cxt mt <$> parseField r 3 numeric
      -- mdForwardRefOrNull cxt mt <$> parseField r 4 numeric
      -- TODO
      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

    -- [ valueid, n x [id, mdnode] ]
    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

      -- the record will always be of odd length
      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

      -- TODO: is it OK to skip this if we always parse everything?
      PartialMetadata -> Parse PartialMetadata
forall a. a -> Parse a
forall (m :: * -> *) a. Monad m => a -> m a
return PartialMetadata
pm


    -- In the llvm source, this node is processed when the INDEX_OFFSET record is
    -- found.
    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
      -- TODO: is it OK to skip this if we always parse everything?
      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

    -- Codes 42 and 43 are reserved for Fortran array–specific debug info, see
    -- https://github.com/llvm/llvm-project/blob/4681f6111e655057f5015564a9bf3705f87495bf/llvm/include/llvm/Bitcode/LLVMBitCodes.h#L348-L349

    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)


-- | This is a named version of the metadata list that can show up at the end of
-- a global declaration. It will be of the form @!dbg !2 [!dbg !n, ...]@.
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


-- | Parse a metadata node.
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


-- | Parse out a metadata node in the old format.
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))
        -- XXX need to check for a void type here
        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)

{-
Note [Apple LLVM]
~~~~~~~~~~~~~~~~~
Apple maintains a fork of LLVM, whose source code can be found at
https://github.com/apple/llvm-project. The version of Clang that is shipped
with Xcode, and thereby the de facto default Clang version on macOS, is based
on this LLVM fork. To distinguish between the two LLVM codebases, we will refer
to "upstream LLVM" and "Apple LLVM" throughout this Note.

One of the more noticeable differences between upstream and Apple LLVM is that
Apple LLVM uses a slightly different bitcode format. In particular, Apple LLVM
has support for pointer authentication
(https://lists.llvm.org/pipermail/llvm-dev/2019-October/136091.html), which
requires adding an extra record to the METADATA_DERIVED_TYPE entry that is not
present in upstream LLVM. This impacts llvm-pretty-bc-parser, as we currently
check that the number of records does not exceed a certain maximum, but this
maximum is different depending on whether we parse upstream or Apple LLVM
bitcode.

For now, we work around this issue by raising the maximum number of
METADATA_DERIVED_TYPE records by one to accommodate Apple LLVM, but we do not
actually parse any information related to pointer authentication. This should
work provided that Apple LLVM continues to encode pointer authentication–related
metadata in the same part of METADATA_DERIVED_TYPE in future releases. If this
assumption does not hold true in the future, we will likely need a more
sophisticated solution that involves parsing the bitcode differently depending
on what Apple LLVM version was used to produce a bitcode file.

Note [Printing metadata inline]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There are some forms of metadata that we should always print inline and never
create entries for in top-level metadata lists (named or otherwise). Currently,
these forms of metadata are:

* DIExpression
* DIArgList

This list is taken from the LLVM source code here:
https://github.com/llvm/llvm-project/blob/65600cb2a7e940babf6c493503b9d3fd19f8cb06/llvm/lib/IR/AsmWriter.cpp#L1242-L1245

Implementation-wise, this is accomplished by using `addInlineDebugInfo`. Unlike
`addDebugInfo`, this inserts the metadata field into a separate `mtEntries` map
that is not used to populate top-level metadata lists when pretty-printing an
LLVM module.
-}