llvm-pretty 0.7.1.0 → 0.7.1.1
raw patch · 4 files changed
+173/−149 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Text.LLVM.AST: parseLayoutSpec :: MonadPlus m => String -> m LayoutSpec
+ Text.LLVM.AST: [globalMetadata] :: Global -> GlobalMdAttachments
+ Text.LLVM.AST: instance GHC.Generics.Generic (Text.LLVM.AST.BasicBlock' lab)
+ Text.LLVM.AST: instance GHC.Generics.Generic (Text.LLVM.AST.Type' ident)
+ Text.LLVM.AST: instance GHC.Generics.Generic (Text.LLVM.AST.Typed a)
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.ArithOp
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.BitOp
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.BlockLabel
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.ConvOp
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.DIBasicType
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.DIExpression
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.DIFile
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.DISubrange
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Declare
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Define
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.FCmpOp
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.FloatType
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.FunAttr
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.GC
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Global
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.GlobalAlias
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.GlobalAttrs
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.ICmpOp
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Ident
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.LayoutSpec
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Linkage
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Mangling
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Module
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.NamedMd
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.PrimType
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.Symbol
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.TypeDecl
+ Text.LLVM.AST: instance GHC.Generics.Generic Text.LLVM.AST.UnnamedMd
+ Text.LLVM.AST: type GlobalMdAttachments = Map KindMd ValMd
+ Text.LLVM.PP: [cfgUseDILocation] :: Config -> Bool
+ Text.LLVM.PP: ppFlags :: Maybe String -> Doc
- Text.LLVM.AST: DICompileUnit :: DwarfLang -> Maybe (ValMd' lab) -> Maybe String -> Bool -> DIFlags -> Word16 -> Maybe FilePath -> DIEmissionKind -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Word64 -> Bool -> DICompileUnit' lab
+ Text.LLVM.AST: DICompileUnit :: DwarfLang -> Maybe (ValMd' lab) -> Maybe String -> Bool -> Maybe String -> Word16 -> Maybe FilePath -> DIEmissionKind -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Maybe (ValMd' lab) -> Word64 -> Bool -> DICompileUnit' lab
- Text.LLVM.AST: Global :: Symbol -> GlobalAttrs -> Type -> Maybe Value -> Maybe Align -> Global
+ Text.LLVM.AST: Global :: Symbol -> GlobalAttrs -> Type -> Maybe Value -> Maybe Align -> GlobalMdAttachments -> Global
- Text.LLVM.AST: PointerSize :: !Int -> !Int -> (Maybe Int) -> LayoutSpec
+ Text.LLVM.AST: PointerSize :: !Int -> !Int -> !Int -> (Maybe Int) -> LayoutSpec
- Text.LLVM.AST: [dicuFlags] :: DICompileUnit' lab -> DIFlags
+ Text.LLVM.AST: [dicuFlags] :: DICompileUnit' lab -> Maybe String
- Text.LLVM.PP: Config :: Bool -> Bool -> Config
+ Text.LLVM.PP: Config :: Bool -> Bool -> Bool -> Config
- Text.LLVM.PP: ppAlloca :: Type -> Maybe (Typed Value) -> Maybe Int -> Doc
+ Text.LLVM.PP: ppAlloca :: LLVM => Type -> Maybe (Typed Value) -> Maybe Int -> Doc
- Text.LLVM.PP: ppAttachedMetadata :: [(String, ValMd)] -> Doc
+ Text.LLVM.PP: ppAttachedMetadata :: LLVM => [(String, ValMd)] -> Doc
- Text.LLVM.PP: ppCall :: Bool -> Type -> Value -> [Typed Value] -> Doc
+ Text.LLVM.PP: ppCall :: LLVM => Bool -> Type -> Value -> [Typed Value] -> Doc
- Text.LLVM.PP: ppCallSym :: Type -> Value -> Doc
+ Text.LLVM.PP: ppCallSym :: LLVM => Type -> Value -> Doc
- Text.LLVM.PP: ppClause :: Clause -> Doc
+ Text.LLVM.PP: ppClause :: LLVM => Clause -> Doc
- Text.LLVM.PP: ppClauses :: Bool -> [Clause] -> Doc
+ Text.LLVM.PP: ppClauses :: LLVM => Bool -> [Clause] -> Doc
- Text.LLVM.PP: ppConstExpr :: ConstExpr -> Doc
+ Text.LLVM.PP: ppConstExpr :: LLVM => ConstExpr -> Doc
- Text.LLVM.PP: ppDICompileUnit :: DICompileUnit -> Doc
+ Text.LLVM.PP: ppDICompileUnit :: LLVM => DICompileUnit -> Doc
- Text.LLVM.PP: ppDICompositeType :: DICompositeType -> Doc
+ Text.LLVM.PP: ppDICompositeType :: LLVM => DICompositeType -> Doc
- Text.LLVM.PP: ppDIDerivedType :: DIDerivedType -> Doc
+ Text.LLVM.PP: ppDIDerivedType :: LLVM => DIDerivedType -> Doc
- Text.LLVM.PP: ppDIGlobalVariable :: DIGlobalVariable -> Doc
+ Text.LLVM.PP: ppDIGlobalVariable :: LLVM => DIGlobalVariable -> Doc
- Text.LLVM.PP: ppDIGlobalVariableExpression :: DIGlobalVariableExpression -> Doc
+ Text.LLVM.PP: ppDIGlobalVariableExpression :: LLVM => DIGlobalVariableExpression -> Doc
- Text.LLVM.PP: ppDILexicalBlock :: DILexicalBlock -> Doc
+ Text.LLVM.PP: ppDILexicalBlock :: LLVM => DILexicalBlock -> Doc
- Text.LLVM.PP: ppDILexicalBlockFile :: DILexicalBlockFile -> Doc
+ Text.LLVM.PP: ppDILexicalBlockFile :: LLVM => DILexicalBlockFile -> Doc
- Text.LLVM.PP: ppDILocalVariable :: DILocalVariable -> Doc
+ Text.LLVM.PP: ppDILocalVariable :: LLVM => DILocalVariable -> Doc
- Text.LLVM.PP: ppDISubprogram :: DISubprogram -> Doc
+ Text.LLVM.PP: ppDISubprogram :: LLVM => DISubprogram -> Doc
- Text.LLVM.PP: ppDISubroutineType :: DISubroutineType -> Doc
+ Text.LLVM.PP: ppDISubroutineType :: LLVM => DISubroutineType -> Doc
- Text.LLVM.PP: ppDebugInfo :: DebugInfo -> Doc
+ Text.LLVM.PP: ppDebugInfo :: LLVM => DebugInfo -> Doc
- Text.LLVM.PP: ppDebugLoc :: DebugLoc -> Doc
+ Text.LLVM.PP: ppDebugLoc :: LLVM => DebugLoc -> Doc
- Text.LLVM.PP: ppGlobal :: Global -> Doc
+ Text.LLVM.PP: ppGlobal :: LLVM => Global -> Doc
- Text.LLVM.PP: ppGlobalAlias :: GlobalAlias -> Doc
+ Text.LLVM.PP: ppGlobalAlias :: LLVM => GlobalAlias -> Doc
- Text.LLVM.PP: ppInvoke :: Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc
+ Text.LLVM.PP: ppInvoke :: LLVM => Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc
- Text.LLVM.PP: ppMetadataNode :: [Maybe ValMd] -> Doc
+ Text.LLVM.PP: ppMetadataNode :: LLVM => [Maybe ValMd] -> Doc
- Text.LLVM.PP: ppPhiArg :: (Value, BlockLabel) -> Doc
+ Text.LLVM.PP: ppPhiArg :: LLVM => (Value, BlockLabel) -> Doc
- Text.LLVM.PP: ppTypedValMd :: ValMd -> Doc
+ Text.LLVM.PP: ppTypedValMd :: LLVM => ValMd -> Doc
- Text.LLVM.PP: ppUnnamedMd :: UnnamedMd -> Doc
+ Text.LLVM.PP: ppUnnamedMd :: LLVM => UnnamedMd -> Doc
- Text.LLVM.PP: ppValMd :: ValMd -> Doc
+ Text.LLVM.PP: ppValMd :: LLVM => ValMd -> Doc
- Text.LLVM.PP: ppValue :: Value -> Doc
+ Text.LLVM.PP: ppValue :: LLVM => Value -> Doc
- Text.LLVM.PP: ppVectorIndex :: Value -> Doc
+ Text.LLVM.PP: ppVectorIndex :: LLVM => Value -> Doc
Files
- llvm-pretty.cabal +1/−1
- src/Text/LLVM.hs +6/−5
- src/Text/LLVM/AST.hs +102/−95
- src/Text/LLVM/PP.hs +64/−48
llvm-pretty.cabal view
@@ -1,5 +1,5 @@ Name: llvm-pretty-Version: 0.7.1.0+Version: 0.7.1.1 License: BSD3 License-file: LICENSE Author: Trevor Elliott
src/Text/LLVM.hs view
@@ -198,11 +198,12 @@ -- | Emit a global declaration. global :: GlobalAttrs -> Symbol -> Type -> Maybe Value -> LLVM (Typed Value) global attrs sym ty mbVal = emitGlobal Global- { globalSym = sym- , globalType = ty- , globalValue = toValue `fmap` mbVal- , globalAttrs = attrs- , globalAlign = Nothing+ { globalSym = sym+ , globalType = ty+ , globalValue = toValue `fmap` mbVal+ , globalAttrs = attrs+ , globalAlign = Nothing+ , globalMetadata = Map.empty } -- | Output a somewhat clunky representation for a string global, that deals
src/Text/LLVM/AST.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE DeriveFunctor, DeriveGeneric #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-} #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1@@ -10,9 +11,7 @@ module Text.LLVM.AST where -import Text.LLVM.Util (breaks,uncons)--import Control.Monad (MonadPlus(mzero,mplus),(<=<),msum,guard,liftM,liftM3)+import Control.Monad (MonadPlus(mzero,mplus),(<=<),guard) import Data.Int (Int32,Int64) import Data.List (genericIndex,genericLength) import qualified Data.Map as Map@@ -20,6 +19,9 @@ import Data.Word (Word8,Word16,Word32,Word64) import GHC.Generics (Generic, Generic1) +import Text.Parsec+import Text.Parsec.String+ #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative ((<$)) import Data.Foldable (Foldable(foldMap))@@ -32,16 +34,16 @@ data Module = Module { modSourceName :: Maybe String- , modDataLayout :: DataLayout- , modTypes :: [TypeDecl]+ , modDataLayout :: DataLayout -- ^ type size and alignment information+ , modTypes :: [TypeDecl] -- ^ top-level type aliases , modNamedMd :: [NamedMd] , modUnnamedMd :: [UnnamedMd]- , modGlobals :: [Global]- , modDeclares :: [Declare]- , modDefines :: [Define]+ , modGlobals :: [Global] -- ^ global value declarations+ , modDeclares :: [Declare] -- ^ external function declarations (without definitions)+ , modDefines :: [Define] -- ^ internal function declarations (with definitions) , modInlineAsm :: InlineAsm , modAliases :: [GlobalAlias]- } deriving (Show)+ } deriving (Show,Generic) instance Monoid Module where mempty = emptyModule@@ -78,7 +80,7 @@ data NamedMd = NamedMd { nmName :: String , nmValues :: [Int]- } deriving (Show)+ } deriving (Show,Generic) -- Unnamed Metadata ------------------------------------------------------------@@ -87,7 +89,7 @@ { umIndex :: !Int , umValues :: ValMd , umDistinct :: Bool- } deriving (Show)+ } deriving (Show,Generic) -- Aliases ---------------------------------------------------------------------@@ -96,7 +98,7 @@ { aliasName :: Symbol , aliasType :: Type , aliasTarget :: Value- } deriving (Show)+ } deriving (Show,Generic) -- Data Layout -----------------------------------------------------------------@@ -106,72 +108,71 @@ data LayoutSpec = BigEndian | LittleEndian- | PointerSize !Int !Int (Maybe Int)- | IntegerSize !Int !Int (Maybe Int)- | VectorSize !Int !Int (Maybe Int)- | FloatSize !Int !Int (Maybe Int)- | AggregateSize !Int !Int (Maybe Int)- | StackObjSize !Int !Int (Maybe Int)+ | PointerSize !Int !Int !Int (Maybe Int) -- ^ address space, size, abi, pref+ | IntegerSize !Int !Int (Maybe Int) -- ^ size, abi, pref+ | VectorSize !Int !Int (Maybe Int) -- ^ size, abi, pref+ | FloatSize !Int !Int (Maybe Int) -- ^ size, abi, pref+ | StackObjSize !Int !Int (Maybe Int) -- ^ size, abi, pref+ | AggregateSize !Int !Int (Maybe Int) -- ^ size, abi, pref | NativeIntSize [Int]- | StackAlign !Int+ | StackAlign !Int -- ^ size | Mangling Mangling- deriving (Show)+ deriving (Show,Generic) data Mangling = ElfMangling | MipsMangling | MachOMangling | WindowsCoffMangling- deriving (Show,Eq)+ deriving (Show,Generic,Eq) -- | Parse the data layout string. parseDataLayout :: MonadPlus m => String -> m DataLayout-parseDataLayout = mapM parseLayoutSpec . breaks (== '-')---- | Parse a single layout specification from a string.-parseLayoutSpec :: MonadPlus m => String -> m LayoutSpec-parseLayoutSpec str = msum- [ guard (str == "E") >> return BigEndian- , guard (str == "e") >> return LittleEndian- , do (i,rest) <- uncons str- let body = breaks (== ':') rest- case i of-- 'S' -> do align <- parseInt rest- return (StackAlign align)-- 'p' -> build PointerSize (tail body)- 'i' -> build IntegerSize body- 'v' -> build VectorSize body- 'f' -> build FloatSize body- 'a' -> build AggregateSize body- 's' -> build StackObjSize body-- 'n' -> do ints <- mapM parseInt body- return (NativeIntSize ints)-- 'm' -> case tail body of- ["e"] -> return (Mangling ElfMangling)- ["m"] -> return (Mangling MipsMangling)- ["o"] -> return (Mangling MachOMangling)- ["w"] -> return (Mangling WindowsCoffMangling)- _ -> mzero+parseDataLayout str =+ case parse (pDataLayout <* eof) "<internal>" str of+ Left _err -> mzero+ Right specs -> return specs+ where+ pDataLayout :: Parser DataLayout+ pDataLayout = sepBy pLayoutSpec (char '-') - _ -> mzero- ]+ pLayoutSpec :: Parser LayoutSpec+ pLayoutSpec =+ do c <- letter+ case c of+ 'E' -> return BigEndian+ 'e' -> return LittleEndian+ 'S' -> StackAlign <$> pInt+ 'p' -> PointerSize <$> pInt0 <*> pCInt <*> pCInt <*> pPref+ 'i' -> IntegerSize <$> pInt <*> pCInt <*> pPref+ 'v' -> VectorSize <$> pInt <*> pCInt <*> pPref+ 'f' -> FloatSize <$> pInt <*> pCInt <*> pPref+ 's' -> StackObjSize <$> pInt <*> pCInt <*> pPref+ 'a' -> AggregateSize <$> pInt <*> pCInt <*> pPref+ 'n' -> NativeIntSize <$> sepBy pInt (char ':')+ 'm' -> Mangling <$> (char ':' >> pMangling)+ _ -> mzero - where+ pMangling :: Parser Mangling+ pMangling =+ do c <- letter+ case c of+ 'e' -> return ElfMangling+ 'm' -> return MipsMangling+ 'o' -> return MachOMangling+ 'w' -> return WindowsCoffMangling+ _ -> mzero - build f lst = case lst of- [sz,abi,pref] -> liftM3 f (parseInt sz) (parseInt abi) (parsePref pref)- [sz,abi] -> liftM3 f (parseInt sz) (parseInt abi) (return Nothing)- _ -> mzero+ pInt :: Parser Int+ pInt = read <$> many1 digit - parsePref = liftM Just . parseInt+ pInt0 :: Parser Int+ pInt0 = pInt <|> return 0 - parseInt s = case reads s of- [(i,[])] -> return i- _ -> mzero+ pCInt :: Parser Int+ pCInt = char ':' >> pInt + pPref :: Parser (Maybe Int)+ pPref = optionMaybe pCInt -- Inline Assembly ------------------------------------------------------------- @@ -180,7 +181,7 @@ -- Identifiers ----------------------------------------------------------------- newtype Ident = Ident String- deriving (Show,Eq,Ord)+ deriving (Show,Generic,Eq,Ord) instance IsString Ident where fromString = Ident@@ -188,7 +189,7 @@ -- Symbols --------------------------------------------------------------------- newtype Symbol = Symbol String- deriving (Show,Eq,Ord)+ deriving (Show,Generic,Eq,Ord) instance Monoid Symbol where mappend (Symbol a) (Symbol b) = Symbol (mappend a b)@@ -206,7 +207,7 @@ | FloatType FloatType | X86mmx | Metadata- deriving (Eq, Ord, Show)+ deriving (Eq, Generic, Ord, Show) data FloatType = Half@@ -215,7 +216,7 @@ | Fp128 | X86_fp80 | PPC_fp128- deriving (Eq, Ord, Show)+ deriving (Eq, Generic, Ord, Show) type Type = Type' Ident @@ -229,7 +230,7 @@ | PackedStruct [Type' ident] | Vector Int32 (Type' ident) | Opaque- deriving (Eq, Ord, Show, Functor)+ deriving (Eq, Generic, Ord, Show, Functor) -- | Traverse a type, updating or removing aliases. updateAliases :: (a -> Type' b) -> (Type' a -> Type' b)@@ -354,7 +355,7 @@ data TypeDecl = TypeDecl { typeName :: Ident , typeValue :: Type- } deriving (Show)+ } deriving (Show, Generic) -- Globals ---------------------------------------------------------------------@@ -365,7 +366,8 @@ , globalType :: Type , globalValue :: Maybe Value , globalAlign :: Maybe Align- } deriving Show+ , globalMetadata :: GlobalMdAttachments+ } deriving (Show, Generic) addGlobal :: Global -> Module -> Module addGlobal g m = m { modGlobals = g : modGlobals m }@@ -373,7 +375,7 @@ data GlobalAttrs = GlobalAttrs { gaLinkage :: Maybe Linkage , gaConstant :: Bool- } deriving (Show)+ } deriving (Show, Generic) emptyGlobalAttrs :: GlobalAttrs emptyGlobalAttrs = GlobalAttrs@@ -390,7 +392,7 @@ , decArgs :: [Type] , decVarArgs :: Bool , decAttrs :: [FunAttr]- } deriving (Show)+ } deriving (Show, Generic) -- | The function type of this declaration decFunType :: Declare -> Type@@ -410,7 +412,7 @@ , defGC :: Maybe GC , defBody :: [BasicBlock] , defMetadata :: FnMdAttachments- } deriving (Show)+ } deriving (Show, Generic) defFunType :: Define -> Type defFunType Define { .. } =@@ -451,14 +453,14 @@ | SSPreq | SSPstrong | UWTable- deriving (Show)+ deriving (Show, Generic) -- Basic Block Labels ---------------------------------------------------------- data BlockLabel = Named Ident | Anon Int- deriving (Eq,Ord,Show)+ deriving (Eq,Ord,Show, Generic) instance IsString BlockLabel where fromString str = Named (fromString str)@@ -468,7 +470,7 @@ data BasicBlock' lab = BasicBlock { bbLabel :: Maybe lab , bbStmts :: [Stmt' lab]- } deriving (Show)+ } deriving (Show, Generic) type BasicBlock = BasicBlock' BlockLabel @@ -502,18 +504,18 @@ | External | DLLImport | DLLExport- deriving (Eq,Show)+ deriving (Eq,Show,Generic) newtype GC = GC { getGC :: String- } deriving (Show)+ } deriving (Show,Generic) -- Typed Things ---------------------------------------------------------------- data Typed a = Typed { typedType :: Type , typedValue :: a- } deriving (Show,Functor)+ } deriving (Show,Generic,Functor) instance Foldable Typed where foldMap f t = f (typedValue t)@@ -583,7 +585,7 @@ -- ^ * Floating point reminder resulting from floating point division. -- * The reminder has the same sign as the divident (first parameter). - deriving (Eq,Show)+ deriving (Eq,Generic,Show) isIArith :: ArithOp -> Bool isIArith Add{} = True@@ -598,6 +600,7 @@ isFArith :: ArithOp -> Bool isFArith = not . isIArith +-- | Binary bitwise operators. data BitOp = Shl Bool Bool {- ^ * Shift left.@@ -608,32 +611,33 @@ If a check fails, then the result is poisoned. The value of the second parameter must be strictly less than the- nubmer of bits in the first parameter,+ number of bits in the first parameter, otherwise the result is undefined. -} | Lshr Bool {- ^ * Logical shift right.- * The boolean is for exact check: posion the result,+ * The boolean is for exact check: poison the result, if we shift out a 1 bit (i.e., had to round). The value of the second parameter must be strictly less than the- nubmer of bits in the first parameter, otherwise the result is undefined.+ number of bits in the first parameter, otherwise the result is undefined. -} | Ashr Bool {- ^ * Arithmetic shift right.- * The boolean is for exact check: posion the result,+ * The boolean is for exact check: poison the result, if we shift out a 1 bit (i.e., had to round). The value of the second parameter must be strictly less than the- nubmer of bits in the first parameter, otherwise the result is undefined.+ number of bits in the first parameter, otherwise the result is undefined. -} | And | Or | Xor- deriving Show+ deriving (Show,Generic) +-- | Conversions from one type to another. data ConvOp = Trunc | ZExt@@ -647,7 +651,7 @@ | PtrToInt | IntToPtr | BitCast- deriving Show+ deriving (Show,Generic) type Align = Int @@ -687,7 +691,7 @@ how many elements (1 if 'Nothing'); required alignment. * Middle of basic block.- * Returns a pointer to hold the given number of elemets. -}+ * Returns a pointer to hold the given number of elements. -} | Load (Typed (Value' lab)) (Maybe Align) {- ^ * Read a value from the given address:@@ -759,7 +763,7 @@ {- ^ * Get an element from a vector: the first argument is a vector, the second an index. * Middle of basic block.- * Returns the element at the given positoin. -}+ * Returns the element at the given position. -} | InsertElt (Typed (Value' lab)) (Typed (Value' lab)) (Value' lab) {- ^ * Modify an element of a vector: the first argument is the vector,@@ -838,13 +842,15 @@ isPhi Phi{} = True isPhi _ = False +-- | Integer comparison operators. data ICmpOp = Ieq | Ine | Iugt | Iuge | Iult | Iule | Isgt | Isge | Islt | Isle- deriving (Show)+ deriving (Show, Generic) +-- | Floating-point comparison operators. data FCmpOp = Ffalse | Foeq | Fogt | Foge | Folt | Fole | Fone | Ford | Fueq | Fugt | Fuge | Fult | Fule | Fune | Funo | Ftrue- deriving (Show)+ deriving (Show, Generic) -- Values ----------------------------------------------------------------------@@ -885,6 +891,7 @@ type KindMd = String type FnMdAttachments = Map.Map KindMd ValMd+type GlobalMdAttachments = Map.Map KindMd ValMd data DebugLoc' lab = DebugLoc { dlLine :: Word32@@ -996,14 +1003,14 @@ , dibtSize :: Word64 , dibtAlign :: Word64 , dibtEncoding :: DwarfAttrEncoding- } deriving (Show)+ } deriving (Show,Generic) data DICompileUnit' lab = DICompileUnit { dicuLanguage :: DwarfLang , dicuFile :: Maybe (ValMd' lab) , dicuProducer :: Maybe String , dicuIsOptimized :: Bool- , dicuFlags :: DIFlags+ , dicuFlags :: Maybe String , dicuRuntimeVersion :: Word16 , dicuSplitDebugFilename :: Maybe FilePath , dicuEmissionKind :: DIEmissionKind@@ -1061,12 +1068,12 @@ data DIExpression = DIExpression { dieElements :: [Word64] }- deriving (Show)+ deriving (Show,Generic) data DIFile = DIFile { difFilename :: FilePath , difDirectory :: FilePath- } deriving (Show)+ } deriving (Show,Generic) data DIGlobalVariable' lab = DIGlobalVariable { digvScope :: Maybe (ValMd' lab)@@ -1153,7 +1160,7 @@ { disrCount :: Int64 , disrLowerBound :: Int64 }- deriving (Show)+ deriving (Show,Generic) data DISubroutineType' lab = DISubroutineType { distFlags :: DIFlags
src/Text/LLVM/PP.hs view
@@ -18,6 +18,7 @@ import Text.LLVM.AST +import Control.Applicative ((<|>)) import Data.Char (isAscii,isPrint,ord,toUpper) import Data.List (intersperse) import qualified Data.Map as Map@@ -40,6 +41,8 @@ , cfgGEPImplicitType :: Bool -- ^ True when the type of the result of the GEP -- instruction is implied.++ , cfgUseDILocation :: Bool } withConfig :: Config -> (LLVM => a) -> a@@ -54,12 +57,15 @@ ppLLVM36 = withConfig Config { cfgLoadImplicitType = True , cfgGEPImplicitType = True+ , cfgUseDILocation = False } ppLLVM37 = withConfig Config { cfgLoadImplicitType = False , cfgGEPImplicitType = False+ , cfgUseDILocation = True } ppLLVM38 = withConfig Config { cfgLoadImplicitType = False , cfgGEPImplicitType = False+ , cfgUseDILocation = True } checkConfig :: LLVM => (Config -> Bool) -> Bool@@ -89,7 +95,7 @@ sep [ ppMetadata (text (nmName nm)) <+> char '=' , ppMetadata (braces (commas (map (ppMetadata . int) (nmValues nm)))) ] -ppUnnamedMd :: UnnamedMd -> Doc+ppUnnamedMd :: LLVM => UnnamedMd -> Doc ppUnnamedMd um = sep [ ppMetadata (int (umIndex um)) <+> char '=' , distinct <+> ppValMd (umValues um) ]@@ -100,7 +106,7 @@ -- Aliases --------------------------------------------------------------------- -ppGlobalAlias :: GlobalAlias -> Doc+ppGlobalAlias :: LLVM => GlobalAlias -> Doc ppGlobalAlias g = ppSymbol (aliasName g) <+> char '=' <+> body where val = aliasTarget g@@ -119,18 +125,22 @@ -- | Pretty print a single layout specification. ppLayoutSpec :: LayoutSpec -> Doc-ppLayoutSpec BigEndian = char 'E'-ppLayoutSpec LittleEndian = char 'e'-ppLayoutSpec (PointerSize sz abi pref) = "p:" <> ppLayoutBody sz abi pref-ppLayoutSpec (IntegerSize sz abi pref) = char 'i' <> ppLayoutBody sz abi pref-ppLayoutSpec (VectorSize sz abi pref) = char 'v' <> ppLayoutBody sz abi pref-ppLayoutSpec (FloatSize sz abi pref) = char 'f' <> ppLayoutBody sz abi pref-ppLayoutSpec (AggregateSize sz abi pref) = char 'a' <> ppLayoutBody sz abi pref-ppLayoutSpec (StackObjSize sz abi pref) = char 's' <> ppLayoutBody sz abi pref-ppLayoutSpec (NativeIntSize szs) =- char 'n' <> hcat (punctuate (char ':') (map int szs))-ppLayoutSpec (StackAlign a) = char 'S' <> int a-ppLayoutSpec (Mangling m) = char 'm' <> char ':' <> ppMangling m+ppLayoutSpec ls =+ case ls of+ BigEndian -> char 'E'+ LittleEndian -> char 'e'+ PointerSize 0 sz abi pref -> char 'p' <> char ':' <> ppLayoutBody sz abi pref+ PointerSize n sz abi pref -> char 'p' <> int n <> char ':'+ <> ppLayoutBody sz abi pref+ IntegerSize sz abi pref -> char 'i' <> ppLayoutBody sz abi pref+ VectorSize sz abi pref -> char 'v' <> ppLayoutBody sz abi pref+ FloatSize sz abi pref -> char 'f' <> ppLayoutBody sz abi pref+ StackObjSize sz abi pref -> char 's' <> ppLayoutBody sz abi pref+ AggregateSize sz abi pref -> char 'a' <> ppLayoutBody sz abi pref+ NativeIntSize szs ->+ char 'n' <> hcat (punctuate (char ':') (map int szs))+ StackAlign a -> char 'S' <> int a+ Mangling m -> char 'm' <> char ':' <> ppMangling m -- | Pretty-print the common case for data layout specifications. ppLayoutBody :: Int -> Int -> Maybe Int -> Doc@@ -204,11 +214,12 @@ -- Declarations ---------------------------------------------------------------- -ppGlobal :: Global -> Doc+ppGlobal :: LLVM => Global -> Doc ppGlobal g = ppSymbol (globalSym g) <+> char '=' <+> ppGlobalAttrs (globalAttrs g) <+> ppType (globalType g) <+> ppMaybe ppValue (globalValue g) <> ppAlign (globalAlign g)+ <> ppAttachedMetadata (Map.toList (globalMetadata g)) ppGlobalAttrs :: GlobalAttrs -> Doc ppGlobalAttrs ga = ppMaybe ppLinkage (gaLinkage ga) <+> constant@@ -302,7 +313,7 @@ <> ppAttachedMetadata mds Effect i mds -> ppInstr i <> ppAttachedMetadata mds -ppAttachedMetadata :: [(String,ValMd)] -> Doc+ppAttachedMetadata :: LLVM => [(String,ValMd)] -> Doc ppAttachedMetadata mds | null mds = empty | otherwise = comma <+> commas (map step mds)@@ -466,13 +477,13 @@ PtrTo ty -> ppType ty <> comma ty -> ppType ty <> comma -ppClauses :: Bool -> [Clause] -> Doc+ppClauses :: LLVM => Bool -> [Clause] -> Doc ppClauses isCleanup cs = vcat (cleanup : map ppClause cs) where cleanup | isCleanup = "cleanup" | otherwise = empty -ppClause :: Clause -> Doc+ppClause :: LLVM => Clause -> Doc ppClause c = case c of Catch tv -> "catch" <+> ppTyped ppValue tv Filter tv -> "filter" <+> ppTyped ppValue tv@@ -484,14 +495,14 @@ ppSwitchEntry :: Type -> (Integer,BlockLabel) -> Doc ppSwitchEntry ty (i,l) = ppType ty <+> integer i <> comma <+> ppTypedLabel l -ppVectorIndex :: Value -> Doc+ppVectorIndex :: LLVM => Value -> Doc ppVectorIndex i = ppType (PrimType (Integer 32)) <+> ppValue i ppAlign :: Maybe Align -> Doc ppAlign Nothing = empty ppAlign (Just align) = comma <+> "align" <+> int align -ppAlloca :: Type -> Maybe (Typed Value) -> Maybe Int -> Doc+ppAlloca :: LLVM => Type -> Maybe (Typed Value) -> Maybe Int -> Doc ppAlloca ty mbLen mbAlign = "alloca" <+> ppType ty <> len <> align where len = fromMaybe empty $ do@@ -501,7 +512,7 @@ a <- mbAlign return (comma <+> "align" <+> int a) -ppCall :: Bool -> Type -> Value -> [Typed Value] -> Doc+ppCall :: LLVM => Bool -> Type -> Value -> [Typed Value] -> Doc ppCall tc ty f args | tc = "tail" <+> body | otherwise = body@@ -509,9 +520,9 @@ body = "call" <+> ppCallSym ty f <> parens (commas (map (ppTyped ppValue) args)) -ppCallSym :: Type -> Value -> Doc-ppCallSym (PtrTo (FunTy res _ _)) (ValSymbol sym) = ppType res <+> ppSymbol sym-ppCallSym ty val = ppType ty <+> ppValue val+ppCallSym :: LLVM => Type -> Value -> Doc+ppCallSym (PtrTo (FunTy res args va)) val = ppType res <+> ppArgList va (map ppType args) <+> ppValue val+ppCallSym ty val = ppType ty <+> ppValue val ppGEP :: LLVM => Bool -> Typed Value -> [Typed Value] -> Doc ppGEP ib ptr ixs = "getelementptr" <+> inbounds@@ -528,7 +539,7 @@ inbounds | ib = "inbounds" | otherwise = empty -ppInvoke :: Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc+ppInvoke :: LLVM => Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc ppInvoke ty f args to uw = body where body = "invoke" <+> ppType ty <+> ppValue f@@ -536,7 +547,7 @@ <+> "to" <+> ppType (PrimType Label) <+> ppLabel to <+> "unwind" <+> ppType (PrimType Label) <+> ppLabel uw -ppPhiArg :: (Value,BlockLabel) -> Doc+ppPhiArg :: LLVM => (Value,BlockLabel) -> Doc ppPhiArg (v,l) = char '[' <+> ppValue v <> comma <+> ppLabel l <+> char ']' ppICmpOp :: ICmpOp -> Doc@@ -569,7 +580,7 @@ ppFCmpOp Funo = "uno" ppFCmpOp Ftrue = "true" -ppValue :: Value -> Doc+ppValue :: LLVM => Value -> Doc ppValue val = case val of ValInteger i -> integer i ValBool b -> ppBool b@@ -593,7 +604,7 @@ ValAsm s a i c -> ppAsm s a i c ValMd m -> ppValMd m -ppValMd :: ValMd -> Doc+ppValMd :: LLVM => ValMd -> Doc ppValMd m = case m of ValMdString str -> ppMetadata (ppStringLiteral str) ValMdValue tv -> ppTyped ppValue tv@@ -602,8 +613,9 @@ ValMdLoc l -> ppDebugLoc l ValMdDebugInfo di -> ppDebugInfo di -ppDebugLoc :: DebugLoc -> Doc-ppDebugLoc dl = "!MDLocation"+ppDebugLoc :: LLVM => DebugLoc -> Doc+ppDebugLoc dl = (if cfgUseDILocation ?config then "!DILocation"+ else "!MDLocation") <> parens (commas [ "line:" <+> integral (dlLine dl) , "column:" <+> integral (dlCol dl) , "scope:" <+> ppValMd (dlScope dl)@@ -614,13 +626,13 @@ Just md -> comma <+> "inlinedAt:" <+> ppValMd md Nothing -> empty -ppTypedValMd :: ValMd -> Doc+ppTypedValMd :: LLVM => ValMd -> Doc ppTypedValMd = ppTyped ppValMd . Typed (PrimType Metadata) ppMetadata :: Doc -> Doc ppMetadata body = char '!' <> body -ppMetadataNode :: [Maybe ValMd] -> Doc+ppMetadataNode :: LLVM => [Maybe ValMd] -> Doc ppMetadataNode vs = ppMetadata (braces (commas (map arg vs))) where arg = maybe ("null") ppValMd@@ -628,7 +640,8 @@ ppStringLiteral :: String -> Doc ppStringLiteral = doubleQuotes . text . concatMap escape where- escape c | isAscii c && isPrint c = [c]+ escape c | c == '"' || c == '\\' = '\\' : showHex (fromEnum c) ""+ | isAscii c && isPrint c = [c] | otherwise = '\\' : pad (ord c) pad n | n < 0x10 = '0' : map toUpper (showHex n "")@@ -646,7 +659,7 @@ | otherwise = empty -ppConstExpr :: ConstExpr -> Doc+ppConstExpr :: LLVM => ConstExpr -> Doc ppConstExpr (ConstGEP inb mp ixs) = "getelementptr" <+> opt inb "inbounds" <+> parens (mcommas ((ppType <$> mp) : (map (pure . ppTyped ppValue) ixs)))@@ -670,7 +683,7 @@ -- DWARF Debug Info ------------------------------------------------------------ -ppDebugInfo :: DebugInfo -> Doc+ppDebugInfo :: LLVM => DebugInfo -> Doc ppDebugInfo di = case di of DebugInfoBasicType bt -> ppDIBasicType bt DebugInfoCompileUnit cu -> ppDICompileUnit cu@@ -697,7 +710,7 @@ , "encoding:" <+> integral (dibtEncoding bt) ]) -ppDICompileUnit :: DICompileUnit -> Doc+ppDICompileUnit :: LLVM => DICompileUnit -> Doc ppDICompileUnit cu = "!DICompileUnit" <> parens (mcommas [ pure ("language:" <+> integral (dicuLanguage cu))@@ -705,7 +718,7 @@ , (("producer:" <+>) . doubleQuotes . text) <$> (dicuProducer cu) , pure ("isOptimized:" <+> ppBool (dicuIsOptimized cu))- , pure ("flags:" <+> integral (dicuFlags cu))+ , pure ("flags:" <+> ppFlags (dicuFlags cu)) , pure ("runtimeVersion:" <+> integral (dicuRuntimeVersion cu)) , (("splitDebugFilename:" <+>) . doubleQuotes . text) <$> (dicuSplitDebugFilename cu)@@ -719,7 +732,10 @@ , pure ("dwoId:" <+> integral (dicuDWOId cu)) ]) -ppDICompositeType :: DICompositeType -> Doc+ppFlags :: Maybe String -> Doc+ppFlags mb = doubleQuotes (maybe empty text mb)++ppDICompositeType :: LLVM => DICompositeType -> Doc ppDICompositeType ct = "!DICompositeType" <> parens (mcommas [ pure ("tag:" <+> integral (dictTag ct))@@ -739,14 +755,14 @@ <$> (dictIdentifier ct) ]) -ppDIDerivedType :: DIDerivedType -> Doc+ppDIDerivedType :: LLVM => DIDerivedType -> Doc ppDIDerivedType dt = "!DIDerivedType" <> parens (mcommas [ pure ("tag:" <+> integral (didtTag dt)) , (("name:" <+>) . doubleQuotes . text) <$> (didtName dt) , (("file:" <+>) . ppValMd) <$> (didtFile dt) , pure ("line:" <+> integral (didtLine dt))- , (("baseType:" <+>) . ppValMd) <$> (didtBaseType dt)+ , ("baseType:" <+>) <$> (ppValMd <$> didtBaseType dt <|> Just "null") , pure ("size:" <+> integral (didtSize dt)) , pure ("align:" <+> integral (didtAlign dt)) , pure ("offset:" <+> integral (didtOffset dt))@@ -770,7 +786,7 @@ , "directory:" <+> doubleQuotes (text (difDirectory f)) ]) -ppDIGlobalVariable :: DIGlobalVariable -> Doc+ppDIGlobalVariable :: LLVM => DIGlobalVariable -> Doc ppDIGlobalVariable gv = "!DIGlobalVariable" <> parens (mcommas [ (("scope:" <+>) . ppValMd) <$> (digvScope gv)@@ -782,19 +798,19 @@ , (("type:" <+>) . ppValMd) <$> (digvType gv) , pure ("isLocal:" <+> ppBool (digvIsLocal gv)) , pure ("isDefinition:" <+> ppBool (digvIsDefinition gv))- , (("variable:" <+>) . ppValMd) <$> (digvType gv)+ , (("variable:" <+>) . ppValMd) <$> (digvVariable gv) , (("declaration:" <+>) . ppValMd) <$> (digvDeclaration gv) , (("align:" <+>) . integral) <$> digvAlignment gv ]) -ppDIGlobalVariableExpression :: DIGlobalVariableExpression -> Doc+ppDIGlobalVariableExpression :: LLVM => DIGlobalVariableExpression -> Doc ppDIGlobalVariableExpression gve = "!DIGlobalVariableExpression" <> parens (mcommas [ (("var:" <+>) . ppValMd) <$> (digveVariable gve) , (("expr:" <+>) . ppValMd) <$> (digveExpression gve) ]) -ppDILexicalBlock :: DILexicalBlock -> Doc+ppDILexicalBlock :: LLVM => DILexicalBlock -> Doc ppDILexicalBlock ct = "!DILexicalBlock" <> parens (mcommas [ (("scope:" <+>) . ppValMd) <$> (dilbScope ct)@@ -803,7 +819,7 @@ , pure ("column:" <+> integral (dilbColumn ct)) ]) -ppDILexicalBlockFile :: DILexicalBlockFile -> Doc+ppDILexicalBlockFile :: LLVM => DILexicalBlockFile -> Doc ppDILexicalBlockFile lbf = "!DILexicalBlockFile" <> parens (mcommas [ pure ("scope:" <+> ppValMd (dilbfScope lbf))@@ -811,7 +827,7 @@ , pure ("discriminator:" <+> integral (dilbfDiscriminator lbf)) ]) -ppDILocalVariable :: DILocalVariable -> Doc+ppDILocalVariable :: LLVM => DILocalVariable -> Doc ppDILocalVariable lv = "!DILocalVariable" <> parens (mcommas [ (("scope:" <+>) . ppValMd) <$> (dilvScope lv)@@ -823,7 +839,7 @@ , pure ("flags:" <+> integral (dilvFlags lv)) ]) -ppDISubprogram :: DISubprogram -> Doc+ppDISubprogram :: LLVM => DISubprogram -> Doc ppDISubprogram sp = "!DISubprogram" <> parens (mcommas [ (("scope:" <+>) . ppValMd) <$> (dispScope sp)@@ -852,7 +868,7 @@ , "lowerBound:" <+> integral (disrLowerBound sr) ]) -ppDISubroutineType :: DISubroutineType -> Doc+ppDISubroutineType :: LLVM => DISubroutineType -> Doc ppDISubroutineType st = "!DISubroutineType" <> parens (commas [ "flags:" <+> integral (distFlags st)