From 0d341a9122c8a0d7ee609599ffc5c381a3ef405a Mon Sep 17 00:00:00 2001
From: Aaron Tomb <atomb@galois.com>
Date: Fri, 27 Sep 2019 16:19:52 -0700
Subject: [PATCH] Actually parse METADATA_LABEL blocks

---
 src/Text/LLVM/AST.hs    |  9 +++++++++
 src/Text/LLVM/Labels.hs |  1 +
 src/Text/LLVM/PP.hs     | 12 ++++++++++++
 3 files changed, 22 insertions(+)

diff --git a/src/Text/LLVM/AST.hs b/src/Text/LLVM/AST.hs
index 5d99ed2..f885ec2 100644
--- a/src/Text/LLVM/AST.hs
+++ b/src/Text/LLVM/AST.hs
@@ -1100,10 +1100,19 @@ data DebugInfo' lab
   | DebugInfoTemplateTypeParameter (DITemplateTypeParameter' lab)
   | DebugInfoTemplateValueParameter (DITemplateValueParameter' lab)
   | DebugInfoImportedEntity (DIImportedEntity' lab)
+  | DebugInfoLabel (DILabel' lab)
     deriving (Data, Eq, Functor, Generic, Generic1, Ord, Show, Typeable)
 
 type DebugInfo = DebugInfo' BlockLabel
 
+type DILabel = DILabel' BlockLabel
+data DILabel' lab = DILabel
+    { dilScope :: Maybe (ValMd' lab)
+    , dilName  :: String
+    , dilFile  :: Maybe (ValMd' lab)
+    , dilLine  :: Word32
+    } deriving (Data, Eq, Functor, Generic, Generic1, Ord, Show, Typeable)
+
 type DIImportedEntity = DIImportedEntity' BlockLabel
 data DIImportedEntity' lab = DIImportedEntity
     { diieTag    :: DwarfTag
diff --git a/src/Text/LLVM/Labels.hs b/src/Text/LLVM/Labels.hs
index 2d3f49f..d49dad7 100644
--- a/src/Text/LLVM/Labels.hs
+++ b/src/Text/LLVM/Labels.hs
@@ -125,6 +125,7 @@ instance HasLabel Stmt'                       where relabel = $(generateRelabel
 instance HasLabel Clause'                     where relabel = $(generateRelabel 'relabel ''Clause')
 instance HasLabel Value'                      where relabel = $(generateRelabel 'relabel ''Value')
 instance HasLabel ValMd'                      where relabel = $(generateRelabel 'relabel ''ValMd')
+instance HasLabel DILabel'                    where relabel = $(generateRelabel 'relabel ''DILabel')
 instance HasLabel DebugLoc'                   where relabel = $(generateRelabel 'relabel ''DebugLoc')
 instance HasLabel DebugInfo'                  where relabel = $(generateRelabel 'relabel ''DebugInfo')
 instance HasLabel DIDerivedType'              where relabel = $(generateRelabel 'relabel ''DIDerivedType')
diff --git a/src/Text/LLVM/PP.hs b/src/Text/LLVM/PP.hs
index 9c54291..89f12db 100644
--- a/src/Text/LLVM/PP.hs
+++ b/src/Text/LLVM/PP.hs
@@ -859,6 +859,7 @@ ppDebugInfo' pp di = case di of
   DebugInfoTemplateTypeParameter dttp  -> ppDITemplateTypeParameter' pp dttp
   DebugInfoTemplateValueParameter dtvp -> ppDITemplateValueParameter' pp dtvp
   DebugInfoImportedEntity diip         -> ppDIImportedEntity' pp diip
+  DebugInfoLabel dil            -> ppDILabel' pp dil
 
 ppDebugInfo :: LLVM => DebugInfo -> Doc
 ppDebugInfo = ppDebugInfo' ppLabel
@@ -876,6 +877,17 @@ ppDIImportedEntity' pp ie = "!DIImportedEntity"
 ppDIImportedEntity :: LLVM => DIImportedEntity -> Doc
 ppDIImportedEntity = ppDIImportedEntity' ppLabel
 
+ppDILabel' :: LLVM => (i -> Doc) -> DILabel' i -> Doc
+ppDILabel' pp ie = "!DILabel"
+  <> parens (mcommas [ (("scope:"  <+>) . ppValMd' pp) <$> dilScope ie
+                     , pure ("name:" <+> text (dilName ie))
+                     , (("file:"   <+>) . ppValMd' pp) <$> dilFile ie
+                     , pure ("line:"   <+> integral (dilLine ie))
+                     ])
+
+ppDILabel :: LLVM => DILabel -> Doc
+ppDILabel = ppDILabel' ppLabel
+
 ppDINameSpace' :: LLVM => (i -> Doc) -> DINameSpace' i -> Doc
 ppDINameSpace' pp ns = "!DINameSpace"
   <> parens (mcommas [ ("name:"   <+>) . text <$> (dinsName ns)