llvm-hs-pure 4.0.0.0 → 4.1.0.0

raw patch · 27 files changed

+251/−153 lines, 27 filesdep +attoparsecdep +bytestringdep +tasty-quickcheckdep −parsecPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec, bytestring, tasty-quickcheck

Dependencies removed: parsec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−0
• llvm-hs-pure.cabal +8/−4
• src/LLVM/AST.hs +10/−9
• src/LLVM/AST/AddrSpace.hs +1/−1
• src/LLVM/AST/COMDAT.hs +1/−1
• src/LLVM/AST/CallingConvention.hs +1/−1
• src/LLVM/AST/Constant.hs +1/−1
• src/LLVM/AST/DLL.hs +1/−1
• src/LLVM/AST/DataLayout.hs +21/−21
• src/LLVM/AST/Float.hs +4/−6
• src/LLVM/AST/FloatingPointPredicate.hs +1/−1
• src/LLVM/AST/FunctionAttribute.hs +5/−5
• src/LLVM/AST/Global.hs +12/−10
• src/LLVM/AST/InlineAssembly.hs +4/−4
• src/LLVM/AST/Instruction.hs +9/−9
• src/LLVM/AST/IntegerPredicate.hs +1/−1
• src/LLVM/AST/Linkage.hs +1/−1
• src/LLVM/AST/Name.hs +14/−3
• src/LLVM/AST/Operand.hs +5/−5
• src/LLVM/AST/ParameterAttribute.hs +1/−1
• src/LLVM/AST/RMWOperation.hs +1/−1
• src/LLVM/AST/ThreadLocalStorage.hs +1/−1
• src/LLVM/AST/Type.hs +23/−22
• src/LLVM/AST/Visibility.hs +1/−1
• src/LLVM/DataLayout.hs +27/−22
• src/LLVM/Prelude.hs +11/−2
• test/LLVM/Test/DataLayout.hs +59/−19

@@ -0,0 +1,27 @@+## 4.1.0 (2017-05-17)++* Switch AST to `ByteString`/`ShortByteString` reflecting LLVM’s use+  of C-style strings.+* `preferredAlignment` is now a `Word32` instead of `Maybe Word32`. To+  recover the old behavior set it to the same value as abiAlignment.+* `GlobalAlias` now expects the element type of a pointer type instead+  of the pointer type itself. The address space is passed separately+  via the `addrSpace` field. This makes `GlobalAlias` consistent with+  `GlobalVariable`.+* The `FloatingPointType` constructor now takes a `FloatingPointType` argument+  instead of a width and a `FloatingPointFormat` to more closely match the+  LLVM IR language reference.+* The `IsString` instance of `Name` now throws an error on non-ASCII+  strings instead of silently discarding the upper bytes. There is+  also a new `mkName` function with the same behavior for easier+  discoverability. Non-ASCII names need to be encoded using an arbitrary encoding to+  to a `ShortByteString` which can then be used as a `Name`.++## 4.0.0 (initial release, changes in comparison to llvm-general)++* Move modules from `LLVM.General*` to `LLVM.*`+* Support for LLVM 4.0+* Improved support for LLVM’s exception handling instructions+* `-fshared-llvm` is now supported on windows (thanks to @RyanGLScott)+* Default to `-fshared-llvm`+* Expose `LLVM.Internal.*` modules.

