llvm-general-pure 3.4.5.4 → 3.5.0.0

raw patch · 19 files changed

+393/−176 lines, 19 filesdep −transformers-compatdep ~basedep ~llvm-general-puredep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies removed: transformers-compat

Dependency ranges changed: base, llvm-general-pure, mtl, transformers

API changes (from Hackage documentation)

Files

• changelog +0/−5
• llvm-general-pure.cabal +13/−17
• 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/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

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

@@ -1,5 +1,5 @@ name: llvm-general-pure-version: 3.4.5.4+version: 3.5.0.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -14,26 +14,17 @@   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   location: git://github.com/bscarlet/llvm-general.git -source-repository this-  type: git-  location: git://github.com/bscarlet/llvm-general.git-  branch: llvm-3.4-  tag: pure-v3.4.5.4- 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,+    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 +44,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 +58,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@@ -78,15 +74,15 @@ test-suite test   type: exitcode-stdio-1.0   build-depends:  -    base >= 3 && < 5,+    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.0.0,     containers >= 0.4.2.1,-    mtl >= 2.1.3+    mtl >= 2.2.1   hs-source-dirs: test   extensions:     TupleSections

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

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

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

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

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

@@ -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  } 

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

@@ -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 = []   }

@@ -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 { 

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

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

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

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

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

@@ -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")  ] 

@@ -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"     )    ]  ]

@@ -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\