llvm-general-pure 3.4.5.4 → 3.5.1.0
raw patch · 20 files changed
Files
- changelog +0/−5
- llvm-general-pure.cabal +18/−14
- src/LLVM/General/AST.hs +4/−0
- src/LLVM/General/AST/Attribute.hs +15/−36
- src/LLVM/General/AST/COMDAT.hs +13/−0
- src/LLVM/General/AST/CallingConvention.hs +25/−1
- src/LLVM/General/AST/Constant.hs +4/−0
- src/LLVM/General/AST/DLL.hs +10/−0
- src/LLVM/General/AST/DataLayout.hs +32/−8
- src/LLVM/General/AST/FunctionAttribute.hs +44/−0
- src/LLVM/General/AST/Global.hs +21/−3
- src/LLVM/General/AST/Instruction.hs +22/−13
- src/LLVM/General/AST/Linkage.hs +0/−4
- src/LLVM/General/AST/ParameterAttribute.hs +23/−0
- src/LLVM/General/AST/ThreadLocalStorage.hs +12/−0
- src/LLVM/General/DataLayout.hs +78/−31
- src/LLVM/General/Internal/PrettyPrint.hs +1/−0
- src/LLVM/General/PrettyPrint.hs +14/−2
- test/LLVM/General/Test/DataLayout.hs +36/−35
- test/LLVM/General/Test/PrettyPrint.hs +30/−21
− changelog
@@ -1,5 +0,0 @@--*-change-log-*---3.4.5.3 Benjamin S. Scarlet <fgthb0@greynode.net> 2015-04-11- * Clean up warnings with ghc-7.10- * Start changelog
llvm-general-pure.cabal view
@@ -1,10 +1,12 @@ name: llvm-general-pure-version: 3.4.5.4+version: 3.5.1.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net> maintainer: Benjamin S. Scarlet <fgthb0@greynode.net> copyright: (c) 2013 Benjamin S. Scarlet and Google Inc.+homepage: http://github.com/bscarlet/llvm-general/+bug-reports: http://github.com/bscarlet/llvm-general/issues build-type: Simple stability: experimental cabal-version: >= 1.8@@ -14,8 +16,6 @@ llvm-general-pure is a set of pure Haskell types and functions for interacting with LLVM <http://llvm.org/>. It includes an ADT to represent LLVM IR (<http://llvm.org/docs/LangRef.html>). The llvm-general package builds on this one with FFI bindings to LLVM, but llvm-general-pure does not require LLVM to be available.-extra-source-files:- changelog source-repository head type: git@@ -24,16 +24,15 @@ source-repository this type: git location: git://github.com/bscarlet/llvm-general.git- branch: llvm-3.4- tag: pure-v3.4.5.4+ branch: llvm-3.5+ tag: pure-v3.5.1.0 library ghc-options: -fwarn-unused-imports- build-depends: - base >= 4.5.0.0 && < 5,- transformers >= 0.3.0.0,- transformers-compat,- mtl >= 2.1.3,+ build-depends:+ base >= 4.6 && < 5,+ transformers >= 0.4.0.0,+ mtl >= 2.2.1, template-haskell >= 2.5.0.0, containers >= 0.4.2.1, setenv >= 0.1.0,@@ -53,6 +52,8 @@ LLVM.General.AST.AddrSpace LLVM.General.AST.InlineAssembly LLVM.General.AST.Attribute+ LLVM.General.AST.ParameterAttribute+ LLVM.General.AST.FunctionAttribute LLVM.General.AST.CallingConvention LLVM.General.AST.Constant LLVM.General.AST.DataLayout@@ -65,8 +66,11 @@ LLVM.General.AST.Name LLVM.General.AST.Operand LLVM.General.AST.RMWOperation+ LLVM.General.AST.ThreadLocalStorage LLVM.General.AST.Type LLVM.General.AST.Visibility+ LLVM.General.AST.DLL+ LLVM.General.AST.COMDAT LLVM.General.DataLayout LLVM.General.PrettyPrint LLVM.General.Prelude@@ -77,16 +81,16 @@ test-suite test type: exitcode-stdio-1.0- build-depends: - base >= 3 && < 5,+ build-depends:+ base >= 4.6 && < 5, test-framework >= 0.5, test-framework-hunit >= 0.2.7, HUnit >= 1.2.4.2, test-framework-quickcheck2 >= 0.3.0.1, QuickCheck >= 2.5.1.1,- llvm-general-pure == 3.4.5.4,+ llvm-general-pure == 3.5.1.0, containers >= 0.4.2.1,- mtl >= 2.1.3+ mtl >= 2.2.1 hs-source-dirs: test extensions: TupleSections
src/LLVM/General/AST.hs view
@@ -24,6 +24,8 @@ import LLVM.General.AST.Operand import LLVM.General.AST.Instruction import LLVM.General.AST.DataLayout+import qualified LLVM.General.AST.Attribute as A+import qualified LLVM.General.AST.COMDAT as COMDAT -- | Any thing which can be at the top level of a 'Module' data Definition @@ -32,6 +34,8 @@ | MetadataNodeDefinition MetadataNodeID [Maybe Operand] | NamedMetadataDefinition String [MetadataNodeID] | ModuleInlineAssembly String+ | FunctionAttributes A.GroupID [A.FunctionAttribute]+ | COMDAT String COMDAT.SelectionKind deriving (Eq, Read, Show, Typeable, Data) -- | <http://llvm.org/docs/LangRef.html#modulestructure>
src/LLVM/General/AST/Attribute.hs view
@@ -1,38 +1,17 @@ -- | Module to allow importing 'Attribute' distinctly qualified.-module LLVM.General.AST.Attribute where--import LLVM.General.Prelude---- | <http://llvm.org/docs/LangRef.html#parameter-attributes>-data ParameterAttribute- = ZeroExt- | SignExt- | InReg- | SRet- | Alignment Word32- | NoAlias- | ByVal- | NoCapture- | Nest- deriving (Eq, Read, Show, Typeable, Data)+-- Before LLVM 3.5, the attributes which could be used on functions+-- and those which could be used on parameters were disjoint. In+-- LLVM 3.5, two attributes (readonly and readnone) can be used+-- in both contexts. Because their interpretation is different in+-- the two contexts and only those two attributes can be used in+-- both contexts, I've opted to keep the Haskell types for parameter+-- and function attributes distinct, but move the two types into+-- separate modules so they can have contructors with the same names.+module LLVM.General.AST.Attribute (+ ParameterAttribute(..),+ FunctionAttribute(..),+ GroupID(..)+ ) where --- | <http://llvm.org/docs/LangRef.html#function-attributes>-data FunctionAttribute- = NoReturn- | NoUnwind- | ReadNone- | ReadOnly- | NoInline- | AlwaysInline- | OptimizeForSize- | StackProtect- | StackProtectReq- | NoRedZone- | NoImplicitFloat- | Naked- | InlineHint- | StackAlignment Word32- | ReturnsTwice- | UWTable- | NonLazyBind- deriving (Eq, Read, Show, Typeable, Data)+import LLVM.General.AST.ParameterAttribute hiding (ReadNone, ReadOnly)+import LLVM.General.AST.FunctionAttribute
+ src/LLVM/General/AST/COMDAT.hs view
@@ -0,0 +1,13 @@+-- | Module to allow importing 'COMDAT.SelectionKind' distinctly qualified.+module LLVM.General.AST.COMDAT where++import LLVM.General.Prelude++-- | <http://llvm.org/docs/LangRef.html#comdats>+data SelectionKind+ = Any+ | ExactMatch+ | Largest+ | NoDuplicates+ | SameSize+ deriving (Eq, Read, Show, Typeable, Data)
src/LLVM/General/AST/CallingConvention.hs view
@@ -4,6 +4,30 @@ import LLVM.General.Prelude -- | <http://llvm.org/docs/LangRef.html#callingconv>-data CallingConvention = C | Fast | Cold | GHC | Numbered Word32+data CallingConvention+ = C+ | Fast+ | Cold+ | GHC+ | HiPE+ | WebKit_JS+ | AnyReg+ | PreserveMost+ | PreserveAll+ | X86_StdCall+ | X86_FastCall+ | ARM_APCS+ | ARM_AAPCS+ | ARM_AAPCS_VFP+ | MSP430_INTR+ | X86_ThisCall+ | PTX_Kernel+ | PTX_Device+ | SPIR_FUNC+ | SPIR_KERNEL+ | Intel_OCL_BI+ | X86_64_SysV+ | X86_64_Win64+ | Numbered Word32 deriving (Eq, Read, Show, Typeable, Data)
src/LLVM/General/AST/Constant.hs view
@@ -168,6 +168,10 @@ operand0 :: Constant, type' :: Type }+ | AddrSpaceCast {+ operand0 :: Constant,+ type' :: Type+ } | ICmp { iPredicate :: IntegerPredicate, operand0 :: Constant,
+ src/LLVM/General/AST/DLL.hs view
@@ -0,0 +1,10 @@+-- | Module to allow importing 'DLL.StorageClass' distinctly qualified.+module LLVM.General.AST.DLL where++import LLVM.General.Prelude++-- | <http://llvm.org/docs/LangRef.html#dll-storage-classes>+data StorageClass+ = Import+ | Export+ deriving (Eq, Read, Show, Typeable, Data)
src/LLVM/General/AST/DataLayout.hs view
@@ -25,27 +25,51 @@ = IntegerAlign | VectorAlign | FloatAlign- | AggregateAlign- | StackAlign deriving (Eq, Ord, Read, Show, Typeable, Data) +-- | A style of name mangling+data Mangling+ = ELFMangling+ | MIPSMangling+ | MachOMangling+ | WindowsCOFFMangling+ deriving (Eq, Ord, Read, Show, Typeable, Data)+ -- | a description of the various data layout properties which may be used during -- optimization data DataLayout = DataLayout {- endianness :: Maybe Endianness,+ endianness :: Endianness,+ mangling :: Maybe Mangling, stackAlignment :: Maybe Word32, pointerLayouts :: Map AddrSpace (Word32, AlignmentInfo), typeLayouts :: Map (AlignType, Word32) AlignmentInfo,+ aggregateLayout :: AlignmentInfo, nativeSizes :: Maybe (Set Word32) } deriving (Eq, Ord, Read, Show, Typeable, Data) --- | a 'DataLayout' which specifies nothing-defaultDataLayout = DataLayout {- endianness = Nothing,+-- | a default 'DataLayout'+defaultDataLayout endianness = DataLayout {+ endianness = endianness,+ mangling = Nothing, stackAlignment = Nothing,- pointerLayouts = Map.empty,- typeLayouts = Map.empty,+ pointerLayouts = Map.fromList [+ (AddrSpace 0, (64, AlignmentInfo 64 (Just 64)))+ ],+ typeLayouts = Map.fromList [+ ((IntegerAlign, 1), AlignmentInfo 8 (Just 8)),+ ((IntegerAlign, 8), AlignmentInfo 8 (Just 8)),+ ((IntegerAlign, 16), AlignmentInfo 16 (Just 16)),+ ((IntegerAlign, 32), AlignmentInfo 32 (Just 32)),+ ((IntegerAlign, 64), AlignmentInfo 32 (Just 64)),+ ((FloatAlign, 16), AlignmentInfo 16 (Just 16)),+ ((FloatAlign, 32), AlignmentInfo 32 (Just 32)),+ ((FloatAlign, 64), AlignmentInfo 64 (Just 64)),+ ((FloatAlign, 128), AlignmentInfo 128 (Just 128)),+ ((VectorAlign, 64), AlignmentInfo 64 (Just 64)),+ ((VectorAlign, 128), AlignmentInfo 128 (Just 128))+ ],+ aggregateLayout = AlignmentInfo 0 (Just 64), nativeSizes = Nothing }
+ src/LLVM/General/AST/FunctionAttribute.hs view
@@ -0,0 +1,44 @@+-- | Module to allow importing 'FunctionAttribute' distinctly qualified.+module LLVM.General.AST.FunctionAttribute where++import LLVM.General.Prelude++-- | <http://llvm.org/docs/LangRef.html#function-attributes>+data FunctionAttribute+ = NoReturn+ | NoUnwind+ | ReadNone+ | ReadOnly+ | NoInline+ | AlwaysInline+ | MinimizeSize+ | OptimizeForSize+ | OptimizeNone+ | StackProtect+ | StackProtectReq+ | StackProtectStrong+ | NoRedZone+ | NoImplicitFloat+ | Naked+ | InlineHint+ | StackAlignment Word64+ | ReturnsTwice+ | UWTable+ | NonLazyBind+ | Builtin+ | NoBuiltin+ | Cold+ | JumpTable+ | NoDuplicate+ | SanitizeAddress+ | SanitizeThread+ | SanitizeMemory+ | StringAttribute {+ stringAttributeKind :: String,+ stringAttributeValue :: String -- ^ Use "" for no value -- the two are conflated+ } + deriving (Eq, Ord, Read, Show, Typeable, Data)++-- | <http://llvm.org/docs/LangRef.html#attribute-groups>+newtype GroupID = GroupID Word+ deriving (Eq, Ord, Read, Show, Typeable, Data)
src/LLVM/General/AST/Global.hs view
@@ -10,7 +10,9 @@ import LLVM.General.AST.Instruction (Named, Instruction, Terminator) import qualified LLVM.General.AST.Linkage as L import qualified LLVM.General.AST.Visibility as V+import qualified LLVM.General.AST.DLL as DLL import qualified LLVM.General.AST.CallingConvention as CC+import qualified LLVM.General.AST.ThreadLocalStorage as TLS import qualified LLVM.General.AST.Attribute as A -- | <http://llvm.org/doxygen/classllvm_1_1GlobalValue.html>@@ -20,13 +22,15 @@ name :: Name, linkage :: L.Linkage, visibility :: V.Visibility,- isThreadLocal :: Bool,+ dllStorageClass :: Maybe DLL.StorageClass,+ threadLocalMode :: Maybe TLS.Model, addrSpace :: AddrSpace, hasUnnamedAddr :: Bool, isConstant :: Bool, type' :: Type, initializer :: Maybe Constant, section :: Maybe String,+ comdat :: Maybe String, alignment :: Word32 } -- | <http://llvm.org/docs/LangRef.html#aliases>@@ -34,6 +38,9 @@ name :: Name, linkage :: L.Linkage, visibility :: V.Visibility,+ dllStorageClass :: Maybe DLL.StorageClass,+ threadLocalMode :: Maybe TLS.Model,+ hasUnnamedAddr :: Bool, type' :: Type, aliasee :: Constant }@@ -41,15 +48,18 @@ | Function { linkage :: L.Linkage, visibility :: V.Visibility,+ dllStorageClass :: Maybe DLL.StorageClass, callingConvention :: CC.CallingConvention, returnAttributes :: [A.ParameterAttribute], returnType :: Type, name :: Name, parameters :: ([Parameter],Bool), -- ^ snd indicates varargs- functionAttributes :: [A.FunctionAttribute],+ functionAttributes :: [Either A.GroupID A.FunctionAttribute], section :: Maybe String,+ comdat :: Maybe String, alignment :: Word32, garbageCollectorName :: Maybe String,+ prefix :: Maybe Constant, basicBlocks :: [BasicBlock] } deriving (Eq, Read, Show, Typeable, Data)@@ -71,13 +81,15 @@ name = error "global variable name not defined", linkage = L.External, visibility = V.Default,- isThreadLocal = False,+ dllStorageClass = Nothing,+ threadLocalMode = Nothing, addrSpace = AddrSpace 0, hasUnnamedAddr = False, isConstant = False, type' = error "global variable type not defined", initializer = Nothing, section = Nothing,+ comdat = Nothing, alignment = 0 } @@ -88,6 +100,9 @@ name = error "global alias name not defined", linkage = L.External, visibility = V.Default,+ dllStorageClass = Nothing,+ threadLocalMode = Nothing,+ hasUnnamedAddr = False, type' = error "global alias type not defined", aliasee = error "global alias aliasee not defined" }@@ -98,6 +113,7 @@ Function { linkage = L.External, visibility = V.Default,+ dllStorageClass = Nothing, callingConvention = CC.C, returnAttributes = [], returnType = error "function return type not defined",@@ -105,7 +121,9 @@ parameters = ([], False), functionAttributes = [], section = Nothing,+ comdat = Nothing, alignment = 0, garbageCollectorName = Nothing,+ prefix = Nothing, basicBlocks = [] }
src/LLVM/General/AST/Instruction.hs view
@@ -12,7 +12,8 @@ import LLVM.General.AST.FloatingPointPredicate (FloatingPointPredicate) import LLVM.General.AST.RMWOperation (RMWOperation) import LLVM.General.AST.CallingConvention (CallingConvention)-import LLVM.General.AST.Attribute (ParameterAttribute, FunctionAttribute)+import qualified LLVM.General.AST.ParameterAttribute as PA (ParameterAttribute)+import qualified LLVM.General.AST.FunctionAttribute as FA (FunctionAttribute, GroupID) -- | <http://llvm.org/docs/LangRef.html#metadata-nodes-and-metadata-strings> -- Metadata can be attached to an instruction@@ -47,10 +48,10 @@ } | Invoke { callingConvention' :: CallingConvention,- returnAttributes' :: [ParameterAttribute],+ returnAttributes' :: [PA.ParameterAttribute], function' :: CallableOperand,- arguments' :: [(Operand, [ParameterAttribute])],- functionAttributes' :: [FunctionAttribute],+ arguments' :: [(Operand, [PA.ParameterAttribute])],+ functionAttributes' :: [Either FA.GroupID FA.FunctionAttribute], returnDest :: Name, exceptionDest :: Name, metadata' :: InstructionMetadata@@ -87,12 +88,14 @@ | SequentiallyConsistent deriving (Eq, Ord, Read, Show, Data, Typeable) +-- | <http://llvm.org/docs/LangRef.html#singlethread>+data SynchronizationScope+ = SingleThread+ | CrossThread+ deriving (Eq, Ord, Read, Show, Data, Typeable)+ -- | An 'Atomicity' describes constraints on the visibility of effects of an atomic instruction-data Atomicity = Atomicity { - crossThread :: Bool, -- ^ <http://llvm.org/docs/LangRef.html#singlethread>- memoryOrdering :: MemoryOrdering- }- deriving (Eq, Ord, Read, Show, Typeable, Data)+type Atomicity = (SynchronizationScope, MemoryOrdering) -- | For the redoubtably complex 'LandingPad' instruction data LandingPadClause@@ -100,6 +103,11 @@ | Filter Constant deriving (Eq, Ord, Read, Show, Typeable, Data) +-- | For the call instruction+-- <http://llvm.org/docs/LangRef.html#call-instruction>+data TailCallKind = Tail | MustTail+ deriving (Eq, Ord, Read, Show, Typeable, Data)+ -- | non-terminator instructions: -- <http://llvm.org/docs/LangRef.html#binaryops> -- <http://llvm.org/docs/LangRef.html#bitwiseops>@@ -250,6 +258,7 @@ expected :: Operand, replacement :: Operand, atomicity :: Atomicity,+ failureMemoryOrdering :: MemoryOrdering, metadata :: InstructionMetadata } | AtomicRMW { @@ -343,12 +352,12 @@ metadata :: InstructionMetadata } | Call {- isTailCall :: Bool,+ tailCallKind :: Maybe TailCallKind, callingConvention :: CallingConvention,- returnAttributes :: [ParameterAttribute],+ returnAttributes :: [PA.ParameterAttribute], function :: CallableOperand,- arguments :: [(Operand, [ParameterAttribute])],- functionAttributes :: [FunctionAttribute],+ arguments :: [(Operand, [PA.ParameterAttribute])],+ functionAttributes :: [Either FA.GroupID FA.FunctionAttribute], metadata :: InstructionMetadata } | Select {
src/LLVM/General/AST/Linkage.hs view
@@ -6,8 +6,6 @@ -- | <http://llvm.org/docs/LangRef.html#linkage> data Linkage = Private- | LinkerPrivate- | LinkerPrivateWeak | Internal | AvailableExternally | LinkOnce@@ -18,6 +16,4 @@ | LinkOnceODR | WeakODR | External- | DLLImport- | DLLExport deriving (Eq, Read, Show, Typeable, Data)
+ src/LLVM/General/AST/ParameterAttribute.hs view
@@ -0,0 +1,23 @@+-- | Module to allow importing 'ParameterAttribute' distinctly qualified.+module LLVM.General.AST.ParameterAttribute where++import LLVM.General.Prelude++-- | <http://llvm.org/docs/LangRef.html#parameter-attributes>+data ParameterAttribute+ = ZeroExt+ | SignExt+ | InReg+ | SRet+ | Alignment Word64+ | NoAlias+ | ByVal+ | NoCapture+ | Nest+ | ReadNone+ | ReadOnly+ | InAlloca+ | NonNull+ | Dereferenceable Word64+ | Returned+ deriving (Eq, Ord, Read, Show, Typeable, Data)
+ src/LLVM/General/AST/ThreadLocalStorage.hs view
@@ -0,0 +1,12 @@+-- | Module to allow importing 'ThreadLocalStorage.Model' distinctly qualified.+module LLVM.General.AST.ThreadLocalStorage where++import LLVM.General.Prelude++-- | <http://llvm.org/docs/LangRef.html#thread-local-storage-models>+data Model+ = GeneralDynamic+ | LocalDynamic+ | InitialExec+ | LocalExec+ deriving (Eq, Ord, Read, Show, Typeable, Data)
src/LLVM/General/DataLayout.hs view
@@ -5,6 +5,8 @@ import LLVM.General.Prelude +import Control.Monad.Trans.Except+ import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Set as Set@@ -16,51 +18,87 @@ dataLayoutToString :: DataLayout -> String dataLayoutToString dl = - let sTriple :: (Word32, AlignmentInfo) -> String- sTriple (s, ai) = show s ++ ":" ++ show (abiAlignment ai) ++ (maybe "" (\p -> ":" ++ show p) (preferredAlignment ai))+ let sAlignmentInfo :: AlignmentInfo -> String+ sAlignmentInfo (AlignmentInfo abi pref) = + show abi ++ case pref of+ Just pref | pref /= abi -> ":" ++ show pref+ _ -> ""+ sTriple :: (Word32, AlignmentInfo) -> String+ sTriple (s, ai) = show s ++ ":" ++ sAlignmentInfo ai atChar at = case at of- IntegerAlign -> "i"- VectorAlign -> "v"- FloatAlign -> "f"- AggregateAlign -> "a"- StackAlign -> "s"+ IntegerAlign -> "i"+ VectorAlign -> "v"+ FloatAlign -> "f"+ manglingChar m = case m of+ ELFMangling -> "e"+ MIPSMangling -> "m"+ MachOMangling -> "o"+ WindowsCOFFMangling -> "w"+ oneOpt f accessor = maybe [] ((:[]) . f) (accessor dl)+ defDl = defaultDataLayout BigEndian+ nonDef :: Eq a => (DataLayout -> [a]) -> [a]+ nonDef f = (f dl) List.\\ (f defDl) in List.intercalate "-" (- (case endianness dl of Just BigEndian -> ["E"]; Just LittleEndian -> ["e"]; _ -> [])+ [case endianness dl of BigEndian -> "E"; LittleEndian -> "e"] ++- (maybe [] (\s -> ["S" ++ show s]) (stackAlignment dl))+ (oneOpt (("m:" ++) . manglingChar) mangling) ++- [ "p" ++ (if a == 0 then "" else show a) ++ ":" ++ sTriple t | (AddrSpace a, t) <- Map.toList . pointerLayouts $ dl]+ [+ "p" ++ (if a == 0 then "" else show a) ++ ":" ++ sTriple t + | (AddrSpace a, t) <- nonDef (Map.toList . pointerLayouts)+ ] ++ [+ atChar at ++ sTriple (s, ai)+ | ((at, s), ai) <- nonDef (Map.toList . typeLayouts)+ ] ++ [+ "a:" ++ sAlignmentInfo ai | ai <- nonDef (return . aggregateLayout)+ ] +++ (oneOpt (("n"++) . (List.intercalate ":") . (map show) . Set.toList) nativeSizes) ++- [ atChar at ++ sTriple (s, ai) | ((at, s), ai) <- Map.toList . typeLayouts $ dl ]- ++ - (maybe [] (\ns -> ["n" ++ (List.intercalate ":" (map show . Set.toList $ ns))]) (nativeSizes dl))+ (oneOpt (("S"++) . show) stackAlignment) ) -parseDataLayout :: String -> Maybe DataLayout-parseDataLayout "" = Nothing-parseDataLayout s = +-- | Parse a 'DataLayout', given a default Endianness should one not be specified in the+-- string to be parsed. LLVM itself uses BigEndian as the default: thus pass BigEndian to+-- be conformant or LittleEndian to be righteously defiant.+parseDataLayout :: Endianness -> String -> Except String (Maybe DataLayout)+parseDataLayout _ "" = return Nothing+parseDataLayout defaultEndianness s = let num :: Parser Word32- num = read <$> many digit- triple :: Parser (Word32, AlignmentInfo)- triple = do- s <- num- char ':'+ num = read <$> many1 digit+ alignmentInfo :: Parser AlignmentInfo+ alignmentInfo = do abi <- num pref <- optionMaybe $ do char ':' num- return (s, (AlignmentInfo abi pref))+ return $ AlignmentInfo abi pref+ triple :: Parser (Word32, AlignmentInfo)+ triple = do+ s <- num+ char ':'+ ai <- alignmentInfo+ return (s, ai) parseSpec :: Parser (DataLayout -> DataLayout) parseSpec = choice [ do char 'e'- return $ \dl -> dl { endianness = Just LittleEndian },+ return $ \dl -> dl { endianness = LittleEndian }, do char 'E' - return $ \dl -> dl { endianness = Just BigEndian },+ return $ \dl -> dl { endianness = BigEndian }, do+ char 'm'+ char ':'+ m <- choice [+ char 'e' >> return ELFMangling,+ char 'm' >> return MIPSMangling,+ char 'o' >> return MachOMangling,+ char 'w' >> return WindowsCOFFMangling+ ]+ return $ \dl -> dl { mangling = Just m },+ do char 'S' n <- num return $ \dl -> dl { stackAlignment = Just n },@@ -71,15 +109,24 @@ t <- triple return $ \dl -> dl { pointerLayouts = Map.insert a t (pointerLayouts dl) }, do+ char 's' -- Ignore this obsolete approach to stack alignment. After the 3.4 release,+ -- this is never generated, still parsed but ignored. Comments suggest+ -- it will no longer be parsed after 4.0.+ triple+ return id,+ do at <- choice [ char 'i' >> return IntegerAlign, char 'v' >> return VectorAlign,- char 'f' >> return FloatAlign,- char 'a' >> return AggregateAlign,- char 's' >> return StackAlign+ char 'f' >> return FloatAlign ]- (sz,ai) <- triple- return $ \dl -> dl { typeLayouts = Map.insert (at,sz) ai (typeLayouts dl) },+ (sz, ai) <- triple+ return $ \dl -> dl { typeLayouts = Map.insert (at, sz) ai (typeLayouts dl) },+ do+ char 'a'+ char ':'+ ai <- alignmentInfo+ return $ \dl -> dl { aggregateLayout = ai }, do char 'n' ns <- num `sepBy` (char ':')@@ -87,7 +134,7 @@ ] in case parse (parseSpec `sepBy` (char '-')) "" s of- Left _ -> error $ "ill formed data layout: " ++ show s- Right fs -> Just $ foldr ($) defaultDataLayout fs+ Left _ -> throwE $ "ill formed data layout: " ++ show s+ Right fs -> return . Just $ foldr ($) (defaultDataLayout defaultEndianness) fs
src/LLVM/General/Internal/PrettyPrint.hs view
@@ -94,6 +94,7 @@ name <+> braces (punctuate comma [ n <+> "=" <+> v | (n,v) <- fields ]) ctor :: QTree -> [QTree] -> QTree+ctor name [] = name ctor name fields = do p <- asks precedence parensIfNeeded appPrec (foldl (<+>) name fields)
src/LLVM/General/PrettyPrint.hs view
@@ -31,10 +31,14 @@ import qualified LLVM.General.AST.Float as A import qualified LLVM.General.AST.FloatingPointPredicate as A import qualified LLVM.General.AST.IntegerPredicate as A-import qualified LLVM.General.AST.Attribute as A+import qualified LLVM.General.AST.FunctionAttribute as A+import qualified LLVM.General.AST.ParameterAttribute as A import qualified LLVM.General.AST.CallingConvention as A import qualified LLVM.General.AST.Visibility as A+import qualified LLVM.General.AST.DLL as A.DLL+import qualified LLVM.General.AST.COMDAT as A.COMDAT import qualified LLVM.General.AST.Linkage as A+import qualified LLVM.General.AST.ThreadLocalStorage as A.TLS import qualified LLVM.General.AST.InlineAssembly as A import qualified LLVM.General.AST.RMWOperation as A @@ -50,6 +54,7 @@ ''A.Global, ''A.AlignmentInfo, ''A.AlignType,+ ''A.Mangling, ''A.C.Constant, ''A.AddrSpace, ''A.Endianness,@@ -62,18 +67,23 @@ ''A.Parameter, ''A.CallingConvention, ''A.Visibility,+ ''A.DLL.StorageClass,+ ''A.COMDAT.SelectionKind, ''A.Linkage, ''A.SomeFloat, ''A.Named, ''A.Terminator,+ ''A.TailCallKind, ''A.Instruction, ''A.LandingPadClause, ''A.InlineAssembly, ''A.RMWOperation,- ''A.Atomicity, ''A.Dialect, ''A.FastMathFlags,+ ''A.SynchronizationScope, ''A.MemoryOrdering,+ ''A.GroupID,+ ''A.TLS.Model, ''Either, ''Maybe ]@@ -131,6 +141,8 @@ ("LLVM.General.AST.Global", Just "G"), ("LLVM.General.AST.CallingConvention", Just "CC"), ("LLVM.General.AST.Visibility", Just "V"),+ ("LLVM.General.AST.DLL", Just "DLL"),+ ("LLVM.General.AST.COMDAT", Just "COMDAT"), ("LLVM.General.AST.Linkage", Just "L") ]
test/LLVM/General/Test/DataLayout.hs view
@@ -4,6 +4,8 @@ import Test.Framework.Providers.HUnit import Test.HUnit +import Control.Monad.Except+ import Data.Maybe import qualified Data.Set as Set import qualified Data.Map as Map@@ -13,16 +15,19 @@ import LLVM.General.AST.AddrSpace import LLVM.General.DataLayout +ddl = defaultDataLayout LittleEndian+ tests = testGroup "DataLayout" [ testCase name $ do- (dataLayoutToString astDl, parseDataLayout strDl) @?= (strDl, Just astDl)+ let Right parsed = runExcept $ parseDataLayout LittleEndian strDl+ (dataLayoutToString astDl, parsed) @?= (strDl, Just astDl) | (name, astDl, strDl) <- [- ("little-endian", defaultDataLayout { endianness = Just LittleEndian }, "e"),- ("big-endian", defaultDataLayout { endianness = Just BigEndian }, "E"),- ("native", defaultDataLayout { nativeSizes = Just (Set.fromList [8,32]) }, "n8:32"),+ ("little-endian", ddl, "e"),+ ("big-endian", defaultDataLayout BigEndian, "E"),+ ("native", ddl { nativeSizes = Just (Set.fromList [8,32]) }, "e-n8:32"), ( "no pref",- defaultDataLayout {+ ddl { pointerLayouts = Map.singleton (AddrSpace 0) @@ -34,47 +39,43 @@ } ) },- "p:8:64"+ "e-p:8:64" ), (- "no pref",- defaultDataLayout {+ "pref",+ ddl { pointerLayouts = - Map.singleton- (AddrSpace 1) - (- 8,- AlignmentInfo {- abiAlignment = 32,- preferredAlignment = Just 64- }- )+ Map.insert (AddrSpace 1) (8, AlignmentInfo 32 (Just 64)) (pointerLayouts ddl) },- "p1:8:32:64"+ "e-p1:8:32:64" ), (+ "def",+ ddl { pointerLayouts = Map.singleton (AddrSpace 0) (64, AlignmentInfo 64 (Just 64)) },+ "e"+ ), ( "big",- DataLayout {- endianness = Just LittleEndian,+ ddl {+ endianness = LittleEndian,+ mangling = Just ELFMangling, stackAlignment = Just 128, pointerLayouts = Map.fromList [- (AddrSpace 0, (64, AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}))+ (AddrSpace 0, (8, AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 16})) ], typeLayouts = Map.fromList [- ((IntegerAlign, 1), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 8}),- ((IntegerAlign, 8), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 8}),- ((IntegerAlign, 16), AlignmentInfo {abiAlignment = 16, preferredAlignment = Just 16}),- ((IntegerAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 32}),- ((IntegerAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}),- ((VectorAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}),- ((VectorAlign, 128), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 128}),- ((FloatAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 32}),- ((FloatAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64}),- ((FloatAlign, 80), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 128}),- ((AggregateAlign, 0), AlignmentInfo {abiAlignment = 0, preferredAlignment = Just 64}),- ((StackAlign, 0), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 64})- ],+ ((IntegerAlign, 1), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 256}),+ ((IntegerAlign, 8), AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 256}),+ ((IntegerAlign, 16), AlignmentInfo {abiAlignment = 16, preferredAlignment = Just 256}),+ ((IntegerAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 256}),+ ((IntegerAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}),+ ((VectorAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}),+ ((VectorAlign, 128), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 256}),+ ((FloatAlign, 32), AlignmentInfo {abiAlignment = 32, preferredAlignment = Just 256}),+ ((FloatAlign, 64), AlignmentInfo {abiAlignment = 64, preferredAlignment = Just 256}),+ ((FloatAlign, 80), AlignmentInfo {abiAlignment = 128, preferredAlignment = Just 256})+ ] `Map.union` typeLayouts ddl, + aggregateLayout = AlignmentInfo {abiAlignment = 0, preferredAlignment = Just 256}, nativeSizes = Just (Set.fromList [8,16,32,64]) },- "e-S128-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-v64:64:64-v128:128:128-f32:32:32-f64:64:64-f80:128:128-a0:0:64-s0:64:64-n8:16:32:64"+ "e-m:e-p:8:8:16-i1:8:256-i8:8:256-i16:16:256-i32:32:256-i64:64:256-v64:64:256-v128:128:256-f32:32:256-f64:64:256-f80:128:256-a:0:256-n8:16:32:64-S128" ) ] ]
test/LLVM/General/Test/PrettyPrint.hs view
@@ -8,35 +8,39 @@ import LLVM.General.AST import LLVM.General.AST.Type+import LLVM.General.AST.Global import qualified LLVM.General.AST.Linkage as L import qualified LLVM.General.AST.Visibility as V+import qualified LLVM.General.AST.DLL as DLL import qualified LLVM.General.AST.CallingConvention as CC import qualified LLVM.General.AST.Constant as C tests = testGroup "PrettyPrint" [ testCase "basic" $ do let ast = Module "<string>" Nothing Nothing [- GlobalDefinition $ Function L.External V.Default CC.C [] i32 (Name "foo") ([- Parameter i32 (Name "x") []- ],False)- [] Nothing 0 Nothing- [- BasicBlock (UnName 0) [- UnName 1 := Mul {- nsw = True,- nuw = False,- operand0 = ConstantOperand (C.Int 32 1),- operand1 = ConstantOperand (C.Int 32 1),- metadata = []- }- ] (- Do $ Br (Name "here") []- ),- BasicBlock (Name "here") [- ] (- Do $ Ret (Just (LocalReference i32 (UnName 1))) []- )- ]+ GlobalDefinition $ functionDefaults {+ dllStorageClass = Just DLL.Export,+ returnType = i32,+ name = Name "foo",+ parameters = ([Parameter i32 (Name "x") []], False),+ basicBlocks = [+ BasicBlock (UnName 0) [+ UnName 1 := Mul {+ nsw = True,+ nuw = False,+ operand0 = ConstantOperand (C.Int 32 1),+ operand1 = ConstantOperand (C.Int 32 1),+ metadata = []+ }+ ] (+ Do $ Br (Name "here") []+ ),+ BasicBlock (Name "here") [+ ] (+ Do $ Ret (Just (LocalReference i32 (UnName 1))) []+ )+ ]+ } ] s = "A.Module {\n\ \ A.moduleName = \"<string>\",\n\@@ -46,6 +50,7 @@ \ A.GlobalDefinition A.G.Function {\n\ \ A.G.linkage = A.L.External,\n\ \ A.G.visibility = A.V.Default,\n\+ \ A.G.dllStorageClass = Just A.DLL.Export,\n\ \ A.G.callingConvention = A.CC.C,\n\ \ A.G.returnAttributes = [],\n\ \ A.G.returnType = A.IntegerType {A.typeBits = 32},\n\@@ -53,8 +58,10 @@ \ A.G.parameters = ([A.G.Parameter A.IntegerType { A.typeBits = 32 } (A.Name \"x\") []], False),\n\ \ A.G.functionAttributes = [],\n\ \ A.G.section = Nothing,\n\+ \ A.G.comdat = Nothing,\n\ \ A.G.alignment = 0,\n\ \ A.G.garbageCollectorName = Nothing,\n\+ \ A.G.prefix = Nothing,\n\ \ A.G.basicBlocks = [\n\ \ A.G.BasicBlock (A.UnName 0) [\n\ \ A.UnName 1 A.:= A.Mul {\n\@@ -85,8 +92,10 @@ \import qualified LLVM.General.AST as A\n\ \import qualified LLVM.General.AST.AddrSpace as A\n\ \import qualified LLVM.General.AST.Attribute as A.A\n\+ \import qualified LLVM.General.AST.COMDAT as A.COMDAT\n\ \import qualified LLVM.General.AST.CallingConvention as A.CC\n\ \import qualified LLVM.General.AST.Constant as A.C\n\+ \import qualified LLVM.General.AST.DLL as A.DLL\n\ \import qualified LLVM.General.AST.DataLayout as A\n\ \import qualified LLVM.General.AST.Float as A\n\ \import qualified LLVM.General.AST.FloatingPointPredicate as A.FPred\n\