@@ -1,5 +1,5 @@ name: llvm-hs-pure-version: 4.0.0.0+version: 4.1.0.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer <moritz.kiefer@purelyfunctional.org>, Benjamin S. Scarlet@@ -17,6 +17,7 @@   It includes an ADT to represent LLVM IR (<http://llvm.org/docs/LangRef.html>). The llvm-hs package   builds on this one with FFI bindings to LLVM, but llvm-hs-pure does not require LLVM to be available. tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2+extra-source-files: CHANGELOG.md  source-repository head   type: git@@ -28,7 +29,7 @@   default: False  library-  ghc-options: -Wall -fno-warn-name-shadowing+  ghc-options: -Wall   if flag(semigroups)     build-depends:       base >= 4.7 && < 4.9,@@ -37,17 +38,19 @@     build-depends:       base >= 4.9 && < 5   build-depends:+    attoparsec >= 0.13,+    bytestring >= 0.10 && < 0.11,     transformers >= 0.3 && < 0.6,     transformers-compat >= 0.4,     mtl >= 2.1,     template-haskell >= 2.5.0.0,-    containers >= 0.4.2.1,-    parsec >= 3.1.3+    containers >= 0.4.2.1   hs-source-dirs: src   extensions:     NoImplicitPrelude     TupleSections     DeriveDataTypeable+    DeriveGeneric     EmptyDataDecls     FlexibleContexts     FlexibleInstances@@ -93,6 +96,7 @@   build-depends:     tasty >= 0.11,     tasty-hunit >= 0.9,+    tasty-quickcheck >= 0.8,     llvm-hs-pure,     transformers >= 0.3,     transformers-compat >= 0.4,

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | This module and descendants define AST data types to represent LLVM code. -- Note that these types are designed for fidelity rather than convenience - if the truth -- of what LLVM supports is less than pretty, so be it.@@ -20,7 +21,7 @@ import LLVM.Prelude  import LLVM.AST.Name-import LLVM.AST.Type (Type(..), FloatingPointFormat(..))+import LLVM.AST.Type (Type(..), FloatingPointType(..)) import LLVM.AST.Global import LLVM.AST.Operand import LLVM.AST.Instruction@@ -33,23 +34,23 @@   = GlobalDefinition Global   | TypeDefinition Name (Maybe Type)   | MetadataNodeDefinition MetadataNodeID [Maybe Metadata]-  | NamedMetadataDefinition String [MetadataNodeID]-  | ModuleInlineAssembly String+  | NamedMetadataDefinition ShortByteString [MetadataNodeID]+  | ModuleInlineAssembly ByteString   | FunctionAttributes A.GroupID [A.FunctionAttribute]-  | COMDAT String COMDAT.SelectionKind-    deriving (Eq, Read, Show, Typeable, Data)+  | COMDAT ShortByteString COMDAT.SelectionKind+    deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/docs/LangRef.html#module-structure> data Module =   Module {-    moduleName :: String,-    moduleSourceFileName :: String,+    moduleName :: ShortByteString,+    moduleSourceFileName :: ShortByteString,     -- | a 'DataLayout', if specified, must match that of the eventual code generator     moduleDataLayout :: Maybe DataLayout,-    moduleTargetTriple :: Maybe String,+    moduleTargetTriple :: Maybe ShortByteString,     moduleDefinitions :: [Definition]   }-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | helper for making 'Module's defaultModule :: Module

@@ -5,4 +5,4 @@  -- | See <http://llvm.org/docs/LangRef.html#pointer-type> data AddrSpace = AddrSpace Word32-   deriving (Eq, Ord, Read, Show, Typeable, Data)+   deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)

@@ -10,4 +10,4 @@   | Largest   | NoDuplicates   | SameSize-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)

@@ -29,5 +29,5 @@   | X86_64_SysV   | X86_64_Win64   | Numbered Word32-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic) 

@@ -211,7 +211,7 @@         element :: Constant,         indices' :: [Word32]       }-    deriving (Eq, Ord, Read, Show, Typeable, Data)+    deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)   -- | Since LLVM types don't include signedness, there's ambiguity in interpreting

@@ -7,4 +7,4 @@ data StorageClass     = Import     | Export-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)

