Commit 0f15f8a7 authored by dterei's avatar dterei
Browse files

Add Metadata support to LLVM bindings.

parent 234a526f
......@@ -34,6 +34,9 @@ module Llvm (
-- ** Some basic types
i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
-- ** Metadata types
LlvmMetaVal(..), LlvmMetaUnamed(..), LlvmMeta(..), MetaData,
-- ** Operations on the type system.
isGlobal, getLitType, getLit, getName, getPlainName, getVarType,
getLink, getStatType, getGlobalVar, getGlobalType, pVarLift, pVarLower,
......@@ -42,7 +45,8 @@ module Llvm (
-- * Pretty Printing
ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals,
ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions,
ppLlvmFunction, ppLlvmAlias, ppLlvmAliases, llvmSDoc
ppLlvmFunction, ppLlvmAlias, ppLlvmAliases, ppLlvmMetas, ppLlvmMeta,
llvmSDoc
) where
......
......@@ -31,6 +31,9 @@ data LlvmModule = LlvmModule {
-- | LLVM Alias type definitions.
modAliases :: [LlvmAlias],
-- | LLVM meta data.
modMeta :: [LlvmMeta],
-- | Global variables to include in the module.
modGlobals :: [LMGlobal],
......@@ -138,8 +141,15 @@ data LlvmStatement
-}
| Nop
{- |
A LLVM statement with metadata attached to it.
-}
| MetaStmt [MetaData] LlvmStatement
deriving (Show, Eq)
type MetaData = (LMString, LlvmMetaUnamed)
-- | Llvm Expressions
data LlvmExpression
......@@ -229,5 +239,10 @@ data LlvmExpression
-}
| Asm LMString LMString LlvmType [LlvmVar] Bool Bool
{- |
A LLVM expression with metadata attached to it.
-}
| MetaExpr [MetaData] LlvmExpression
deriving (Show, Eq)
......@@ -10,8 +10,10 @@ module Llvm.PpLlvm (
ppLlvmComment,
ppLlvmGlobals,
ppLlvmGlobal,
ppLlvmAlias,
ppLlvmAliases,
ppLlvmAlias,
ppLlvmMetas,
ppLlvmMeta,
ppLlvmFunctionDecls,
ppLlvmFunctionDecl,
ppLlvmFunctions,
......@@ -38,9 +40,10 @@ import Unique
-- | Print out a whole LLVM module.
ppLlvmModule :: LlvmModule -> Doc
ppLlvmModule (LlvmModule comments aliases globals decls funcs)
ppLlvmModule (LlvmModule comments aliases meta globals decls funcs)
= ppLlvmComments comments $+$ newLine
$+$ ppLlvmAliases aliases $+$ newLine
$+$ ppLlvmMetas meta $+$ newLine
$+$ ppLlvmGlobals globals $+$ newLine
$+$ ppLlvmFunctionDecls decls $+$ newLine
$+$ ppLlvmFunctions funcs
......@@ -91,6 +94,31 @@ ppLlvmAlias (name, ty)
= text "%" <> ftext name <+> equals <+> text "type" <+> texts ty
-- | Print out a list of LLVM metadata.
ppLlvmMetas :: [LlvmMeta] -> Doc
ppLlvmMetas metas = vcat $ map ppLlvmMeta metas
-- | Print out an LLVM metadata definition.
ppLlvmMeta :: LlvmMeta -> Doc
ppLlvmMeta (MetaUnamed (LMMetaUnamed u) metas)
= exclamation <> int u <> text " = metadata !{" <>
hcat (intersperse comma $ map ppLlvmMetaVal metas) <> text "}"
ppLlvmMeta (MetaNamed n metas)
= exclamation <> ftext n <> text " = !{" <>
hcat (intersperse comma $ map pprNode munq) <> text "}"
where
munq = map (\(LMMetaUnamed u) -> u) metas
pprNode n = exclamation <> int n
-- | Print out an LLVM metadata value.
ppLlvmMetaVal :: LlvmMetaVal -> Doc
ppLlvmMetaVal (MetaStr s) = text "metadata !" <> doubleQuotes (ftext s)
ppLlvmMetaVal (MetaVar v) = texts v
ppLlvmMetaVal (MetaNode (LMMetaUnamed u))
= text "metadata !" <> int u
-- | Print out a list of function definitions.
ppLlvmFunctions :: LlvmFunctions -> Doc
ppLlvmFunctions funcs = vcat $ map ppLlvmFunction funcs
......@@ -172,6 +200,11 @@ ppLlvmBlock (LlvmBlock blockId stmts)
$+$ newLine
$+$ ppRest
-- | Print out an LLVM block label.
ppLlvmBlockLabel :: LlvmBlockId -> Doc
ppLlvmBlockLabel id = (llvmSDoc $ pprUnique id) <> colon
-- | Print out an LLVM statement.
ppLlvmStatement :: LlvmStatement -> Doc
ppLlvmStatement stmt =
......@@ -188,10 +221,8 @@ ppLlvmStatement stmt =
Expr expr -> ind $ ppLlvmExpression expr
Unreachable -> ind $ text "unreachable"
Nop -> empty
MetaStmt meta s -> ppMetaStatement meta s
-- | Print out an LLVM block label.
ppLlvmBlockLabel :: LlvmBlockId -> Doc
ppLlvmBlockLabel id = (llvmSDoc $ pprUnique id) <> colon
-- | Print out an LLVM expression.
ppLlvmExpression :: LlvmExpression -> Doc
......@@ -207,6 +238,7 @@ ppLlvmExpression expr
Malloc tp amount -> ppMalloc tp amount
Phi tp precessors -> ppPhi tp precessors
Asm asm c ty v se sk -> ppAsm asm c ty v se sk
MetaExpr meta expr -> ppMetaExpr meta expr
--------------------------------------------------------------------------------
......@@ -342,6 +374,21 @@ ppAsm asm constraints rty vars sideeffect alignstack =
<+> cons <> vars'
ppMetaStatement :: [MetaData] -> LlvmStatement -> Doc
ppMetaStatement meta stmt = ppLlvmStatement stmt <> ppMetas meta
ppMetaExpr :: [MetaData] -> LlvmExpression -> Doc
ppMetaExpr meta expr = ppLlvmExpression expr <> ppMetas meta
ppMetas :: [MetaData] -> Doc
ppMetas meta = hcat $ map ppMeta meta
where
ppMeta (name, (LMMetaUnamed n))
= comma <+> exclamation <> ftext name <+> exclamation <> int n
--------------------------------------------------------------------------------
-- * Misc functions
--------------------------------------------------------------------------------
......@@ -363,3 +410,7 @@ texts = (text . show)
newLine :: Doc
newLine = text ""
-- | Exclamation point.
exclamation :: Doc
exclamation = text "!"
......@@ -70,12 +70,49 @@ instance Show LlvmType where
show (LMAlias (s,_)) = "%" ++ unpackFS s
-- | LLVM metadata values. Used for representing debug and optimization
-- information.
data LlvmMetaVal
-- | Metadata string
= MetaStr LMString
-- | Metadata node
| MetaNode LlvmMetaUnamed
-- | Normal value type as metadata
| MetaVar LlvmVar
deriving (Eq)
-- | LLVM metadata nodes.
data LlvmMeta
-- | Unamed metadata
= MetaUnamed LlvmMetaUnamed [LlvmMetaVal]
-- | Named metadata
| MetaNamed LMString [LlvmMetaUnamed]
deriving (Eq)
-- | Unamed metadata variable.
newtype LlvmMetaUnamed = LMMetaUnamed Int
instance Eq LlvmMetaUnamed where
(==) (LMMetaUnamed n) (LMMetaUnamed m) = n == m
instance Show LlvmMetaVal where
show (MetaStr s) = "metadata !\"" ++ unpackFS s ++ "\""
show (MetaNode n) = "metadata " ++ show n
show (MetaVar v) = show v
instance Show LlvmMetaUnamed where
show (LMMetaUnamed u) = "!" ++ show u
instance Show LlvmMeta where
show (MetaUnamed m _) = show m
show (MetaNamed m _) = "!" ++ unpackFS m
-- | An LLVM section definition. If Nothing then let LLVM decide the section
type LMSection = Maybe LMString
type LMAlign = Maybe Int
type LMConst = Bool -- ^ is a variable constant or not
-- | Llvm Variables
-- | LLVM Variables
data LlvmVar
-- | Variables with a global scope.
= LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign LMConst
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment