Actually parse METADATA_LABEL blocks

Ptival · Sep 27, 2019 · 0d341a9 · 0d341a9
1 parent d800941
commit 0d341a9
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 0 deletions.
diff --git 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
@@ -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
@@ -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)