@@ -11,21 +11,21 @@  -- | Little Endian is the one true way :-). Sadly, we must support the infidels. data Endianness = LittleEndian | BigEndian-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | An AlignmentInfo describes how a given type must and would best be aligned data AlignmentInfo = AlignmentInfo {     abiAlignment :: Word32,-    preferredAlignment :: Maybe Word32+    preferredAlignment :: Word32   }-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | A type of type for which 'AlignmentInfo' may be specified data AlignType   = IntegerAlign   | VectorAlign   | FloatAlign-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | A style of name mangling data Mangling@@ -33,7 +33,7 @@   | MIPSMangling   | MachOMangling   | WindowsCOFFMangling-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | a description of the various data layout properties which may be used during -- optimization@@ -46,31 +46,31 @@     aggregateLayout :: AlignmentInfo,     nativeSizes :: Maybe (Set Word32)   }-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | a default 'DataLayout' defaultDataLayout :: Endianness -> DataLayout-defaultDataLayout endianness = DataLayout {-  endianness = endianness,+defaultDataLayout defaultEndianness = DataLayout {+  endianness = defaultEndianness,   mangling = Nothing,   stackAlignment = Nothing,   pointerLayouts = Map.fromList [-    (AddrSpace 0, (64, AlignmentInfo 64 (Just 64)))+    (AddrSpace 0, (64, AlignmentInfo 64 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))+    ((IntegerAlign, 1), AlignmentInfo 8 8),+    ((IntegerAlign, 8), AlignmentInfo 8 8),+    ((IntegerAlign, 16), AlignmentInfo 16 16),+    ((IntegerAlign, 32), AlignmentInfo 32 32),+    ((IntegerAlign, 64), AlignmentInfo 32 64),+    ((FloatAlign, 16), AlignmentInfo 16 16),+    ((FloatAlign, 32), AlignmentInfo 32 32),+    ((FloatAlign, 64), AlignmentInfo 64 64),+    ((FloatAlign, 128), AlignmentInfo 128 128),+    ((VectorAlign, 64), AlignmentInfo 64 64),+    ((VectorAlign, 128), AlignmentInfo 128 128)    ],-  aggregateLayout = AlignmentInfo 0 (Just 64),+  aggregateLayout = AlignmentInfo 0 64,   nativeSizes = Nothing  } 

@@ -2,19 +2,17 @@ -- numbers LLVM supports. It is most definitely intended to be imported qualified. module LLVM.AST.Float where -import Prelude as P-import Data.Data-import Data.Word (Word16, Word64)+import LLVM.Prelude  -- | A type summing up the various float types. -- N.B. Note that in the constructors with multiple fields, the lower significance bits are on the right -- - e.g. Quadruple highbits lowbits data SomeFloat-  = Half Word16 +  = Half Word16   | Single Float-  | Double P.Double+  | Double Double   | Quadruple Word64 Word64   | X86_FP80 Word16 Word64   | PPC_FP128 Word64 Word64-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) 

@@ -21,7 +21,7 @@   | ULE   | UNE   | True-  deriving (Eq, Ord, Read, Show, Data, Typeable)+  deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)   

@@ -35,18 +35,18 @@     | SanitizeThread     | SanitizeMemory     | StringAttribute {-        stringAttributeKind :: String,-        stringAttributeValue :: String -- ^ Use "" for no value -- the two are conflated+        stringAttributeKind :: ShortByteString,+        stringAttributeValue :: ShortByteString -- ^ Use "" for no value -- the two are conflated       }-    | AllocSize Word (Maybe Word)+    | AllocSize Word32 (Maybe Word32) -- ^ AllocSize 0 (Just 0) is invalid     | WriteOnly     | ArgMemOnly     | Convergent     | InaccessibleMemOnly     | InaccessibleMemOrArgMemOnly     | SafeStack-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/docs/LangRef.html#attribute-groups> newtype GroupID = GroupID Word-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)

