packages feed

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 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)