diff --git a/llvm-pretty.cabal b/llvm-pretty.cabal --- a/llvm-pretty.cabal +++ b/llvm-pretty.cabal @@ -1,5 +1,5 @@ Name: llvm-pretty -Version: 0.6.0.0 +Version: 0.7.0.0 License: BSD3 License-file: LICENSE Author: Trevor Elliott diff --git a/src/Text/LLVM.hs b/src/Text/LLVM.hs --- a/src/Text/LLVM.hs +++ b/src/Text/LLVM.hs @@ -31,7 +31,7 @@ , define' , declare , global - + , FunAttrs(..), emptyFunAttrs -- * Types , iT, ptrT, voidT, arrayT , (=:), (-:) @@ -192,6 +192,7 @@ , decName = sym , decArgs = tys , decVarArgs = va + , decAttrs = [] } -- | Emit a global declaration. @@ -217,6 +218,18 @@ -- Function Definition --------------------------------------------------------- +data FunAttrs = FunAttrs + { funLinkage :: Maybe Linkage + , funGC :: Maybe GC + } deriving (Show) + +emptyFunAttrs :: FunAttrs +emptyFunAttrs = FunAttrs + { funLinkage = Nothing + , funGC = Nothing + } + + -- XXX Do not export freshArg :: Type -> LLVM (Typed Ident) freshArg ty = (Typed ty . Ident) `fmap` freshNameLLVM "a" @@ -257,13 +270,15 @@ define attrs rty fun sig k = do (args,body) <- defineBody [] sig k emitDefine Define - { defAttrs = attrs + { defLinkage = funLinkage attrs , defName = fun , defRetType = rty , defArgs = args , defVarArgs = False - , defBody = body + , defAttrs = [] , defSection = Nothing + , defGC = funGC attrs + , defBody = body , defMetadata = Map.empty } @@ -282,13 +297,15 @@ define' attrs rty sym sig va k = do args <- mapM freshArg sig emitDefine Define - { defAttrs = attrs + { defLinkage = funLinkage attrs , defName = sym , defRetType = rty , defArgs = args , defVarArgs = va - , defBody = snd (runBB (k (map (fmap toValue) args))) + , defAttrs = [] , defSection = Nothing + , defGC = funGC attrs + , defBody = snd (runBB (k (map (fmap toValue) args))) , defMetadata = Map.empty } diff --git a/src/Text/LLVM/AST.hs b/src/Text/LLVM/AST.hs --- a/src/Text/LLVM/AST.hs +++ b/src/Text/LLVM/AST.hs @@ -389,6 +389,7 @@ , decName :: Symbol , decArgs :: [Type] , decVarArgs :: Bool + , decAttrs :: [FunAttr] } deriving (Show) -- | The function type of this declaration @@ -399,12 +400,14 @@ -- Function Definitions -------------------------------------------------------- data Define = Define - { defAttrs :: FunAttrs + { defLinkage :: Maybe Linkage , defRetType :: Type , defName :: Symbol , defArgs :: [Typed Ident] , defVarArgs :: Bool + , defAttrs :: [FunAttr] , defSection :: Maybe String + , defGC :: Maybe GC , defBody :: [BasicBlock] , defMetadata :: FnMdAttachments } deriving (Show) @@ -416,17 +419,40 @@ addDefine :: Define -> Module -> Module addDefine d m = m { modDefines = d : modDefines m } -data FunAttrs = FunAttrs - { funLinkage :: Maybe Linkage - , funGC :: Maybe GC - } deriving (Show) +-- Function Attributes and attribute groups ------------------------------------ -emptyFunAttrs :: FunAttrs -emptyFunAttrs = FunAttrs - { funLinkage = Nothing - , funGC = Nothing - } +data FunAttr + = AlignStack Int + | Alwaysinline + | Builtin + | Cold + | Inlinehint + | Jumptable + | Minsize + | Naked + | Nobuiltin + | Noduplicate + | Noimplicitfloat + | Noinline + | Nonlazybind + | Noredzone + | Noreturn + | Nounwind + | Optnone + | Optsize + | Readnone + | Readonly + | ReturnsTwice + | SanitizeAddress + | SanitizeMemory + | SanitizeThread + | SSP + | SSPreq + | SSPstrong + | UWTable + deriving (Show) + -- Basic Block Labels ---------------------------------------------------------- data BlockLabel @@ -718,7 +744,7 @@ | ExtractValue (Typed (Value' lab)) [Int32] {- ^ * Get the value of a member of an aggregate value: the first argument is an aggregate value (not a pointer!), - the second is a path of indexes, similar to the one in 'GEP'. + the second is a path of indexes, similar to the one in 'GEP'. * Middle of basic block. * Returns the given member of the aggregate value. -} @@ -768,7 +794,7 @@ | IndirectBr (Typed (Value' lab)) [lab] | Switch (Typed (Value' lab)) lab [(Integer,lab)] - {- ^ * Multi-way branch: the first value determines the direction + {- ^ * Multi-way branch: the first value determines the direction of the branch, the label is a default direction, if the value does not appear in the jump table, the last argument is the jump table. @@ -940,6 +966,7 @@ | DebugInfoExpression DIExpression | DebugInfoFile DIFile | DebugInfoGlobalVariable (DIGlobalVariable' lab) + | DebugInfoGlobalVariableExpression (DIGlobalVariableExpression' lab) | DebugInfoLexicalBlock (DILexicalBlock' lab) | DebugInfoLexicalBlockFile (DILexicalBlockFile' lab) | DebugInfoLocalVariable (DILocalVariable' lab) @@ -987,6 +1014,7 @@ , dicuImports :: Maybe (ValMd' lab) , dicuMacros :: Maybe (ValMd' lab) , dicuDWOId :: Word64 + , dicuSplitDebugInlining :: Bool } deriving (Show,Functor,Generic,Generic1) @@ -1051,10 +1079,19 @@ , digvIsDefinition :: Bool , digvVariable :: Maybe (ValMd' lab) , digvDeclaration :: Maybe (ValMd' lab) + , digvAlignment :: Maybe Word32 } deriving (Show,Functor,Generic,Generic1) type DIGlobalVariable = DIGlobalVariable' BlockLabel + +data DIGlobalVariableExpression' lab = DIGlobalVariableExpression + { digveVariable :: Maybe (ValMd' lab) + , digveExpression :: Maybe (ValMd' lab) + } + deriving (Show,Functor,Generic,Generic1) + +type DIGlobalVariableExpression = DIGlobalVariableExpression' BlockLabel data DILexicalBlock' lab = DILexicalBlock { dilbScope :: Maybe (ValMd' lab) diff --git a/src/Text/LLVM/Labels.hs b/src/Text/LLVM/Labels.hs --- a/src/Text/LLVM/Labels.hs +++ b/src/Text/LLVM/Labels.hs @@ -148,20 +148,21 @@ relabel f (Resume tv) = Resume <$> traverse (relabel f) tv -instance HasLabel Clause' where relabel = genericRelabel -instance HasLabel Value' where relabel = genericRelabel -instance HasLabel ValMd' where relabel = genericRelabel -instance HasLabel DebugLoc' where relabel = genericRelabel -instance HasLabel DebugInfo' where relabel = genericRelabel -instance HasLabel DIDerivedType' where relabel = genericRelabel -instance HasLabel DISubroutineType' where relabel = genericRelabel -instance HasLabel DIGlobalVariable' where relabel = genericRelabel -instance HasLabel DILocalVariable' where relabel = genericRelabel -instance HasLabel DISubprogram' where relabel = genericRelabel -instance HasLabel DICompositeType' where relabel = genericRelabel -instance HasLabel DILexicalBlock' where relabel = genericRelabel -instance HasLabel DICompileUnit' where relabel = genericRelabel -instance HasLabel DILexicalBlockFile' where relabel = genericRelabel +instance HasLabel Clause' where relabel = genericRelabel +instance HasLabel Value' where relabel = genericRelabel +instance HasLabel ValMd' where relabel = genericRelabel +instance HasLabel DebugLoc' where relabel = genericRelabel +instance HasLabel DebugInfo' where relabel = genericRelabel +instance HasLabel DIDerivedType' where relabel = genericRelabel +instance HasLabel DISubroutineType' where relabel = genericRelabel +instance HasLabel DIGlobalVariable' where relabel = genericRelabel +instance HasLabel DIGlobalVariableExpression' where relabel = genericRelabel +instance HasLabel DILocalVariable' where relabel = genericRelabel +instance HasLabel DISubprogram' where relabel = genericRelabel +instance HasLabel DICompositeType' where relabel = genericRelabel +instance HasLabel DILexicalBlock' where relabel = genericRelabel +instance HasLabel DICompileUnit' where relabel = genericRelabel +instance HasLabel DILexicalBlockFile' where relabel = genericRelabel -- | Clever instance that actually uses the block name instance HasLabel ConstExpr' where diff --git a/src/Text/LLVM/PP.hs b/src/Text/LLVM/PP.hs --- a/src/Text/LLVM/PP.hs +++ b/src/Text/LLVM/PP.hs @@ -222,16 +222,19 @@ <+> ppType (decRetType d) <+> ppSymbol (decName d) <> ppArgList (decVarArgs d) (map ppType (decArgs d)) + <+> hsep (ppFunAttr <$> decAttrs d) + ppDefine :: LLVM => Define -> Doc ppDefine d = "define" - <+> ppMaybe ppLinkage (funLinkage (defAttrs d)) + <+> ppMaybe ppLinkage (defLinkage d) <+> ppType (defRetType d) <+> ppSymbol (defName d) <> ppArgList (defVarArgs d) (map (ppTyped ppIdent) (defArgs d)) + <+> hsep (ppFunAttr <$> defAttrs d) <+> ppMaybe (\s -> "section" <+> doubleQuotes (text s)) (defSection d) - <+> ppMaybe (\gc -> "gc" <+> ppGC gc) (funGC (defAttrs d)) + <+> ppMaybe (\gc -> "gc" <+> ppGC gc) (defGC d) <+> ppMds (defMetadata d) <+> char '{' $+$ vcat (map ppBasicBlock (defBody d)) @@ -242,6 +245,40 @@ [] -> empty mds -> hsep [ "!" <> text k <+> ppValMd md | (k, md) <- mds ] +-- FunAttr --------------------------------------------------------------------- + +ppFunAttr :: FunAttr -> Doc +ppFunAttr a = + case a of + AlignStack w -> text "alignstack" <> parens (int w) + Alwaysinline -> text "alwaysinline" + Builtin -> text "builtin" + Cold -> text "cold" + Inlinehint -> text "inlinehint" + Jumptable -> text "jumptable" + Minsize -> text "minsize" + Naked -> text "naked" + Nobuiltin -> text "nobuiltin" + Noduplicate -> text "noduplicate" + Noimplicitfloat -> text "noimplicitfloat" + Noinline -> text "noinline" + Nonlazybind -> text "nonlazybind" + Noredzone -> text "noredzone" + Noreturn -> text "noreturn" + Nounwind -> text "nounwind" + Optnone -> text "optnone" + Optsize -> text "optsize" + Readnone -> text "readnone" + Readonly -> text "readonly" + ReturnsTwice -> text "returns_twice" + SanitizeAddress -> text "sanitize_address" + SanitizeMemory -> text "sanitize_memory" + SanitizeThread -> text "sanitize_thread" + SSP -> text "ssp" + SSPreq -> text "sspreq" + SSPstrong -> text "sspstrong" + UWTable -> text "uwtable" + -- Basic Blocks ---------------------------------------------------------------- ppLabelDef :: BlockLabel -> Doc @@ -643,6 +680,7 @@ DebugInfoExpression e -> ppDIExpression e DebugInfoFile f -> ppDIFile f DebugInfoGlobalVariable gv -> ppDIGlobalVariable gv + DebugInfoGlobalVariableExpression gv -> ppDIGlobalVariableExpression gv DebugInfoLexicalBlock lb -> ppDILexicalBlock lb DebugInfoLexicalBlockFile lbf -> ppDILexicalBlockFile lbf DebugInfoLocalVariable lv -> ppDILocalVariable lv @@ -746,6 +784,14 @@ , pure ("isDefinition:" <+> ppBool (digvIsDefinition gv)) , (("variable:" <+>) . ppValMd) <$> (digvType gv) , (("declaration:" <+>) . ppValMd) <$> (digvDeclaration gv) + , (("align:" <+>) . integral) <$> digvAlignment gv + ]) + +ppDIGlobalVariableExpression :: DIGlobalVariableExpression -> Doc +ppDIGlobalVariableExpression gve = "!DIGlobalVariableExpression" + <> parens (mcommas + [ (("var:" <+>) . ppValMd) <$> (digveVariable gve) + , (("expr:" <+>) . ppValMd) <$> (digveExpression gve) ]) ppDILexicalBlock :: DILexicalBlock -> Doc