@@ -24,13 +24,13 @@         visibility :: V.Visibility,         dllStorageClass :: Maybe DLL.StorageClass,         threadLocalMode :: Maybe TLS.Model,-        addrSpace :: AddrSpace,         unnamedAddr :: Maybe UnnamedAddr,         isConstant :: Bool,         type' :: Type,+        addrSpace :: AddrSpace,         initializer :: Maybe Constant,-        section :: Maybe String,-        comdat :: Maybe String,+        section :: Maybe ShortByteString,+        comdat :: Maybe ShortByteString,         alignment :: Word32       }     -- | <http://llvm.org/docs/LangRef.html#aliases>@@ -42,6 +42,7 @@         threadLocalMode :: Maybe TLS.Model,         unnamedAddr :: Maybe UnnamedAddr,         type' :: Type,+        addrSpace :: AddrSpace,         aliasee :: Constant       }     -- | <http://llvm.org/docs/LangRef.html#functions>@@ -55,28 +56,28 @@         name :: Name,         parameters :: ([Parameter],Bool), -- ^ snd indicates varargs         functionAttributes :: [Either A.GroupID A.FunctionAttribute],-        section :: Maybe String,-        comdat :: Maybe String,+        section :: Maybe ShortByteString,+        comdat :: Maybe ShortByteString,         alignment :: Word32,-        garbageCollectorName :: Maybe String,+        garbageCollectorName :: Maybe ShortByteString,         prefix :: Maybe Constant,         basicBlocks :: [BasicBlock],         personalityFunction :: Maybe Constant       }-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | 'Parameter's for 'Function's data Parameter = Parameter Type Name [A.ParameterAttribute]-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/doxygen/classllvm_1_1BasicBlock.html> -- LLVM code in a function is a sequence of 'BasicBlock's each with a label, -- some instructions, and a terminator. data BasicBlock = BasicBlock Name [Named Instruction] (Named Terminator)-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  data UnnamedAddr = LocalAddr | GlobalAddr-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | helper for making 'GlobalVariable's globalVariableDefaults :: Global@@ -108,6 +109,7 @@     threadLocalMode = Nothing,     unnamedAddr = Nothing,     type' = error "global alias type not defined",+    addrSpace = AddrSpace 0,     aliasee = error "global alias aliasee not defined"   } 

@@ -10,7 +10,7 @@ data Dialect   = ATTDialect   | IntelDialect-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/docs/LangRef.html#inline-assembler-expressions> -- to be used through 'LLVM.AST.Operand.CallableOperand' with a@@ -18,10 +18,10 @@ data InlineAssembly   = InlineAssembly {       type' :: Type,-      assembly :: String,-      constraints :: String,+      assembly :: ByteString,+      constraints :: ShortByteString,       hasSideEffects :: Bool,       alignStack :: Bool,       dialect :: Dialect     }-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)

@@ -19,7 +19,7 @@  -- | <http://llvm.org/docs/LangRef.html#metadata-nodes-and-metadata-strings> -- Metadata can be attached to an instruction-type InstructionMetadata = [(String, MetadataNode)]+type InstructionMetadata = [(ShortByteString, MetadataNode)]  -- | <http://llvm.org/docs/LangRef.html#terminators> data Terminator @@ -81,7 +81,7 @@       defaultUnwindDest :: Maybe Name,       metadata' :: InstructionMetadata     }-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/docs/LangRef.html#fast-math-flags> data FastMathFlags @@ -93,7 +93,7 @@       noSignedZeros :: Bool,       allowReciprocal :: Bool     }-  deriving (Eq, Ord, Read, Show, Data, Typeable)+  deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)  -- | <http://llvm.org/docs/LangRef.html#atomic-memory-ordering-constraints> -- <http://llvm.org/docs/Atomics.html>@@ -104,13 +104,13 @@   | Release   | AcquireRelease   | SequentiallyConsistent-  deriving (Eq, Ord, Read, Show, Data, Typeable)+  deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)  -- | <http://llvm.org/docs/LangRef.html#singlethread> data SynchronizationScope   = SingleThread   | CrossThread-  deriving (Eq, Ord, Read, Show, Data, Typeable)+  deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)  -- | An 'Atomicity' describes constraints on the visibility of effects of an atomic instruction type Atomicity = (SynchronizationScope, MemoryOrdering)@@ -119,12 +119,12 @@ data LandingPadClause     = Catch Constant     | Filter Constant-    deriving (Eq, Ord, Read, Show, Typeable, Data)+    deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | For the call instruction -- <http://llvm.org/docs/LangRef.html#call-instruction> data TailCallKind = Tail | MustTail-    deriving (Eq, Ord, Read, Show, Typeable, Data)+    deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | non-terminator instructions: -- <http://llvm.org/docs/LangRef.html#binaryops>@@ -434,11 +434,11 @@       metadata :: InstructionMetadata     } -  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)  -- | Instances of instructions may be given a name, allowing their results to be referenced as 'Operand's. -- Sometimes instructions - e.g. a call to a function returning void - don't need names. data Named a    = Name := a   | Do a-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)

@@ -15,7 +15,7 @@   | SGE   | SLT   | SLE-  deriving (Eq, Ord, Read, Show, Data, Typeable)+  deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)   

@@ -16,4 +16,4 @@     | LinkOnceODR     | WeakODR     | External-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)

@@ -2,6 +2,8 @@ module LLVM.AST.Name where  import LLVM.Prelude+import Data.Char+import Data.Monoid import Data.String  {- |@@ -26,10 +28,19 @@ which they are used. -} data Name-    = Name String -- ^ a string name+    = Name ShortByteString -- ^ a string name     | UnName Word -- ^ a number for a nameless thing-   deriving (Eq, Ord, Read, Show, Typeable, Data)+   deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) +-- | Using 'fromString` on non-ASCII strings will throw an error. instance IsString Name where-  fromString = Name+  fromString s+    | all isAscii s = Name (fromString s)+    | otherwise =+      error ("Only ASCII strings are automatically converted to LLVM names. "+          <> "Other strings need to be encoded to a `ShortByteString` using an arbitrary encoding.") +-- | Create a 'Name' based on an ASCII 'String'.+-- Non-ASCII strings will throw an error.+mkName :: String -> Name+mkName = fromString

@@ -12,20 +12,20 @@ -- Note this is different from "named metadata", which are represented with -- 'LLVM.AST.NamedMetadataDefinition'. newtype MetadataNodeID = MetadataNodeID Word-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/docs/LangRef.html#metadata> data MetadataNode    = MetadataNode [Maybe Metadata]   | MetadataNodeReference MetadataNodeID-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/docs/LangRef.html#metadata> data Metadata-  = MDString String -- ^ <http://llvm.org/docs/doxygen/html/classllvm_1_1MDNode.html>+  = MDString ShortByteString -- ^ <http://llvm.org/docs/doxygen/html/classllvm_1_1MDNode.html>   | MDNode MetadataNode -- ^ <http://llvm.org/docs/doxygen/html/classllvm_1_1MDNode.html>   | MDValue Operand -- ^ <http://llvm.org/docs/doxygen/html/classllvm_1_1ValueAsMetadata.html>-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | An 'Operand' is roughly that which is an argument to an 'LLVM.AST.Instruction.Instruction' data Operand @@ -34,7 +34,7 @@   -- | 'Constant's include 'LLVM.AST.Constant.GlobalReference', for \@foo   | ConstantOperand Constant   | MetadataOperand Metadata-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | The 'LLVM.AST.Instruction.Call' instruction is special: the callee can be inline assembly type CallableOperand  = Either InlineAssembly Operand

@@ -24,4 +24,4 @@     | Returned     | SwiftSelf     | SwiftError-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)

@@ -16,7 +16,7 @@   | Min   | UMax   | UMin-  deriving (Eq, Ord, Read, Show, Data, Typeable)+  deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)   

@@ -9,4 +9,4 @@     | LocalDynamic     | InitialExec     | LocalExec-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)

@@ -6,14 +6,15 @@ import LLVM.AST.AddrSpace import LLVM.AST.Name --- | LLVM supports some special formats floating point format. This type is to distinguish those format.--- I believe it's treated as a format for "a" float, as opposed to a vector of two floats, because--- its intended usage is to represent a single number with a combined significand.-data FloatingPointFormat-  = IEEE-  | DoubleExtended-  | PairOfFloats-  deriving (Eq, Ord, Read, Show, Typeable, Data)+-- | LLVM supports some special formats floating point format. This type is to distinguish those format. Also see  <http://llvm.org/docs/LangRef.html#floating-point-types>+data FloatingPointType+  = HalfFP      -- ^ 16-bit floating point value+  | FloatFP     -- ^ 32-bit floating point value+  | DoubleFP    -- ^ 64-bit floating point value+  | FP128FP     -- ^ 128-bit floating point value (112-bit mantissa)+  | X86_FP80FP  -- ^ 80-bit floating point value (X87)+  | PPC_FP128FP -- ^ 128-bit floating point value (two 64-bits)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | <http://llvm.org/docs/LangRef.html#type-system> data Type@@ -24,7 +25,7 @@   -- | <http://llvm.org/docs/LangRef.html#pointer-type>   | PointerType { pointerReferent :: Type, pointerAddrSpace :: AddrSpace }   -- | <http://llvm.org/docs/LangRef.html#floating-point-types>-  | FloatingPointType { typeBits :: Word32, floatingPointFormat :: FloatingPointFormat }+  | FloatingPointType { floatingPointType :: FloatingPointType }   -- | <http://llvm.org/docs/LangRef.html#function-type>   | FunctionType { resultType :: Type, argumentTypes :: [Type], isVarArg :: Bool }   -- | <http://llvm.org/docs/LangRef.html#vector-type>@@ -39,7 +40,7 @@   | MetadataType -- only to be used as a parameter type for a few intrinsics   -- | <http://llvm.org/docs/LangRef.html#token-type>   | TokenType-  deriving (Eq, Ord, Read, Show, Typeable, Data)+  deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)  -- | An abbreviation for 'VoidType' void :: Type@@ -73,27 +74,27 @@ ptr :: Type -> Type ptr t = PointerType t (AddrSpace 0) --- | An abbreviation for 'FloatingPointType' 16 'IEEE'+-- | An abbreviation for 'FloatingPointType' 'HalfFP' half :: Type-half = FloatingPointType 16 IEEE+half = FloatingPointType HalfFP --- | An abbreviation for 'FloatingPointType' 32 'IEEE'+-- | An abbreviation for 'FloatingPointType' 'FloatFP' float :: Type-float = FloatingPointType 32 IEEE+float = FloatingPointType FloatFP --- | An abbreviation for 'FloatingPointType' 64 'IEEE'+-- | An abbreviation for 'FloatingPointType' 'DoubleFP' double :: Type-double = FloatingPointType 64 IEEE+double = FloatingPointType DoubleFP --- | An abbreviation for 'FloatingPointType' 128 'IEEE'+-- | An abbreviation for 'FloatingPointType' 'FP128FP' fp128 :: Type-fp128 = FloatingPointType 128 IEEE+fp128 = FloatingPointType FP128FP --- | An abbreviation for 'FloatingPointType' 80 'DoubleExtended'+-- | An abbreviation for 'FloatingPointType' 'X86_FP80FP' x86_fp80 :: Type-x86_fp80 = FloatingPointType 80 DoubleExtended+x86_fp80 = FloatingPointType X86_FP80FP --- | An abbreviation for 'FloatingPointType' 128 'PairOfFloats'+-- | An abbreviation for 'FloatingPointType' 'PPC_FP128FP' ppc_fp128 :: Type-ppc_fp128 = FloatingPointType 128 PairOfFloats+ppc_fp128 = FloatingPointType PPC_FP128FP 

@@ -5,4 +5,4 @@  -- | <http://llvm.org/docs/LangRef.html#visibility> data Visibility = Default | Hidden | Protected-  deriving (Eq, Read, Show, Typeable, Data)+  deriving (Eq, Read, Show, Typeable, Data, Generic)

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module LLVM.DataLayout (  dataLayoutToString,  parseDataLayout@@ -7,24 +8,27 @@  import Control.Monad.Trans.Except +import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString.Char8+import Data.ByteString.Char8 as ByteString hiding (map, foldr) import qualified Data.List as List import qualified Data.Map as Map+import Data.Monoid import qualified Data.Set as Set -import Text.ParserCombinators.Parsec hiding (many)- import LLVM.AST.DataLayout import LLVM.AST.AddrSpace -dataLayoutToString :: DataLayout -> String+dataLayoutToString :: DataLayout -> ByteString dataLayoutToString dl =-  let sAlignmentInfo :: AlignmentInfo -> String+  let sAlignmentInfo :: AlignmentInfo -> ByteString       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+        pack (show abi) <>+        if pref /= abi+          then ":" <> pack (show pref)+          else ""+      sTriple :: (Word32, AlignmentInfo) -> ByteString+      sTriple (s, ai) = pack (show s) <> ":" <> sAlignmentInfo ai       atChar at = case at of         IntegerAlign -> "i"         VectorAlign -> "v"@@ -39,39 +43,40 @@       nonDef :: Eq a => (DataLayout -> [a]) -> [a]       nonDef f = (f dl) List.\\ (f defDl)   in-  List.intercalate "-" (+  ByteString.intercalate "-" (     [case endianness dl of BigEndian -> "E"; LittleEndian -> "e"]     ++-    (oneOpt (("m:" ++) . manglingChar) mangling)+    (oneOpt (("m:" <>) . manglingChar) mangling)     ++     [-      "p" ++ (if a == 0 then "" else show a) ++ ":" ++ sTriple t+      "p" <> (if a == 0 then "" else pack (show a)) <> ":" <> sTriple t       | (AddrSpace a, t) <- nonDef (Map.toList . pointerLayouts)     ] ++ [-      atChar at ++ sTriple (s, ai)+      atChar at <> sTriple (s, ai)       | ((at, s), ai) <- nonDef (Map.toList . typeLayouts)     ] ++ [-      "a:" ++ sAlignmentInfo ai | ai <- nonDef (pure . aggregateLayout)+      "a:" <> sAlignmentInfo ai | ai <- nonDef (pure . aggregateLayout)     ] ++-    (oneOpt (("n"++) . (List.intercalate ":") . (map show) . Set.toList) nativeSizes)+    (oneOpt (("n"<>) . (ByteString.intercalate ":") . map (pack . show) . Set.toList) nativeSizes)     ++-    (oneOpt (("S"++) . show) stackAlignment)+    (oneOpt (("S"<>) . pack . show) stackAlignment)   )  -- | 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 :: Endianness -> ByteString -> Except String (Maybe DataLayout) parseDataLayout _ "" = pure Nothing-parseDataLayout defaultEndianness s =+parseDataLayout defaultEndianness str =   let     num :: Parser Word32     num = read <$> many1 digit     alignmentInfo :: Parser AlignmentInfo     alignmentInfo = do       abi <- num-      pref <- optionMaybe $ char ':' *> num-      pure $ AlignmentInfo abi pref+      pref <- optional $ char ':' *> num+      let pref' = fromMaybe abi pref+      pure $ AlignmentInfo abi pref'     triple :: Parser (Word32, AlignmentInfo)     triple = do       s <- num@@ -118,6 +123,6 @@         pure $ \dl -> dl { nativeSizes = Just (Set.fromList ns) }      ]   in-    case parse (parseSpec `sepBy` (char '-')) "" s of-      Left _ -> throwE $ "ill formed data layout: " ++ show s+    case parseOnly (parseSpec `sepBy` (char '-')) str of+      Left _ -> throwE $ "ill formed data layout: " ++ show str       Right fs -> pure . Just $ foldr ($) (defaultDataLayout defaultEndianness) fs

@@ -4,13 +4,17 @@ module LLVM.Prelude (     module Prelude,     module Data.Data,+    module GHC.Generics,     module Data.Int,     module Data.Word,     module Data.Functor,     module Data.Foldable,     module Data.Traversable,     module Control.Applicative,-    module Control.Monad+    module Control.Monad,+    ByteString,+    ShortByteString,+    fromMaybe     ) where  import Prelude hiding (@@ -22,8 +26,10 @@     concatMap,     elem, notElem,   )-import Data.Data hiding (typeOf)+import Data.Data (Data, Typeable)+import GHC.Generics (Generic) import Data.Int+import Data.Maybe (fromMaybe) import Data.Word import Data.Functor import Data.Foldable@@ -35,3 +41,6 @@     sequence, sequence_,     msum   )++import Data.ByteString (ByteString)+import Data.ByteString.Short (ShortByteString)

@@ -1,11 +1,16 @@+{-# LANGUAGE OverloadedStrings #-} module LLVM.Test.DataLayout where  import Test.Tasty import Test.Tasty.HUnit+import Test.Tasty.QuickCheck  import Control.Monad.Trans.Except +import Control.Applicative+import Control.Monad import Data.Maybe+import Data.Monoid import qualified Data.Set as Set import qualified Data.Map as Map @@ -16,7 +21,45 @@  ddl = defaultDataLayout LittleEndian -tests = testGroup "DataLayout" [+mergeWithDefaultDL :: DataLayout -> DataLayout+mergeWithDefaultDL dl =+  dl+  { pointerLayouts = pointerLayouts dl <> pointerLayouts (defaultDataLayout LittleEndian)+  , typeLayouts = typeLayouts dl <> typeLayouts (defaultDataLayout LittleEndian)+  }++instance Arbitrary Endianness where+  arbitrary = elements [LittleEndian, BigEndian]++instance Arbitrary AddrSpace where+  arbitrary = AddrSpace <$> arbitrary++instance Arbitrary Mangling where+  arbitrary =+    elements [ELFMangling, MIPSMangling, MachOMangling, WindowsCOFFMangling]++instance Arbitrary AlignmentInfo where+  arbitrary = AlignmentInfo <$> arbitrary <*> arbitrary++instance Arbitrary AlignType where+  arbitrary = elements [IntegerAlign, VectorAlign, FloatAlign]++instance Arbitrary DataLayout where+  arbitrary =+    DataLayout+      <$> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary++tests = testGroup "DataLayout" $+  testProperty "roundtrip"+    (\dl -> pure (Just (mergeWithDefaultDL dl)) == parseDataLayout LittleEndian (dataLayoutToString dl))+  :+  [   testCase name $ do     let Right parsed = runExcept $ parseDataLayout LittleEndian strDl     (dataLayoutToString astDl, parsed) @?= (strDl, Just astDl)@@ -32,10 +75,7 @@          (AddrSpace 0)           (           8,-          AlignmentInfo {-            abiAlignment = 64,-            preferredAlignment = Nothing-          }+          AlignmentInfo 64 64          )      },      "e-p:8:64"@@ -43,12 +83,12 @@      "pref",      ddl {        pointerLayouts = -         Map.insert (AddrSpace 1) (8, AlignmentInfo 32 (Just 64)) (pointerLayouts ddl)+         Map.insert (AddrSpace 1) (8, AlignmentInfo 32 64) (pointerLayouts ddl)      },      "e-p1:8:32:64"     ), (      "def",-     ddl { pointerLayouts = Map.singleton (AddrSpace 0) (64, AlignmentInfo 64 (Just 64)) },+     ddl { pointerLayouts = Map.singleton (AddrSpace 0) (64, AlignmentInfo 64 64) },      "e"     ), (      "big",@@ -57,21 +97,21 @@        mangling = Just ELFMangling,        stackAlignment = Just 128,        pointerLayouts = Map.fromList [-         (AddrSpace 0, (8, AlignmentInfo {abiAlignment = 8, preferredAlignment = Just 16}))+         (AddrSpace 0, (8, AlignmentInfo 8 16))         ],        typeLayouts = Map.fromList [-         ((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})+         ((IntegerAlign, 1), AlignmentInfo 8 256),+         ((IntegerAlign, 8), AlignmentInfo 8 256),+         ((IntegerAlign, 16), AlignmentInfo 16 256),+         ((IntegerAlign, 32), AlignmentInfo 32 256),+         ((IntegerAlign, 64), AlignmentInfo 64 256),+         ((VectorAlign, 64), AlignmentInfo 64 256),+         ((VectorAlign, 128), AlignmentInfo 128 256),+         ((FloatAlign, 32), AlignmentInfo 32 256),+         ((FloatAlign, 64), AlignmentInfo 64 256),+         ((FloatAlign, 80), AlignmentInfo 128 256)         ] `Map.union` typeLayouts ddl, -       aggregateLayout = AlignmentInfo {abiAlignment = 0, preferredAlignment = Just 256},+       aggregateLayout = AlignmentInfo 0 256,        nativeSizes = Just (Set.fromList [8,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"