llvm-general 3.4.6.0 → 3.5.0.0

raw patch · 63 files changed

+1624/−741 lines, 63 filesdep ~llvm-generaldep ~llvm-general-puresetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: llvm-general, llvm-general-pure

API changes (from Hackage documentation)

Files

• Setup.hs +4/−4
• changelog +0/−5
• llvm-general.cabal +13/−12
• src/LLVM/General/Internal/Atomicity.hs +17/−6
• src/LLVM/General/Internal/Attribute.hs +216/−135
• src/LLVM/General/Internal/CallingConvention.hs +51/−13
• src/LLVM/General/Internal/DecodeAST.hs +22/−2
• src/LLVM/General/Internal/EncodeAST.hs +19/−4
• src/LLVM/General/Internal/FFI/AssemblyC.cpp +1/−2
• src/LLVM/General/Internal/FFI/Attribute.h +55/−0
• src/LLVM/General/Internal/FFI/Attribute.hs +131/−0
• src/LLVM/General/Internal/FFI/AttributeC.cpp +120/−0
• src/LLVM/General/Internal/FFI/AttributeC.hpp +42/−0
• src/LLVM/General/Internal/FFI/BitcodeC.cpp +6/−4
• src/LLVM/General/Internal/FFI/Builder.hs +6/−6
• src/LLVM/General/Internal/FFI/BuilderC.cpp +3/−2
• src/LLVM/General/Internal/FFI/CallingConvention.h +35/−0
• src/LLVM/General/Internal/FFI/CallingConventionC.hpp +16/−0
• src/LLVM/General/Internal/FFI/Function.h +0/−39
• src/LLVM/General/Internal/FFI/Function.hs +25/−26
• src/LLVM/General/Internal/FFI/FunctionC.cpp +32/−0
• src/LLVM/General/Internal/FFI/GlobalAliasC.cpp +1/−0
• src/LLVM/General/Internal/FFI/GlobalValue.h +26/−8
• src/LLVM/General/Internal/FFI/GlobalValue.hs +39/−11
• src/LLVM/General/Internal/FFI/GlobalValueC.cpp +50/−0
• src/LLVM/General/Internal/FFI/GlobalVariable.hs +0/−6
• src/LLVM/General/Internal/FFI/Instruction.h +10/−0
• src/LLVM/General/Internal/FFI/Instruction.hs +19/−21
• src/LLVM/General/Internal/FFI/InstructionC.cpp +50/−25
• src/LLVM/General/Internal/FFI/LLVMCTypes.hsc +49/−13
• src/LLVM/General/Internal/FFI/LibFunc.h +10/−1
• src/LLVM/General/Internal/FFI/Module.hs +6/−1
• src/LLVM/General/Internal/FFI/ModuleC.cpp +6/−2
• src/LLVM/General/Internal/FFI/PassManagerC.cpp +15/−34
• src/LLVM/General/Internal/FFI/PtrHierarchy.hs +7/−2
• src/LLVM/General/Internal/FFI/RawOStreamC.cpp +4/−3
• src/LLVM/General/Internal/FFI/Target.h +4/−2
• src/LLVM/General/Internal/FFI/Target.hs +1/−1
• src/LLVM/General/Internal/FFI/TargetC.cpp +8/−7
• src/LLVM/General/Internal/FFI/Threading.hs +0/−6
• src/LLVM/General/Internal/FFI/Transforms.hs +0/−1
• src/LLVM/General/Internal/FFI/Value.h +0/−2
• src/LLVM/General/Internal/Function.hs +27/−14
• src/LLVM/General/Internal/Global.hs +67/−7
• src/LLVM/General/Internal/Instruction.hs +32/−32
• src/LLVM/General/Internal/Module.hs +63/−29
• src/LLVM/General/Internal/RawOStream.hs +3/−3
• src/LLVM/General/Internal/TailCallKind.hs +18/−0
• src/LLVM/General/Internal/Target.hs +24/−32
• src/LLVM/General/Internal/Threading.hs +0/−21
• src/LLVM/General/Target.hs +1/−1
• src/LLVM/General/Target/Options.hs +3/−1
• src/LLVM/General/Threading.hs +17/−0
• src/LLVM/General/Transforms.hs +13/−38
• test/LLVM/General/Test/CallingConvention.hs +57/−0
• test/LLVM/General/Test/DataLayout.hs +27/−34
• test/LLVM/General/Test/InlineAssembly.hs +1/−1
• test/LLVM/General/Test/Instructions.hs +8/−7
• test/LLVM/General/Test/Instrumentation.hs +3/−1
• test/LLVM/General/Test/Module.hs +57/−31
• test/LLVM/General/Test/Optimization.hs +78/−78
• test/LLVM/General/Test/Target.hs +4/−5
• test/LLVM/General/Test/Tests.hs +2/−0

@@ -22,7 +22,7 @@ -- without checking they're already defined and so causes warnings. uncheckedHsFFIDefines = ["__STDC_LIMIT_MACROS"] -llvmVersion = Version [3,4] []+llvmVersion = Version [3,5] []  llvmConfigNames = [   "llvm-config-" ++ (intercalate "." . map show . versionBranch $ llvmVersion),@@ -111,7 +111,7 @@                         "3.2" -> "LLVM-3.2svn"                         x -> "LLVM-" ++ x       staticLibs <- liftM (map (fromJust . stripPrefix "-l") . words) $ llvmConfig ["--libs"]-      externLibs <- liftM (mapMaybe (stripPrefix "-l") . words) $ llvmConfig ["--ldflags"]+      systemLibs <- liftM (map (fromJust . stripPrefix "-l") . words) $ llvmConfig ["--system-libs"]        let genericPackageDescription' = genericPackageDescription {             condLibrary = do@@ -123,8 +123,8 @@                 condTreeComponents = condTreeComponents libraryCondTree ++ [                   (                     Var (Flag (FlagName "shared-llvm")),-                    CondNode (mempty { libBuildInfo = mempty { extraLibs = [sharedLib] ++ externLibs } }) [] [],-                    Just (CondNode (mempty { libBuildInfo = mempty { extraLibs = staticLibs ++ externLibs } }) [] [])+                    CondNode (mempty { libBuildInfo = mempty { extraLibs = [sharedLib] ++ systemLibs } }) [] [],+                    Just (CondNode (mempty { libBuildInfo = mempty { extraLibs = staticLibs ++ systemLibs } }) [] [])                   )                 ]                }

@@ -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-version: 3.4.6.0+version: 3.5.0.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -16,11 +16,13 @@ 	handles almost all of the stateful complexities of using the LLVM API to build IR; and it supports moving IR not 	only from Haskell into LLVM C++ objects, but the other direction - from LLVM C++ into Haskell. extra-source-files:-  changelog   src/LLVM/General/Internal/FFI/Analysis.h+  src/LLVM/General/Internal/FFI/Attribute.h+  src/LLVM/General/Internal/FFI/AttributeC.hpp   src/LLVM/General/Internal/FFI/BinaryOperator.h+  src/LLVM/General/Internal/FFI/CallingConvention.h+  src/LLVM/General/Internal/FFI/CallingConventionC.hpp   src/LLVM/General/Internal/FFI/Constant.h-  src/LLVM/General/Internal/FFI/Function.h   src/LLVM/General/Internal/FFI/GlobalValue.h   src/LLVM/General/Internal/FFI/InlineAssembly.h   src/LLVM/General/Internal/FFI/Instruction.h@@ -35,12 +37,6 @@   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: v3.4.6.0- flag shared-llvm   description: link against llvm shared rather than static library   default: False@@ -52,6 +48,7 @@ library   build-tools: llvm-config   ghc-options: -fwarn-unused-imports+  cc-options: -std=c++11   build-depends:     base >= 4.6 && < 5,     utf8-string >= 0.3.7,@@ -64,7 +61,7 @@     parsec >= 3.1.3,     array >= 0.4.0.0,     setenv >= 0.1.0,-    llvm-general-pure == 3.4.5.4+    llvm-general-pure == 3.5.0.0   extra-libraries: stdc++   hs-source-dirs: src   extensions:@@ -131,11 +128,13 @@     LLVM.General.Internal.RawOStream     LLVM.General.Internal.RMWOperation     LLVM.General.Internal.String+    LLVM.General.Internal.TailCallKind     LLVM.General.Internal.Target     LLVM.General.Internal.Threading     LLVM.General.Internal.Type     LLVM.General.Internal.Value     LLVM.General.Internal.FFI.Analysis+    LLVM.General.Internal.FFI.Attribute     LLVM.General.Internal.FFI.Assembly     LLVM.General.Internal.FFI.BasicBlock     LLVM.General.Internal.FFI.BinaryOperator@@ -174,6 +173,7 @@   include-dirs: src   c-sources:     src/LLVM/General/Internal/FFI/AssemblyC.cpp+    src/LLVM/General/Internal/FFI/AttributeC.cpp     src/LLVM/General/Internal/FFI/BitcodeC.cpp     src/LLVM/General/Internal/FFI/BuilderC.cpp     src/LLVM/General/Internal/FFI/ConstantC.cpp@@ -205,8 +205,8 @@     HUnit >= 1.2.4.2,     test-framework-quickcheck2 >= 0.3.0.1,     QuickCheck >= 2.5.1.1,-    llvm-general == 3.4.6.0,-    llvm-general-pure == 3.4.5.4,+    llvm-general == 3.5.0.0,+    llvm-general-pure == 3.5.0.0,     containers >= 0.4.2.1,     mtl >= 2.1,     transformers >= 0.3.0.0,@@ -219,6 +219,7 @@   main-is: Test.hs   other-modules:     LLVM.General.Test.Analysis+    LLVM.General.Test.CallingConvention     LLVM.General.Test.Constants     LLVM.General.Test.DataLayout     LLVM.General.Test.ExecutionEngine

@@ -23,16 +23,27 @@   (FFI.memoryOrderingSequentiallyConsistent, Just A.SequentiallyConsistent)  ] -instance Monad m => EncodeM m (Maybe A.Atomicity) (FFI.LLVMBool, FFI.MemoryOrdering) where+genCodingInstance [t| A.SynchronizationScope |] ''FFI.SynchronizationScope [+  (FFI.synchronizationScopeSingleThread, A.SingleThread),+  (FFI.synchronizationScopeCrossThread, A.CrossThread)+ ]++instance Monad m => EncodeM m (Maybe A.Atomicity) (FFI.SynchronizationScope, FFI.MemoryOrdering) where   encodeM a =-    return (,) `ap` encodeM (maybe False A.crossThread a) `ap` encodeM (liftM A.memoryOrdering a)+    return (,) `ap` encodeM (maybe A.SingleThread fst a) `ap` encodeM (liftM snd a) -instance Monad m => DecodeM m (Maybe A.Atomicity) (FFI.LLVMBool, FFI.MemoryOrdering) where-  decodeM (ss, ao) = return (liftM . A.Atomicity) `ap` decodeM ss `ap` decodeM ao+instance Monad m => DecodeM m (Maybe A.Atomicity) (FFI.SynchronizationScope, FFI.MemoryOrdering) where+  decodeM (ss, ao) = return (liftM . (,)) `ap` decodeM ss `ap` decodeM ao -instance Monad m => EncodeM m A.Atomicity (FFI.LLVMBool, FFI.MemoryOrdering) where+instance Monad m => EncodeM m A.Atomicity (FFI.SynchronizationScope, FFI.MemoryOrdering) where   encodeM = encodeM . Just -instance Monad m => DecodeM m A.Atomicity (FFI.LLVMBool, FFI.MemoryOrdering) where+instance Monad m => DecodeM m A.Atomicity (FFI.SynchronizationScope, FFI.MemoryOrdering) where+  decodeM = liftM fromJust . decodeM++instance Monad m => EncodeM m A.MemoryOrdering FFI.MemoryOrdering where+  encodeM = encodeM . Just++instance Monad m => DecodeM m A.MemoryOrdering FFI.MemoryOrdering where   decodeM = liftM fromJust . decodeM 

@@ -1,154 +1,235 @@ {-# LANGUAGE-  TemplateHaskell,   MultiParamTypeClasses,-  ConstraintKinds+  ConstraintKinds,+  QuasiQuotes,+  UndecidableInstances,+  RankNTypes   #-} module LLVM.General.Internal.Attribute where  import LLVM.General.Prelude -import LLVM.General.TH-import Language.Haskell.TH.Quote--import Data.List (genericSplitAt)+import Control.Monad.AnyCont+import Control.Monad.Exceptable+import Control.Monad.State (gets) -import Data.Bits+import Foreign.C (CUInt)+import Foreign.Ptr+import Data.Either+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe +import qualified LLVM.General.Internal.FFI.Attribute as FFI import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI+import LLVM.General.Internal.FFI.LLVMCTypes (parameterAttributeKindP, functionAttributeKindP)   -import qualified LLVM.General.AST.Attribute as A.A+import qualified LLVM.General.AST.ParameterAttribute as A.PA  +import qualified LLVM.General.AST.FunctionAttribute as A.FA    import LLVM.General.Internal.Coding+import LLVM.General.Internal.Context  +import LLVM.General.Internal.EncodeAST+import LLVM.General.Internal.DecodeAST -$(do-  let-    -- build an instance of the Coding class for lists of some kind of attribute-    genAttributeListCoding :: (Data a, Bits a) => TypeQ -> Name -> [(a, String)] -> DecsQ-    genAttributeListCoding type' ctn attributeData = do-      let-         lowZeroes :: Bits b => b -> Int-         lowZeroes b | testBit b 0 = 0-         lowZeroes b = 1 + lowZeroes (shiftR b 1)-         field :: Bits b => b -> (Int, Int)-         field b = -             let s = lowZeroes b-                 w = lowZeroes (complement (shiftR b s))-             in -               (s,w)-         attributeData' = [(mkName n, b, s,w) | (b,n) <- attributeData, let (s,w) = field b ]-      let m = varT . mkName $ "m"-      TyConI (NewtypeD _ _ _ (NormalC ctcn _) _) <- reify ctn-      let zero = [| $(conE ctcn) 0 |]-      sequence [-        instanceD (sequence [appT (conT ''Monad) m]) [t| EncodeM $(m) [$(type')] $(conT ctn) |] [-          funD (mkName "encodeM") [-            clause [] (normalB [| return . (-              let-                 encodeAlignment a | popCount a == 1 = 1 + popCount (a - 1)-                 encodeAlignment _ = error "Cannot encode alignment which is not a power of two"-                 encodeAttribute a = $(-                  caseE [| a |] $ flip map attributeData' $ \(n, b, s, w) ->-                    let bQ = (dataToExpQ (const Nothing) b)-                    in-                      case w of-                        1 -> match (conP n []) (normalB bQ) []-                        _ -> do -                          a <- newName "a"-                          match -                           (conP n [varP a])-                           (normalB [| ($(conE ctcn) (fromIntegral (encodeAlignment $(varE a)) `shiftL` s)) .&. $(bQ) |])-                           []-                  )-              in-                foldl (.|.) $(zero) . map encodeAttribute-             ) |]) []-           ]-         ],- -        -- build a decoder which uses bit masking for multiple fields at once-        -- to eliminate multiple absent attributes in fewer tests-        instanceD (sequence [appT (conT ''Monad) m]) [t| DecodeM $(m) [$(type')] $(conT ctn) |] [-          funD (mkName "decodeM") [-            do-              bits <- newName "bits"-              clause [varP bits] (normalB -                (let-                    code :: (Data a, Bits a) => [ (Name, a, Int, Int) ] -- attrs to handle-                         -> Int -- length (attrs), passed in to avoid recomputation-                         -> (a, ExpQ) -- (<bitmask for all the given attrs>, <code to decode the given attrs>)-                    code [(n, b, s, w)] _ = (-                       b, -                       case w of-                         1 -> [| [ $(conE n) | testBit $(varE bits) s ] |]-                         _-> [| -                               [ -                                 $(do-                                    i' <- newName "i'"-                                    letE -                                     [valD (conP ctcn [varP i']) (normalB [| i |]) []]-                                     [| $(conE n) (bit ((fromIntegral $(varE i')) - 1)) |])-                                 | let i = ($(varE bits) .&. $(dataToExpQ (const Nothing) b)) `shiftR` s, -                                   i /= $(zero)-                               ]-                             |]-                      )-                    code attrs nAttrs =-                      let (nEarlyAttrs, nLateAttrs) = (nAttrs `div` 2, nAttrs - nEarlyAttrs)-                          (earlyAttrs, lateAttrs) = genericSplitAt nEarlyAttrs attrs-                          (earlyAttrBits, earlyAttrCode) = code earlyAttrs nEarlyAttrs-                          (lateAttrBits, lateAttrCode) = code lateAttrs nLateAttrs-                          attrBits = earlyAttrBits .|. lateAttrBits-                      in-                        (-                         attrBits, -                         [| -                            if ($(varE bits) .&. $(dataToExpQ (const Nothing) attrBits) /= $(zero)) then-                              ($earlyAttrCode ++ $lateAttrCode) -                            else-                              []-                          |]-                        )-                in-                  [| return $(snd $ code attributeData' (length attributeData')) |]-                )-               ) []-            ]-          ]-        ]+instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuilder -> EncodeAST ()) where+  encodeM a = return $ \b -> liftIO $ case a of+    A.PA.Alignment v -> FFI.attrBuilderAddAlignment b v+    A.PA.Dereferenceable v -> FFI.attrBuilderAddDereferenceable b v+    _ -> FFI.attrBuilderAddParameterAttributeKind b $ case a of+      A.PA.ZeroExt -> FFI.parameterAttributeKindZExt+      A.PA.SignExt -> FFI.parameterAttributeKindSExt+      A.PA.InReg -> FFI.parameterAttributeKindInReg+      A.PA.SRet -> FFI.parameterAttributeKindStructRet+      A.PA.NoAlias -> FFI.parameterAttributeKindNoAlias+      A.PA.ByVal -> FFI.parameterAttributeKindByVal+      A.PA.NoCapture -> FFI.parameterAttributeKindNoCapture+      A.PA.Nest -> FFI.parameterAttributeKindNest+      A.PA.ReadOnly -> FFI.parameterAttributeKindReadOnly+      A.PA.ReadNone -> FFI.parameterAttributeKindReadNone+      A.PA.InAlloca -> FFI.parameterAttributeKindInAlloca+      A.PA.NonNull -> FFI.parameterAttributeKindNonNull+      A.PA.Returned -> FFI.parameterAttributeKindReturned -  pi <- genAttributeListCoding [t| A.A.ParameterAttribute |] ''FFI.ParamAttr [-    (FFI.paramAttrZExt, "A.A.ZeroExt"),-    (FFI.paramAttrSExt, "A.A.SignExt"),-    (FFI.paramAttrInReg, "A.A.InReg"),-    (FFI.paramAttrStructRet, "A.A.SRet"),-    (FFI.paramAttrAlignment, "A.A.Alignment"),-    (FFI.paramAttrNoAlias, "A.A.NoAlias"),-    (FFI.paramAttrByVal, "A.A.ByVal"),-    (FFI.paramAttrNoCapture, "A.A.NoCapture"),-    (FFI.paramAttrNest, "A.A.Nest")-   ]+instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilder -> EncodeAST ()) where+  encodeM (A.FA.StringAttribute kind value) = return $ \b -> do+    (kindP, kindLen) <- encodeM kind+    (valueP, valueLen) <- encodeM value+    liftIO $ FFI.attrBuilderAddStringAttribute b kindP kindLen valueP valueLen+  encodeM a = return $ \b -> liftIO $ case a of+    A.FA.StackAlignment v -> FFI.attrBuilderAddStackAlignment b v+    _ -> FFI.attrBuilderAddFunctionAttributeKind b $ case a of+      A.FA.NoReturn -> FFI.functionAttributeKindNoReturn+      A.FA.NoUnwind -> FFI.functionAttributeKindNoUnwind+      A.FA.ReadNone -> FFI.functionAttributeKindReadNone+      A.FA.ReadOnly -> FFI.functionAttributeKindReadOnly+      A.FA.NoInline -> FFI.functionAttributeKindNoInline+      A.FA.AlwaysInline -> FFI.functionAttributeKindAlwaysInline+      A.FA.MinimizeSize -> FFI.functionAttributeKindMinSize+      A.FA.OptimizeForSize -> FFI.functionAttributeKindOptimizeForSize+      A.FA.OptimizeNone -> FFI.functionAttributeKindOptimizeForSize                                                   +      A.FA.StackProtect -> FFI.functionAttributeKindStackProtect+      A.FA.StackProtectReq -> FFI.functionAttributeKindStackProtectReq+      A.FA.StackProtectStrong -> FFI.functionAttributeKindStackProtectStrong+      A.FA.NoRedZone -> FFI.functionAttributeKindNoRedZone+      A.FA.NoImplicitFloat -> FFI.functionAttributeKindNoImplicitFloat+      A.FA.Naked -> FFI.functionAttributeKindNaked+      A.FA.InlineHint -> FFI.functionAttributeKindInlineHint+      A.FA.ReturnsTwice -> FFI.functionAttributeKindReturnsTwice+      A.FA.UWTable -> FFI.functionAttributeKindUWTable+      A.FA.NonLazyBind -> FFI.functionAttributeKindNonLazyBind+      A.FA.Builtin -> FFI.functionAttributeKindBuiltin+      A.FA.NoBuiltin -> FFI.functionAttributeKindNoBuiltin+      A.FA.Cold -> FFI.functionAttributeKindCold+      A.FA.JumpTable -> FFI.functionAttributeKindJumpTable+      A.FA.NoDuplicate -> FFI.functionAttributeKindNoDuplicate+      A.FA.SanitizeAddress -> FFI.functionAttributeKindSanitizeAddress+      A.FA.SanitizeThread -> FFI.functionAttributeKindSanitizeThread+      A.FA.SanitizeMemory -> FFI.functionAttributeKindSanitizeMemory -  fi <- genAttributeListCoding [t| A.A.FunctionAttribute |] ''FFI.FunctionAttr [-    (FFI.functionAttrNoReturn, "A.A.NoReturn"),-    (FFI.functionAttrNoUnwind, "A.A.NoUnwind"),-    (FFI.functionAttrReadNone, "A.A.ReadNone"),-    (FFI.functionAttrReadOnly, "A.A.ReadOnly"),-    (FFI.functionAttrNoInline, "A.A.NoInline"),-    (FFI.functionAttrAlwaysInline, "A.A.AlwaysInline"),-    (FFI.functionAttrOptimizeForSize, "A.A.OptimizeForSize"),-    (FFI.functionAttrStackProtect, "A.A.StackProtect"),-    (FFI.functionAttrStackProtectReq, "A.A.StackProtectReq"),-    (FFI.functionAttrNoRedZone, "A.A.NoRedZone"),-    (FFI.functionAttrNoImplicitFloat, "A.A.NoImplicitFloat"),-    (FFI.functionAttrNaked, "A.A.Naked"),-    (FFI.functionAttrInlineHint, "A.A.InlineHint"),-    (FFI.functionAttrStackAlignment, "A.A.StackAlignment"),-    (FFI.functionAttrReturnsTwice, "A.A.ReturnsTwice"),-    (FFI.functionAttrUWTable, "A.A.UWTable"),-    (FFI.functionAttrNonLazyBind, "A.A.NonLazyBind")-   ]-  return (pi ++ fi)- )+instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where+  decodeM a = do+    enum <- liftIO $ FFI.parameterAttributeKindAsEnum a+    case enum of+      [parameterAttributeKindP|ZExt|] -> return A.PA.ZeroExt+      [parameterAttributeKindP|SExt|] -> return A.PA.SignExt+      [parameterAttributeKindP|InReg|] -> return A.PA.InReg+      [parameterAttributeKindP|StructRet|] -> return A.PA.SRet+      [parameterAttributeKindP|Alignment|] -> return A.PA.Alignment `ap` (liftIO $ FFI.attributeValueAsInt a)+      [parameterAttributeKindP|NoAlias|] -> return A.PA.NoAlias+      [parameterAttributeKindP|ByVal|] -> return A.PA.ByVal+      [parameterAttributeKindP|NoCapture|] -> return A.PA.NoCapture+      [parameterAttributeKindP|Nest|] -> return A.PA.Nest+      [parameterAttributeKindP|ReadOnly|] -> return A.PA.ReadOnly+      [parameterAttributeKindP|ReadNone|] -> return A.PA.ReadNone+      [parameterAttributeKindP|InAlloca|] -> return A.PA.InAlloca+      [parameterAttributeKindP|NonNull|] -> return A.PA.NonNull+      [parameterAttributeKindP|Dereferenceable|] -> return A.PA.Dereferenceable `ap` (liftIO $ FFI.attributeValueAsInt a)+      [parameterAttributeKindP|Returned|] -> return A.PA.Returned+      _ -> error $ "unhandled parameter attribute enum value: " ++ show enum +instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where+  decodeM a = do+    isString <- decodeM =<< (liftIO $ FFI.isStringAttribute a)+    if isString+       then+         return A.FA.StringAttribute+                  `ap` (decodeM $ FFI.attributeKindAsString a)+                  `ap` (decodeM $ FFI.attributeValueAsString a)                   +       else do+         enum <- liftIO $ FFI.functionAttributeKindAsEnum a+         case enum of+           [functionAttributeKindP|NoReturn|] -> return A.FA.NoReturn+           [functionAttributeKindP|NoUnwind|] -> return A.FA.NoUnwind+           [functionAttributeKindP|ReadNone|] -> return A.FA.ReadNone+           [functionAttributeKindP|ReadOnly|] -> return A.FA.ReadOnly+           [functionAttributeKindP|NoInline|] -> return A.FA.NoInline+           [functionAttributeKindP|AlwaysInline|] -> return A.FA.AlwaysInline+           [functionAttributeKindP|MinSize|] -> return A.FA.MinimizeSize+           [functionAttributeKindP|OptimizeForSize|] -> return A.FA.OptimizeForSize+           [functionAttributeKindP|OptimizeNone|] -> return A.FA.OptimizeForSize                                                   +           [functionAttributeKindP|StackProtect|] -> return A.FA.StackProtect+           [functionAttributeKindP|StackProtectReq|] -> return A.FA.StackProtectReq+           [functionAttributeKindP|StackProtectStrong|] -> return A.FA.StackProtectStrong+           [functionAttributeKindP|NoRedZone|] -> return A.FA.NoRedZone+           [functionAttributeKindP|NoImplicitFloat|] -> return A.FA.NoImplicitFloat+           [functionAttributeKindP|Naked|] -> return A.FA.Naked+           [functionAttributeKindP|InlineHint|] -> return A.FA.InlineHint+           [functionAttributeKindP|StackAlignment|] -> return A.FA.StackAlignment `ap` (liftIO $ FFI.attributeValueAsInt a)+           [functionAttributeKindP|ReturnsTwice|] -> return A.FA.ReturnsTwice+           [functionAttributeKindP|UWTable|] -> return A.FA.UWTable+           [functionAttributeKindP|NonLazyBind|] -> return A.FA.NonLazyBind+           [functionAttributeKindP|Builtin|] -> return A.FA.Builtin+           [functionAttributeKindP|NoBuiltin|] -> return A.FA.NoBuiltin+           [functionAttributeKindP|Cold|] -> return A.FA.Cold+           [functionAttributeKindP|JumpTable|] -> return A.FA.JumpTable+           [functionAttributeKindP|NoDuplicate|] -> return A.FA.NoDuplicate+           [functionAttributeKindP|SanitizeAddress|] -> return A.FA.SanitizeAddress+           [functionAttributeKindP|SanitizeThread|] -> return A.FA.SanitizeThread+           [functionAttributeKindP|SanitizeMemory|] -> return A.FA.SanitizeMemory+           _ -> error $ "unhandled function attribute enum value: " ++ show enum+            +allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => m (Ptr (FFI.AttrBuilder a))+allocaAttrBuilder = do+  p <- allocaArray FFI.getAttrBuilderSize+  anyContToM $ \f -> do+    ab <- FFI.constructAttrBuilder p+    r <- f ab+    FFI.destroyAttrBuilder ab+    return r +instance EncodeM EncodeAST a (Ptr (FFI.AttrBuilder b) -> EncodeAST ()) => EncodeM EncodeAST (FFI.Index, [a]) (FFI.AttributeSet b) where+  encodeM (index, as) = scopeAnyCont $ do+    ab <- allocaAttrBuilder+    builds <- mapM encodeM as+    forM builds ($ ab) :: EncodeAST [()]+    Context context <- gets encodeStateContext+    liftIO $ FFI.getAttributeSet context index ab++instance EncodeM EncodeAST [A.FA.FunctionAttribute] FFI.FunctionAttributeSet where+  encodeM fas = encodeM (FFI.functionIndex, fas)++instance DecodeM DecodeAST a (FFI.Attribute b) => DecodeM DecodeAST [a] (FFI.AttributeSet b) where+  decodeM as = do+    np <- alloca+    as <- liftIO $ FFI.attributeSetGetAttributes as 0 np+    n <- peek np+    decodeM (n, as)+            +data MixedAttributeSet = MixedAttributeSet {+    functionAttributes :: [Either A.FA.GroupID A.FA.FunctionAttribute],+    returnAttributes :: [A.PA.ParameterAttribute],+    parameterAttributes :: Map CUInt [A.PA.ParameterAttribute]+  }+  deriving (Eq, Show)++data PreSlot+  = IndirectFunctionAttributes A.FA.GroupID+  | DirectFunctionAttributes [A.FA.FunctionAttribute]+  | ReturnAttributes [A.PA.ParameterAttribute]+  | ParameterAttributes CUInt [A.PA.ParameterAttribute]    ++instance EncodeM EncodeAST PreSlot FFI.MixedAttributeSet where+  encodeM preSlot = do+    let forget = liftM FFI.forgetAttributeType+    case preSlot of+      IndirectFunctionAttributes gid -> forget (referAttributeGroup gid)+      DirectFunctionAttributes fas -> forget (encodeM fas :: EncodeAST FFI.FunctionAttributeSet)+      ReturnAttributes as -> forget (encodeM (FFI.returnIndex, as) :: EncodeAST FFI.ParameterAttributeSet)+      ParameterAttributes i as -> forget (encodeM (fromIntegral (i + 1) :: FFI.Index, as) :: EncodeAST FFI.ParameterAttributeSet)++instance EncodeM EncodeAST MixedAttributeSet FFI.MixedAttributeSet where+  encodeM (MixedAttributeSet fAttrs rAttrs pAttrs) = do+    let directP = DirectFunctionAttributes (rights fAttrs)+        indirectPs = map IndirectFunctionAttributes (lefts fAttrs)+        returnP = ReturnAttributes rAttrs+        paramPs = [ ParameterAttributes x as | (x, as) <- Map.toList pAttrs ]+    (nAttrs, attrs) <- encodeM ([directP, returnP] ++ indirectPs ++ paramPs)+    Context context <- gets encodeStateContext+    liftIO $ FFI.mixAttributeSets context attrs nAttrs++instance DecodeM DecodeAST MixedAttributeSet FFI.MixedAttributeSet where+  decodeM mas = do+    numSlots <- if mas == nullPtr then return 0 else liftIO $ FFI.attributeSetNumSlots mas+    slotIndexes <- forM (take (fromIntegral numSlots) [0..]) $ \s -> do+      i <- liftIO $ FFI.attributeSetSlotIndex mas s+      return (i, s)+    let separate :: Ord k => k -> Map k a -> (Maybe a, Map k a)+        separate = Map.updateLookupWithKey (\_ _ -> Nothing)+        indexedSlots = Map.fromList slotIndexes+    unless (Map.size indexedSlots == length slotIndexes) $+           fail "unexpected slot index collision decoding mixed AttributeSet"+    let (functionSlot, otherSlots) = separate FFI.functionIndex (Map.fromList slotIndexes)+    functionAnnotation <- for (maybeToList functionSlot) $ \slot -> do+      a <- liftIO $ FFI.attributeSetSlotAttributes mas slot+      getAttributeGroupID a+    otherAttributeSets <- for otherSlots $ \slot -> do+      a <- liftIO $ FFI.attributeSetSlotAttributes mas slot+      decodeM (a :: FFI.ParameterAttributeSet)+    let (returnAttributeSet, shiftedParameterAttributeSets) = separate FFI.returnIndex otherAttributeSets+    return $ MixedAttributeSet {+                  functionAttributes = fmap Left functionAnnotation,+                  returnAttributes = join . maybeToList $ returnAttributeSet,+                  parameterAttributes = Map.mapKeysMonotonic (\x -> fromIntegral x - 1) shiftedParameterAttributeSets+                } 

@@ -11,23 +11,61 @@ import Foreign.C.Types (CUInt(..))  import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI-import LLVM.General.Internal.FFI.LLVMCTypes (callConvP)+import LLVM.General.Internal.FFI.LLVMCTypes (callingConventionP)  import qualified LLVM.General.AST.CallingConvention as A.CC -instance Monad m => EncodeM m A.CC.CallingConvention FFI.CallConv where+instance Monad m => EncodeM m A.CC.CallingConvention FFI.CallingConvention where   encodeM cc = return $          case cc of-          A.CC.C -> FFI.callConvC-          A.CC.Fast -> FFI.callConvFast-          A.CC.Cold -> FFI.callConvCold-          A.CC.GHC ->  FFI.CallConv 10-          A.CC.Numbered cc' -> FFI.CallConv (fromIntegral cc')+          A.CC.C -> FFI.callingConventionC+          A.CC.Fast -> FFI.callingConventionFast+          A.CC.Cold -> FFI.callingConventionCold+          A.CC.GHC ->  FFI.callingConventionGHC+          A.CC.HiPE -> FFI.callingConventionHiPE+          A.CC.WebKit_JS -> FFI.callingConventionWebKit_JS+          A.CC.AnyReg -> FFI.callingConventionAnyReg+          A.CC.PreserveMost -> FFI.callingConventionPreserveMost+          A.CC.PreserveAll -> FFI.callingConventionPreserveAll+          A.CC.X86_StdCall -> FFI.callingConventionX86_StdCall+          A.CC.X86_FastCall -> FFI.callingConventionX86_FastCall+          A.CC.ARM_APCS -> FFI.callingConventionARM_APCS+          A.CC.ARM_AAPCS -> FFI.callingConventionARM_AAPCS+          A.CC.ARM_AAPCS_VFP -> FFI.callingConventionARM_AAPCS_VFP+          A.CC.MSP430_INTR -> FFI.callingConventionMSP430_INTR+          A.CC.X86_ThisCall -> FFI.callingConventionX86_ThisCall+          A.CC.PTX_Kernel -> FFI.callingConventionPTX_Kernel+          A.CC.PTX_Device -> FFI.callingConventionPTX_Device+          A.CC.SPIR_FUNC -> FFI.callingConventionSPIR_FUNC+          A.CC.SPIR_KERNEL -> FFI.callingConventionSPIR_KERNEL+          A.CC.Intel_OCL_BI -> FFI.callingConventionIntel_OCL_BI+          A.CC.X86_64_SysV -> FFI.callingConventionX86_64_SysV+          A.CC.X86_64_Win64 -> FFI.callingConventionX86_64_Win64+          A.CC.Numbered cc' -> FFI.CallingConvention (fromIntegral cc') -instance Monad m => DecodeM m A.CC.CallingConvention FFI.CallConv where+instance Monad m => DecodeM m A.CC.CallingConvention FFI.CallingConvention where   decodeM cc = return $ case cc of-    [callConvP|C|] -> A.CC.C-    [callConvP|Fast|] -> A.CC.Fast-    [callConvP|Cold|] -> A.CC.Cold-    FFI.CallConv (CUInt 10) -> A.CC.GHC-    FFI.CallConv (CUInt ci) | ci >= 64 -> A.CC.Numbered (fromIntegral ci)+    [callingConventionP|C|] -> A.CC.C+    [callingConventionP|Fast|] -> A.CC.Fast+    [callingConventionP|Cold|] -> A.CC.Cold+    [callingConventionP|GHC|] -> A.CC.GHC+    [callingConventionP|HiPE|] -> A.CC.HiPE+    [callingConventionP|WebKit_JS|] -> A.CC.WebKit_JS+    [callingConventionP|AnyReg|] -> A.CC.AnyReg+    [callingConventionP|PreserveMost|] -> A.CC.PreserveMost+    [callingConventionP|PreserveAll|] -> A.CC.PreserveAll+    [callingConventionP|X86_StdCall|] -> A.CC.X86_StdCall+    [callingConventionP|X86_FastCall|] -> A.CC.X86_FastCall+    [callingConventionP|ARM_APCS|] -> A.CC.ARM_APCS+    [callingConventionP|ARM_AAPCS|] -> A.CC.ARM_AAPCS+    [callingConventionP|ARM_AAPCS_VFP|] -> A.CC.ARM_AAPCS_VFP+    [callingConventionP|MSP430_INTR|] -> A.CC.MSP430_INTR+    [callingConventionP|X86_ThisCall|] -> A.CC.X86_ThisCall+    [callingConventionP|PTX_Kernel|] -> A.CC.PTX_Kernel+    [callingConventionP|PTX_Device|] -> A.CC.PTX_Device+    [callingConventionP|SPIR_FUNC|] -> A.CC.SPIR_FUNC+    [callingConventionP|SPIR_KERNEL|] -> A.CC.SPIR_KERNEL+    [callingConventionP|Intel_OCL_BI|] -> A.CC.Intel_OCL_BI+    [callingConventionP|X86_64_SysV|] -> A.CC.X86_64_SysV+    [callingConventionP|X86_64_Win64|] -> A.CC.X86_64_Win64+    FFI.CallingConvention (CUInt ci) | ci >= 64 -> A.CC.Numbered (fromIntegral ci)

@@ -20,12 +20,16 @@ import Data.Array (Array) import qualified Data.Array as Array +import qualified LLVM.General.Internal.FFI.Attribute as FFI+import qualified LLVM.General.Internal.FFI.GlobalValue as FFI import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.Internal.FFI.Value as FFI import qualified LLVM.General.Internal.FFI.Type as FFI  import qualified LLVM.General.AST.Name as A import qualified LLVM.General.AST.Operand as A (MetadataNodeID(..))+import qualified LLVM.General.AST.Attribute as A.A+import qualified LLVM.General.AST.COMDAT as A.COMDAT  import LLVM.General.Internal.Coding import LLVM.General.Internal.String ()@@ -40,7 +44,10 @@     typesToDefine :: Seq (Ptr FFI.Type),     metadataNodesToDefine :: Seq (A.MetadataNodeID, Ptr FFI.MDNode),     metadataNodes :: Map (Ptr FFI.MDNode) A.MetadataNodeID,-    metadataKinds :: Array Word String+    metadataKinds :: Array Word String,+    parameterAttributeSets :: Map FFI.ParameterAttributeSet [A.A.ParameterAttribute],+    functionAttributeSetIDs :: Map FFI.FunctionAttributeSet A.A.GroupID,+    comdats :: Map (Ptr FFI.COMDAT) (String, A.COMDAT.SelectionKind)   } initialDecode = DecodeState {     globalVarNum = Map.empty,@@ -50,7 +57,10 @@     typesToDefine = Seq.empty,     metadataNodesToDefine = Seq.empty,     metadataNodes = Map.empty,-    metadataKinds = Array.listArray (1,0) []+    metadataKinds = Array.listArray (1,0) [],+    parameterAttributeSets = Map.empty,+    functionAttributeSetIDs = Map.empty,+    comdats = Map.empty   } newtype DecodeAST a = DecodeAST { unDecodeAST :: AnyContT (StateT DecodeState IO) a }   deriving (@@ -150,3 +160,13 @@  instance DecodeM DecodeAST A.Name (Ptr FFI.BasicBlock) where   decodeM = getLocalName++getAttributeGroupID :: FFI.FunctionAttributeSet -> DecodeAST A.A.GroupID+getAttributeGroupID p = do+  ids <- gets functionAttributeSetIDs+  case Map.lookup p ids of+    Just r -> return r+    Nothing -> do+      let r = A.A.GroupID (fromIntegral (Map.size ids))+      modify $ \s -> s { functionAttributeSetIDs = Map.insert p r (functionAttributeSetIDs s) }+      return r

@@ -18,11 +18,14 @@ import Data.Map (Map) import qualified Data.Map as Map -import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.General.Internal.FFI.Attribute as FFI   import qualified LLVM.General.Internal.FFI.Builder as FFI+import qualified LLVM.General.Internal.FFI.GlobalValue as FFI+import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.Internal.FFI.Value as FFI  import qualified LLVM.General.AST as A+import qualified LLVM.General.AST.Attribute as A.A  import LLVM.General.Internal.Context import LLVM.General.Internal.Coding@@ -40,7 +43,9 @@       encodeStateAllBlocks :: Map (A.Name, A.Name) (Ptr FFI.BasicBlock),       encodeStateBlocks :: Map A.Name (Ptr FFI.BasicBlock),       encodeStateMDNodes :: Map A.MetadataNodeID (Ptr FFI.MDNode),-      encodeStateNamedTypes :: Map A.Name (Ptr FFI.Type)+      encodeStateNamedTypes :: Map A.Name (Ptr FFI.Type),+      encodeStateAttributeGroups :: Map A.A.GroupID FFI.FunctionAttributeSet,+      encodeStateCOMDATs :: Map String (Ptr FFI.COMDAT)     }  newtype EncodeAST a = EncodeAST { unEncodeAST :: AnyContT (ExceptableT String (StateT EncodeState IO)) a }@@ -74,7 +79,9 @@               encodeStateAllBlocks = Map.empty,               encodeStateBlocks = Map.empty,               encodeStateMDNodes = Map.empty,-              encodeStateNamedTypes = Map.empty+              encodeStateNamedTypes = Map.empty,+              encodeStateAttributeGroups = Map.empty,+              encodeStateCOMDATs = Map.empty             }       flip evalStateT initEncodeState . runExceptableT . flip runAnyContT return $ a @@ -115,6 +122,12 @@ defineMDNode :: A.MetadataNodeID -> Ptr FFI.MDNode -> EncodeAST () defineMDNode n v = modify $ \b -> b { encodeStateMDNodes = Map.insert n (FFI.upCast v) (encodeStateMDNodes b) } +defineAttributeGroup :: A.A.GroupID -> FFI.FunctionAttributeSet -> EncodeAST ()+defineAttributeGroup gid attrs = modify $ \b -> b { encodeStateAttributeGroups = Map.insert gid attrs (encodeStateAttributeGroups b) }++defineCOMDAT :: String -> Ptr FFI.COMDAT -> EncodeAST ()+defineCOMDAT name cd = modify $ \b -> b { encodeStateCOMDATs = Map.insert name cd (encodeStateCOMDATs b) }+ refer :: (Show n, Ord n) => (EncodeState -> Map n v) -> n -> EncodeAST v -> EncodeAST v refer r n f = do   mop <- gets $ Map.lookup n . r@@ -123,11 +136,13 @@ undefinedReference :: Show n => String -> n -> EncodeAST a undefinedReference m n = throwError $ "reference to undefined " ++ m ++ ": " ++ show n -referOrThrow :: (Show n, Ord n) => (EncodeState -> Map n (Ptr p)) -> String -> n -> EncodeAST (Ptr p)+referOrThrow :: (Show n, Ord n) => (EncodeState -> Map n v) -> String -> n -> EncodeAST v referOrThrow r m n = refer r n $ undefinedReference m n  referGlobal = referOrThrow encodeStateGlobals "global" referMDNode = referOrThrow encodeStateMDNodes "metadata node"+referAttributeGroup = referOrThrow encodeStateAttributeGroups "attribute group"+referCOMDAT = referOrThrow encodeStateCOMDATs "COMDAT"  defineBasicBlock :: A.Name -> A.Name -> Ptr FFI.BasicBlock -> EncodeAST () defineBasicBlock fn n b = modify $ \s -> s {

@@ -1,8 +1,7 @@ #define __STDC_LIMIT_MACROS #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Module.h"-#include "llvm/Assembly/Parser.h"-#include "llvm/Assembly/PrintModulePass.h"+#include "llvm/AsmParser/Parser.h" #include "llvm/Pass.h" #include "llvm/Support/SourceMgr.h" #include "llvm/Support/raw_ostream.h"

@@ -0,0 +1,55 @@+#ifndef __LLVM_GENERAL_INTERNAL_FFI__ATTRIBUTES__H__+#define __LLVM_GENERAL_INTERNAL_FFI__ATTRIBUTES__H__++#define LLVM_GENERAL_FOR_EACH_ATTRIBUTE_KIND(macro)	\+	macro(None,F,F,F)                                 \+	macro(Alignment,T,F,F)                            \+	macro(AlwaysInline,F,F,T)                         \+	macro(Builtin,F,F,T)                              \+	macro(ByVal,T,F,F)                                \+	macro(InAlloca,T,F,F)                             \+	macro(Cold,F,F,T)                                 \+	macro(InlineHint,F,F,T)                           \+	macro(InReg,T,T,F)                                \+	macro(JumpTable,F,F,T)                            \+	macro(MinSize,F,F,T)                              \+	macro(Naked,F,F,T)                                \+	macro(Nest,T,F,F)                                 \+	macro(NoAlias,T,T,F)                              \+	macro(NoBuiltin,F,F,T)                            \+	macro(NoCapture,T,F,F)                            \+	macro(NoDuplicate,F,F,T)                          \+	macro(NoImplicitFloat,F,F,T)                      \+	macro(NoInline,F,F,T)                             \+	macro(NonLazyBind,F,F,T)                          \+	macro(NonNull,T,T,F)                              \+	macro(Dereferenceable,T,T,F)                      \+	macro(NoRedZone,F,F,T)                            \+	macro(NoReturn,F,F,T)                             \+	macro(NoUnwind,F,F,T)                             \+	macro(OptimizeForSize,F,F,T)                      \+	macro(OptimizeNone,F,F,T)                         \+	macro(ReadNone,T,F,T)                             \+	macro(ReadOnly,T,F,T)                             \+	macro(Returned,T,F,F)                             \+	macro(ReturnsTwice,F,F,T)                         \+	macro(SExt,T,T,F)                                 \+	macro(StackAlignment,F,F,T)                       \+	macro(StackProtect,F,F,T)                         \+	macro(StackProtectReq,F,F,T)                      \+	macro(StackProtectStrong,F,F,T)                   \+	macro(StructRet,T,F,F)                            \+	macro(SanitizeAddress,F,F,T)                      \+	macro(SanitizeThread,F,F,T)                       \+	macro(SanitizeMemory,F,F,T)                       \+	macro(UWTable,F,F,T)                              \+	macro(ZExt,T,T,F)                                 \+	macro(EndAttrKinds,F,F,F)++typedef enum {+#define ENUM_CASE(x,p,r,f) LLVM_General_AttributeKind_ ## x,+LLVM_GENERAL_FOR_EACH_ATTRIBUTE_KIND(ENUM_CASE)+#undef ENUM_CASE+} LLVM_General_AttributeKind;++#endif

@@ -0,0 +1,131 @@+{-# LANGUAGE+  ForeignFunctionInterface+  #-}+module LLVM.General.Internal.FFI.Attribute where++import LLVM.General.Prelude++import Foreign.Ptr+import Foreign.C++import LLVM.General.Internal.FFI.Context+import LLVM.General.Internal.FFI.LLVMCTypes++type Index = CInt+type Slot = CUInt+type IntValue = Word64++{-+Data model:+llvm::Attribute is one function or parameter attribute++llvm::AttributeSet is a mess.+It's used to represent, at different times:+a) the set of parameter attributes on a parameter+b) the set of parameter attributes for a functions return value+c) the set of function attributes for a function+d) All of the above++It is only possible to enumerate the attributes in an attribute set+given a "slot".++Encode path:+Use AttrBuilder on the C++ side only, to implement [Attribute] -> AttributeSet+AttributeSets -> whole AttributeSet++Decode strategy:+Store maps of AttributeSetImpl (Mess | Parameter | Function),+keyed by raw pointer. Expect Parameter and Function AttributeSetImpls+to have only one slot. Use the per-slot iterators to decode them+-}++data MixedAttributeType+data FunctionAttributeType+data ParameterAttributeType+data AttributeImpl a+data AttributeSetImpl a++type Attribute a = Ptr (AttributeImpl a)+type FunctionAttribute = Attribute FunctionAttributeType+type ParameterAttribute = Attribute ParameterAttributeType++type AttributeSet a = Ptr (AttributeSetImpl a)+type MixedAttributeSet = AttributeSet MixedAttributeType+type FunctionAttributeSet = AttributeSet FunctionAttributeType+type ParameterAttributeSet = AttributeSet ParameterAttributeType++forgetAttributeType :: AttributeSet a -> AttributeSet MixedAttributeType+forgetAttributeType = castPtr++functionIndex :: Index+functionIndex = -1+returnIndex :: Index+returnIndex = 0++foreign import ccall unsafe "LLVM_General_AttributeKindAsEnum" parameterAttributeKindAsEnum ::+  ParameterAttribute -> IO ParameterAttributeKind++foreign import ccall unsafe "LLVM_General_AttributeKindAsEnum" functionAttributeKindAsEnum ::+  FunctionAttribute -> IO FunctionAttributeKind++foreign import ccall unsafe "LLVM_General_IsStringAttribute" isStringAttribute ::+  Attribute a -> IO LLVMBool++foreign import ccall unsafe "LLVM_General_AttributeKindAsString" attributeKindAsString ::+  Attribute a -> Ptr CSize -> IO (Ptr CChar)++foreign import ccall unsafe "LLVM_General_AttributeValueAsString" attributeValueAsString ::+  Attribute a -> Ptr CSize -> IO (Ptr CChar)++foreign import ccall unsafe "LLVM_General_AttributeValueAsInt" attributeValueAsInt ::+  Attribute a -> IO Word64++foreign import ccall unsafe "LLVM_General_AttributeSetNumSlots" attributeSetNumSlots ::+  AttributeSet a -> IO Slot++foreign import ccall unsafe "LLVM_General_AttributeSetSlotIndex" attributeSetSlotIndex ::+  AttributeSet a -> Slot -> IO Index++foreign import ccall unsafe "LLVM_General_AttributeSetSlotAttributes" attributeSetSlotAttributes ::+  MixedAttributeSet -> Slot -> IO (AttributeSet a)++foreign import ccall unsafe "LLVM_General_AttributeSetGetAttributes" attributeSetGetAttributes ::+  AttributeSet a -> Slot -> Ptr CUInt -> IO (Ptr (Attribute a))++foreign import ccall unsafe "LLVM_General_GetAttributeSet" getAttributeSet ::+  Ptr Context -> Index -> Ptr (AttrBuilder a) -> IO (AttributeSet a)++foreign import ccall unsafe "LLVM_General_MixAttributeSets" mixAttributeSets ::+  Ptr Context -> Ptr MixedAttributeSet -> CUInt -> IO MixedAttributeSet++data AttrBuilder a+type FunctionAttrBuilder = AttrBuilder FunctionAttributeType+type ParameterAttrBuilder = AttrBuilder ParameterAttributeType++foreign import ccall unsafe "LLVM_General_GetAttrBuilderSize" getAttrBuilderSize ::+  CSize++foreign import ccall unsafe "LLVM_General_ConstructAttrBuilder" constructAttrBuilder ::+  Ptr Word8 -> IO (Ptr (AttrBuilder a))++foreign import ccall unsafe "LLVM_General_DestroyAttrBuilder" destroyAttrBuilder ::+  Ptr (AttrBuilder a) -> IO ()++foreign import ccall unsafe "LLVM_General_AttrBuilderAddAttributeKind" attrBuilderAddFunctionAttributeKind ::+  Ptr FunctionAttrBuilder -> FunctionAttributeKind -> IO ()++foreign import ccall unsafe "LLVM_General_AttrBuilderAddAttributeKind" attrBuilderAddParameterAttributeKind ::+  Ptr ParameterAttrBuilder -> ParameterAttributeKind -> IO ()++foreign import ccall unsafe "LLVM_General_AttrBuilderAddStringAttribute" attrBuilderAddStringAttribute ::+  Ptr FunctionAttrBuilder -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO ()++foreign import ccall unsafe "LLVM_General_AttrBuilderAddAlignment" attrBuilderAddAlignment ::+  Ptr ParameterAttrBuilder -> Word64 -> IO ()++foreign import ccall unsafe "LLVM_General_AttrBuilderAddStackAlignment" attrBuilderAddStackAlignment ::+  Ptr FunctionAttrBuilder -> Word64 -> IO ()++foreign import ccall unsafe "LLVM_General_AttrBuilderAddDereferenceableAttr" attrBuilderAddDereferenceable ::+  Ptr ParameterAttrBuilder -> Word64 -> IO ()+                                              

@@ -0,0 +1,120 @@+#define __STDC_LIMIT_MACROS+#include "llvm/IR/LLVMContext.h"+#include "LLVM/General/Internal/FFI/AttributeC.hpp"++extern "C" {++unsigned LLVM_General_AttributeSetNumSlots(const AttributeSetImpl *a) {+	return unwrap(a).getNumSlots();+}++int LLVM_General_AttributeSetSlotIndex(const AttributeSetImpl *a, unsigned slot) {+	return unwrap(a).getSlotIndex(slot);+}++const AttributeSetImpl *LLVM_General_AttributeSetSlotAttributes(const AttributeSetImpl *a, unsigned slot) {+	return wrap(unwrap(a).getSlotAttributes(slot));+}++const AttributeSetImpl *LLVM_General_GetSlotAttributeSet(+	LLVMContextRef context,+	unsigned index,+	const AttributeImpl **attributes,+	unsigned length+) {+	AttrBuilder builder;+	for (unsigned i = 0; i < length; i++) builder.addAttribute(unwrap(attributes[i]));+	return wrap(AttributeSet::get(*unwrap(context), index, builder));+}++const AttributeImpl *const *LLVM_General_AttributeSetGetAttributes(AttributeSetImpl *asi, unsigned slot, unsigned *length) {+	AttributeSet as = unwrap(asi);+	ArrayRef<Attribute>::iterator b = as.begin(slot), e = as.end(slot);+	*length = e - b;+	return reinterpret_cast<const AttributeImpl *const *>(b);+}++inline void LLVM_General_AttributeEnumMatches() {+#define CHECK(name,p,r,f)																								\+	static_assert(																												\+		unsigned(llvm::Attribute::name) == unsigned(LLVM_General_AttributeKind_ ## name), \+		"LLVM_General_AttributeKind enum out of sync w/ llvm::Attribute::AttrKind for " #name	\+	);+	LLVM_GENERAL_FOR_EACH_ATTRIBUTE_KIND(CHECK)+#undef CHECK+}++unsigned LLVM_General_AttributeKindAsEnum(const AttributeImpl *a) {+	LLVM_General_AttributeEnumMatches();+	return unwrap(a).getKindAsEnum();+}++uint64_t LLVM_General_AttributeValueAsInt(const AttributeImpl *a) {+	return unwrap(a).getValueAsInt();+}++LLVMBool LLVM_General_IsStringAttribute(const AttributeImpl *a) {+	return unwrap(a).isStringAttribute();+}++const char *LLVM_General_AttributeKindAsString(const AttributeImpl *a, size_t &l) {+	const StringRef s = unwrap(a).getKindAsString();+	l = s.size();+	return s.data();+}++const char *LLVM_General_AttributeValueAsString(const AttributeImpl *a, size_t &l) {+	const StringRef s = unwrap(a).getValueAsString();+	l = s.size();+	return s.data();+}++const AttributeSetImpl *LLVM_General_GetAttributeSet(LLVMContextRef context, unsigned index, const AttrBuilder &ab) {+	return wrap(AttributeSet::get(*unwrap(context), index, ab));+}++const AttributeSetImpl *LLVM_General_MixAttributeSets(+	LLVMContextRef context, const AttributeSetImpl **as, unsigned n+) {+	return wrap(+		AttributeSet::get(+			*unwrap(context),+			ArrayRef<AttributeSet>(reinterpret_cast<const AttributeSet *>(as), n)+		)+	);+}++size_t LLVM_General_GetAttrBuilderSize() { return sizeof(AttrBuilder); }++AttrBuilder *LLVM_General_ConstructAttrBuilder(char *p) {+	return new(p) AttrBuilder();+}++void LLVM_General_DestroyAttrBuilder(AttrBuilder *a) {+	a->~AttrBuilder();+}++void LLVM_General_AttrBuilderAddAttributeKind(AttrBuilder &ab, unsigned kind) {+	LLVM_General_AttributeEnumMatches();+	ab.addAttribute(Attribute::AttrKind(kind));+}++void LLVM_General_AttrBuilderAddStringAttribute(+	AttrBuilder &ab, const char *kind, size_t kind_len, const char *value, size_t value_len+) {+	ab.addAttribute(StringRef(kind, kind_len), StringRef(value, value_len));+}++void LLVM_General_AttrBuilderAddAlignment(AttrBuilder &ab, uint64_t v) {+	ab.addAlignmentAttr(v);+}++void LLVM_General_AttrBuilderAddStackAlignment(AttrBuilder &ab, uint64_t v) {+	ab.addStackAlignmentAttr(v);+}++void LLVM_General_AttrBuilderAddDereferenceableAttr(AttrBuilder &ab, uint64_t v) {+	ab.addDereferenceableAttr(v);+}++}

@@ -0,0 +1,42 @@+#ifndef __LLVM_GENERAL_ATTRIBUTE_C_HPP__+#define __LLVM_GENERAL_ATTRIBUTE_C_HPP__+#define __STDC_LIMIT_MACROS+#include "llvm/IR/Attributes.h"+#include "LLVM/General/Internal/FFI/Attribute.h"+using namespace llvm;++inline void LLVM_General_AttributeSetMatches() {+	static_assert(+		sizeof(AttributeSet) == sizeof(AttributeSetImpl *),+		"AttributeSet implementation has changed"+	);+}++inline AttributeSet unwrap(const AttributeSetImpl *asi) {+	LLVM_General_AttributeSetMatches();+	return *reinterpret_cast<const AttributeSet *>(&asi);+}++inline const AttributeSetImpl *wrap(AttributeSet as) {+	LLVM_General_AttributeSetMatches();+	return *reinterpret_cast<const AttributeSetImpl **>(&as);+}++inline void LLVM_General_AttributeMatches() {+	static_assert(+		sizeof(Attribute) == sizeof(AttributeImpl *),+		"Attribute implementation has changed"+	);+}++inline Attribute unwrap(const AttributeImpl *ai) {+	LLVM_General_AttributeMatches();+	return *reinterpret_cast<const Attribute *>(&ai);+}++inline const AttributeImpl *wrap(Attribute a) {+	LLVM_General_AttributeMatches();+	return *reinterpret_cast<const AttributeImpl **>(&a);+}++#endif

@@ -1,5 +1,4 @@ #define __STDC_LIMIT_MACROS-//#include "llvm/Config/llvm-config.h" #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Module.h" #include "llvm-c/Core.h"@@ -17,9 +16,12 @@ 	char **error ) { 	std::string msg;-	Module *m = ParseBitcodeFile(unwrap(mb), *unwrap(c), &msg);-	if (m == 0) *error = strdup(msg.c_str());-	return wrap(m);+	ErrorOr<Module *> m = parseBitcodeFile(unwrap(mb), *unwrap(c));+	if (std::error_code ec = m.getError()) {+		*error = strdup(ec.message().c_str());+		return 0;+	}+	return wrap(m.get()); }  void LLVM_General_WriteBitcode(LLVMModuleRef m, raw_ostream &os) {

@@ -87,12 +87,12 @@   Ptr Builder -> Ptr Type -> Ptr Value -> CString -> IO (Ptr Instruction)  foreign import ccall unsafe "LLVM_General_BuildLoad" buildLoad' ::-  Ptr Builder -> LLVMBool -> Ptr Value -> MemoryOrdering -> LLVMBool -> CUInt -> CString -> IO (Ptr Instruction)+  Ptr Builder -> LLVMBool -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CUInt -> CString -> IO (Ptr Instruction)  buildLoad builder vol a' (ss, mo) al s = buildLoad' builder vol a' mo ss al s  foreign import ccall unsafe "LLVM_General_BuildStore" buildStore' ::-  Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> MemoryOrdering -> LLVMBool -> CUInt -> CString -> IO (Ptr Instruction)+  Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CUInt -> CString -> IO (Ptr Instruction)  buildStore builder vol a' v' (ss, mo) al s = buildStore' builder vol a' v' mo ss al s @@ -107,17 +107,17 @@ buildGetElementPtr builder (LLVMBool 0) a (n, is) s = buildGetElementPtr' builder a is n s  foreign import ccall unsafe "LLVM_General_BuildFence" buildFence' ::-  Ptr Builder -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)+  Ptr Builder -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction)  buildFence builder (ss, mo) s = buildFence' builder mo ss s  foreign import ccall unsafe "LLVM_General_BuildAtomicCmpXchg" buildCmpXchg' ::-  Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)+  Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> MemoryOrdering -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction) -buildCmpXchg builder vol a e r (ss, mo) s =  buildCmpXchg' builder vol a e r mo ss s+buildCmpXchg builder vol a e r (ss, smo) fmo s =  buildCmpXchg' builder vol a e r smo fmo ss s  foreign import ccall unsafe "LLVM_General_BuildAtomicRMW" buildAtomicRMW' ::-  Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)+  Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction)  buildAtomicRMW builder vol rmwOp a v (ss, mo) s = buildAtomicRMW' builder vol rmwOp a v mo ss s  

@@ -127,12 +127,13 @@ 	LLVMValueRef ptr,  	LLVMValueRef cmp,  	LLVMValueRef n, -	LLVMAtomicOrdering lao,+	LLVMAtomicOrdering successOrdering,+	LLVMAtomicOrdering failureOrdering, 	LLVMSynchronizationScope lss, 	const char *name ) { 	AtomicCmpXchgInst *a = unwrap(b)->CreateAtomicCmpXchg(-		unwrap(ptr), unwrap(cmp), unwrap(n), unwrap(lao), unwrap(lss)+		unwrap(ptr), unwrap(cmp), unwrap(n), unwrap(successOrdering), unwrap(failureOrdering), unwrap(lss) 	); 	a->setVolatile(v); 	a->setName(name);

@@ -0,0 +1,35 @@+#ifndef __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION__H__+#define __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION__H__++#define LLVM_GENERAL_FOR_EACH_CALLING_CONVENTION(macro) \+  macro(C, 0)                                           \+  macro(Fast, 8)                                        \+  macro(Cold, 9)                                        \+  macro(GHC, 10)                                        \+  macro(HiPE, 11)                                       \+  macro(WebKit_JS, 12)                                  \+  macro(AnyReg, 13)                                     \+  macro(PreserveMost, 14)                               \+  macro(PreserveAll, 15)                                \+  macro(X86_StdCall, 64)                                \+  macro(X86_FastCall, 65)                               \+  macro(ARM_APCS, 66)                                   \+  macro(ARM_AAPCS, 67)                                  \+  macro(ARM_AAPCS_VFP, 68)                              \+  macro(MSP430_INTR, 69)                                \+  macro(X86_ThisCall, 70)                               \+  macro(PTX_Kernel, 71)                                 \+  macro(PTX_Device, 72)                                 \+  macro(SPIR_FUNC, 75)                                  \+  macro(SPIR_KERNEL, 76)                                \+  macro(Intel_OCL_BI, 77)                               \+  macro(X86_64_SysV, 78)                                \+  macro(X86_64_Win64, 79)++typedef enum {+#define ENUM_CASE(l,n) LLVM_General_CallingConvention_ ## l = n,+  LLVM_GENERAL_FOR_EACH_CALLING_CONVENTION(ENUM_CASE)+#undef ENUM_CASE+} LLVM_General_CallingConvention;++#endif

@@ -0,0 +1,16 @@+#ifndef __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION_C_HPP__+#define __LLVM_GENERAL_INTERNAL_FFI__CALLING_CONVENTION_C_HPP__++#include "LLVM/General/Internal/FFI/CallingConvention.h"++inline void LLVM_General_CallingConventionEnumMatches() {+#define CHECK(l,n)                                             \+  static_assert(                                                        \+    unsigned(llvm::CallingConv::l) == unsigned(LLVM_General_CallingConvention_ ## l), \+    "LLVM_General_CallingConvention enum out of sync w/ llvm::CallingConv::ID for " #l  \+  );+  LLVM_GENERAL_FOR_EACH_CALLING_CONVENTION(CHECK)+#undef CHECK+}++#endif

@@ -1,39 +0,0 @@-#ifndef __LLVM_GENERAL_INTERNAL_FFI__FUNCTION__H__-#define __LLVM_GENERAL_INTERNAL_FFI__FUNCTION__H__--#define LLVM_GENERAL_FOR_EACH_CALLCONV(macro) \-	macro(C)																		\-	macro(Fast)																	\-	macro(Cold)																	\--#define LLVM_GENERAL_FOR_EACH_PARAM_ATTR(macro) \-	macro(ZExt,Attribute)                         \-	macro(SExt,Attribute)                         \-	macro(InReg,Attribute)                        \-	macro(StructRet,Attribute)                    \-	macro(Alignment,)                             \-	macro(NoAlias,Attribute)                      \-	macro(ByVal,Attribute)                        \-	macro(NoCapture,Attribute)                    \-	macro(Nest,Attribute)--#define LLVM_GENERAL_FOR_EACH_FUNCTION_ATTR(macro)	\-	macro(NoReturn,Attribute)													\-	macro(NoUnwind,Attribute)													\-	macro(ReadNone,Attribute)													\-	macro(ReadOnly,Attribute)													\-	macro(NoInline,Attribute)													\-	macro(AlwaysInline,Attribute)											\-	macro(OptimizeForSize,Attribute)									\-	macro(StackProtect,Attribute)											\-	macro(StackProtectReq,Attribute)									\-	macro(NoRedZone,Attribute)												\-	macro(NoImplicitFloat,Attribute)									\-	macro(Naked,Attribute)														\-	macro(InlineHint,Attribute)												\-	macro(StackAlignment,)														\-	macro(ReturnsTwice,)															\-	macro(UWTable,)																		\-	macro(NonLazyBind,)																\--#endif

@@ -10,55 +10,54 @@ import Foreign.Ptr import Foreign.C +import LLVM.General.Internal.FFI.Attribute import LLVM.General.Internal.FFI.Context import LLVM.General.Internal.FFI.LLVMCTypes import LLVM.General.Internal.FFI.PtrHierarchy -foreign import ccall unsafe "LLVMGetFunctionCallConv" getFunctionCallConv ::-    Ptr Function -> IO CallConv+foreign import ccall unsafe "LLVM_General_GetFunctionCallingConvention" getFunctionCallingConvention ::+  Ptr Function -> IO CallingConvention -foreign import ccall unsafe "LLVMSetFunctionCallConv" setFunctionCallConv ::-    Ptr Function -> CallConv -> IO ()+foreign import ccall unsafe "LLVM_General_SetFunctionCallingConvention" setFunctionCallingConvention ::+  Ptr Function -> CallingConvention -> IO () -foreign import ccall unsafe "LLVMAddFunctionAttr" addFunctionAttr ::-    Ptr Function -> FunctionAttr -> IO ()+foreign import ccall unsafe "LLVM_General_GetFunctionMixedAttributeSet" getMixedAttributeSet ::+  Ptr Function -> IO MixedAttributeSet -foreign import ccall unsafe "LLVMGetFunctionAttr" getFunctionAttr ::-    Ptr Function -> IO FunctionAttr+foreign import ccall unsafe "LLVM_General_SetFunctionMixedAttributeSet" setMixedAttributeSet ::+  Ptr Function -> MixedAttributeSet -> IO ()  foreign import ccall unsafe "LLVMGetFirstBasicBlock" getFirstBasicBlock ::-    Ptr Function -> IO (Ptr BasicBlock)+  Ptr Function -> IO (Ptr BasicBlock)  foreign import ccall unsafe "LLVMGetLastBasicBlock" getLastBasicBlock ::-    Ptr Function -> IO (Ptr BasicBlock)+  Ptr Function -> IO (Ptr BasicBlock)  foreign import ccall unsafe "LLVMGetNextBasicBlock" getNextBasicBlock ::-    Ptr BasicBlock -> IO (Ptr BasicBlock)+  Ptr BasicBlock -> IO (Ptr BasicBlock)  foreign import ccall unsafe "LLVMAppendBasicBlockInContext" appendBasicBlockInContext ::-    Ptr Context -> Ptr Function -> CString -> IO (Ptr BasicBlock)+  Ptr Context -> Ptr Function -> CString -> IO (Ptr BasicBlock)   foreign import ccall unsafe "LLVMCountParams" countParams ::-    Ptr Function -> IO CUInt+  Ptr Function -> IO CUInt  foreign import ccall unsafe "LLVMGetParams" getParams ::-    Ptr Function -> Ptr (Ptr Parameter) -> IO ()--foreign import ccall unsafe "LLVMGetAttribute" getAttribute ::-    Ptr Parameter -> IO ParamAttr--foreign import ccall unsafe "LLVMAddAttribute" addAttribute ::-    Ptr Parameter -> ParamAttr -> IO ()--foreign import ccall unsafe "LLVM_General_GetFunctionRetAttr" getFunctionRetAttr ::-    Ptr Function -> IO ParamAttr--foreign import ccall unsafe "LLVM_General_AddFunctionRetAttr" addFunctionRetAttr ::-    Ptr Function -> ParamAttr -> IO ()+  Ptr Function -> Ptr (Ptr Parameter) -> IO ()  foreign import ccall unsafe "LLVMGetGC" getGC ::   Ptr Function -> IO CString  foreign import ccall unsafe "LLVMSetGC" setGC ::   Ptr Function -> CString -> IO ()+++foreign import ccall unsafe "LLVM_General_HasFunctionPrefixData" hasPrefixData ::+  Ptr Function -> IO LLVMBool++foreign import ccall unsafe "LLVM_General_GetFunctionPrefixData" getPrefixData ::+  Ptr Function -> IO (Ptr Constant)++foreign import ccall unsafe "LLVM_General_SetFunctionPrefixData" setPrefixData ::+  Ptr Function -> Ptr Constant -> IO ()

@@ -2,8 +2,11 @@ #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Attributes.h" #include "llvm/IR/Function.h"+#include "llvm/IR/Value.h"  #include "llvm-c/Core.h"+#include "LLVM/General/Internal/FFI/AttributeC.hpp"+#include "LLVM/General/Internal/FFI/CallingConventionC.hpp"  using namespace llvm; @@ -22,5 +25,34 @@ 	); } +const AttributeSetImpl *LLVM_General_GetFunctionMixedAttributeSet(LLVMValueRef f) {+	return wrap(unwrap<Function>(f)->getAttributes());+}++void LLVM_General_SetFunctionMixedAttributeSet(LLVMValueRef f, AttributeSetImpl *asi) {+	unwrap<Function>(f)->setAttributes(unwrap(asi));+}++LLVMBool LLVM_General_HasFunctionPrefixData(LLVMValueRef f) {+  return unwrap<Function>(f)->hasPrefixData();+}++LLVMValueRef LLVM_General_GetFunctionPrefixData(LLVMValueRef f) {+  return wrap(unwrap<Function>(f)->getPrefixData());+}++void LLVM_General_SetFunctionPrefixData(LLVMValueRef f, LLVMValueRef p) {+  unwrap<Function>(f)->setPrefixData(unwrap<Constant>(p));+}++unsigned LLVM_General_GetFunctionCallingConvention(LLVMValueRef f) {+  LLVM_General_CallingConventionEnumMatches();+  return unsigned(unwrap<Function>(f)->getCallingConv());+}++void LLVM_General_SetFunctionCallingConvention(LLVMValueRef f, unsigned cc) {+  LLVM_General_CallingConventionEnumMatches();+  unwrap<Function>(f)->setCallingConv(llvm::CallingConv::ID(cc));+}  }

@@ -1,6 +1,7 @@ #define __STDC_LIMIT_MACROS #include "llvm/IR/LLVMContext.h" #include "llvm/IR/GlobalAlias.h"+#include "llvm/IR/GlobalObject.h"  #include "llvm-c/Core.h" 

@@ -6,24 +6,42 @@ 	macro(AvailableExternally)										\ 	macro(LinkOnceAny)														\ 	macro(LinkOnceODR)														\-	macro(LinkOnceODRAutoHide)										\ 	macro(WeakAny)																\ 	macro(WeakODR)																\ 	macro(Appending)															\ 	macro(Internal)																\ 	macro(Private)																\-	macro(DLLImport)															\-	macro(DLLExport)															\ 	macro(ExternalWeak)														\-	macro(Ghost)																	\-	macro(Common)																	\-	macro(LinkerPrivate)													\-	macro(LinkerPrivateWeak)											\-+	macro(Common)  #define LLVM_GENERAL_FOR_EACH_VISIBILITY(macro)	\ 	macro(Default)																\ 	macro(Hidden)																	\ 	macro(Protected)															\++#define LLVM_GENERAL_FOR_EACH_COMDAT_SELECTION_KIND(macro)	\+	macro(Any)                                                \+	macro(ExactMatch)                                         \+	macro(Largest)                                            \+	macro(NoDuplicates)                                       \+	macro(SameSize)++typedef enum {+#define ENUM_CASE(n) LLVM_General_COMDAT_Selection_Kind_ ## n,+LLVM_GENERAL_FOR_EACH_COMDAT_SELECTION_KIND(ENUM_CASE)+#undef ENUM_CASE+} LLVM_General_COMDAT_Selection_Kind;++#define LLVM_GENERAL_FOR_EACH_DLL_STORAGE_CLASS(macro)	\+	macro(Default)                                        \+	macro(DLLImport)                                      \+	macro(DLLExport)++#define LLVM_GENERAL_FOR_EACH_THREAD_LOCAL_MODE(macro)  \+	macro(NotThreadLocal)                                 \+	macro(GeneralDynamicTLSModel)                         \+	macro(LocalDynamicTLSModel)                           \+	macro(InitialExecTLSModel)                            \+	macro(LocalExecTLSModel)  #endif

@@ -14,38 +14,66 @@ import LLVM.General.Internal.FFI.PtrHierarchy import LLVM.General.Internal.FFI.LLVMCTypes +data COMDAT+ foreign import ccall unsafe "LLVMIsAGlobalValue" isAGlobalValue ::-    Ptr Value -> IO (Ptr GlobalValue)+  Ptr Value -> IO (Ptr GlobalValue)  foreign import ccall unsafe "LLVMGetLinkage" getLinkage ::-    Ptr GlobalValue -> IO Linkage+  Ptr GlobalValue -> IO Linkage  foreign import ccall unsafe "LLVMSetLinkage" setLinkage ::-    Ptr GlobalValue -> Linkage -> IO ()+  Ptr GlobalValue -> Linkage -> IO ()  foreign import ccall unsafe "LLVMGetSection" getSection ::-    Ptr GlobalValue -> IO CString+  Ptr GlobalValue -> IO CString  foreign import ccall unsafe "LLVMSetSection" setSection ::-    Ptr GlobalValue -> CString -> IO ()+  Ptr GlobalValue -> CString -> IO () +foreign import ccall unsafe "LLVM_General_GetCOMDAT" getCOMDAT ::+  Ptr GlobalValue -> IO (Ptr COMDAT)++foreign import ccall unsafe "LLVM_General_SetCOMDAT" setCOMDAT ::+  Ptr GlobalObject -> Ptr COMDAT -> IO ()++foreign import ccall unsafe "LLVM_General_GetCOMDATName" getCOMDATName ::+  Ptr COMDAT -> Ptr CSize -> IO (Ptr CChar)++foreign import ccall unsafe "LLVM_General_GetCOMDATSelectionKind" getCOMDATSelectionKind ::+  Ptr COMDAT -> IO COMDATSelectionKind++foreign import ccall unsafe "LLVM_General_SetCOMDATSelectionKind" setCOMDATSelectionKind ::+  Ptr COMDAT -> COMDATSelectionKind -> IO ()+ foreign import ccall unsafe "LLVMGetVisibility" getVisibility ::-    Ptr GlobalValue -> IO Visibility+  Ptr GlobalValue -> IO Visibility  foreign import ccall unsafe "LLVMSetVisibility" setVisibility ::-    Ptr GlobalValue -> Visibility -> IO ()+  Ptr GlobalValue -> Visibility -> IO () +foreign import ccall unsafe "LLVMGetDLLStorageClass" getDLLStorageClass ::+  Ptr GlobalValue -> IO DLLStorageClass++foreign import ccall unsafe "LLVMSetDLLStorageClass" setDLLStorageClass ::+  Ptr GlobalValue -> DLLStorageClass -> IO ()+ foreign import ccall unsafe "LLVMGetAlignment" getAlignment ::-    Ptr GlobalValue -> IO CUInt+  Ptr GlobalValue -> IO CUInt  foreign import ccall unsafe "LLVMSetAlignment" setAlignment ::-    Ptr GlobalValue -> CUInt -> IO ()+  Ptr GlobalValue -> CUInt -> IO ()  foreign import ccall unsafe "LLVM_General_HasUnnamedAddr" hasUnnamedAddr ::-    Ptr GlobalValue -> IO LLVMBool+  Ptr GlobalValue -> IO LLVMBool  foreign import ccall unsafe "LLVM_General_SetUnnamedAddr" setUnnamedAddr ::-    Ptr GlobalValue -> LLVMBool -> IO ()+  Ptr GlobalValue -> LLVMBool -> IO () +foreign import ccall unsafe "LLVM_General_GetThreadLocalMode" getThreadLocalMode ::+  Ptr GlobalValue -> IO ThreadLocalMode++foreign import ccall unsafe "LLVM_General_SetThreadLocalMode" setThreadLocalMode ::+  Ptr GlobalValue -> ThreadLocalMode -> IO ()  

@@ -1,17 +1,67 @@ #define __STDC_LIMIT_MACROS+#include "llvm/IR/Comdat.h" #include "llvm/IR/GlobalValue.h"+#include "llvm/IR/GlobalObject.h" #include "llvm-c/Core.h"+#include "LLVM/General/Internal/FFI/GlobalValue.h"  using namespace llvm;  extern "C" { +const Comdat *LLVM_General_GetCOMDAT(LLVMValueRef globalVal) {+  return unwrap<GlobalValue>(globalVal)->getComdat();+}++void LLVM_General_SetCOMDAT(LLVMValueRef globalObj, Comdat *comdat) {+  return unwrap<GlobalObject>(globalObj)->setComdat(comdat);+}++const char *LLVM_General_GetCOMDATName(const Comdat &comdat, size_t &size) {+  StringRef ref = comdat.getName();+  size = ref.size();+  return ref.data();+}++inline void LLVM_General_COMDAT_Selection_Kind_Enum_Matches() {+#define ENUM_CASE(n) static_assert(unsigned(Comdat::n) == unsigned(LLVM_General_COMDAT_Selection_Kind_ ## n), \+  "COMDAT SelectionKind Enum mismatch");+	LLVM_GENERAL_FOR_EACH_COMDAT_SELECTION_KIND(ENUM_CASE)+#undef ENUM_CASE+}++unsigned LLVM_General_GetCOMDATSelectionKind(const Comdat &comdat) {+  LLVM_General_COMDAT_Selection_Kind_Enum_Matches();+  return unsigned(comdat.getSelectionKind());+}++void LLVM_General_SetCOMDATSelectionKind(Comdat &comdat, unsigned csk) {+  LLVM_General_COMDAT_Selection_Kind_Enum_Matches();+  comdat.setSelectionKind(Comdat::SelectionKind(csk));+}+ LLVMBool LLVM_General_HasUnnamedAddr(LLVMValueRef globalVal) { 	return unwrap<GlobalValue>(globalVal)->hasUnnamedAddr(); }  void LLVM_General_SetUnnamedAddr(LLVMValueRef globalVal, LLVMBool isUnnamedAddr) { 	unwrap<GlobalValue>(globalVal)->setUnnamedAddr(isUnnamedAddr);+}++inline void LLVM_General_TLS_Model_Enum_Matches() {+#define ENUM_CASE(n) static_assert(unsigned(GlobalValue::n) == unsigned(LLVM ## n), "TLS Model Enum mismatch");+	LLVM_GENERAL_FOR_EACH_THREAD_LOCAL_MODE(ENUM_CASE)+#undef ENUM_CASE+}++LLVMThreadLocalMode LLVM_General_GetThreadLocalMode(LLVMValueRef globalVal) {+	LLVM_General_TLS_Model_Enum_Matches();+	return LLVMThreadLocalMode(unwrap<GlobalValue>(globalVal)->getThreadLocalMode());+}++void LLVM_General_SetThreadLocalMode(LLVMValueRef globalVal, LLVMThreadLocalMode mode) {+	LLVM_General_TLS_Model_Enum_Matches();+	unwrap<GlobalValue>(globalVal)->setThreadLocalMode(GlobalValue::ThreadLocalMode(mode)); }  }

@@ -29,9 +29,3 @@ foreign import ccall unsafe "LLVMSetInitializer" setInitializer ::     Ptr GlobalVariable -> Ptr Constant -> IO () -foreign import ccall unsafe "LLVMIsThreadLocal" isThreadLocal ::-    Ptr GlobalVariable -> IO LLVMBool--foreign import ccall unsafe "LLVMSetThreadLocal" setThreadLocal ::-    Ptr GlobalVariable -> LLVMBool -> IO ()-

@@ -54,4 +54,14 @@ #undef ENUM_CASE } LLVMFastMathFlags; +#define LLVM_GENERAL_FOR_EACH_TAIL_CALL_KIND(macro) \+	macro(None)                                       \+	macro(Tail)                                       \+	macro(MustTail)++typedef enum {+#define ENUM_CASE(x) LLVM_General_TailCallKind_ ## x,+LLVM_GENERAL_FOR_EACH_TAIL_CALL_KIND(ENUM_CASE)+#undef ENUM_CASE+} LLVM_General_TailCallKind; #endif

@@ -11,6 +11,7 @@ import Foreign.Ptr import Foreign.C +import LLVM.General.Internal.FFI.Attribute import LLVM.General.Internal.FFI.PtrHierarchy import LLVM.General.Internal.FFI.LLVMCTypes @@ -33,33 +34,27 @@ foreign import ccall unsafe "LLVM_General_GetFCmpPredicate" getFCmpPredicate ::   Ptr Instruction -> IO FCmpPredicate -foreign import ccall unsafe "LLVMGetInstructionCallConv" getInstructionCallConv ::-  Ptr Instruction -> IO CallConv+foreign import ccall unsafe "LLVM_General_GetCallSiteCallingConvention" getCallSiteCallingConvention ::+  Ptr Instruction -> IO CallingConvention -foreign import ccall unsafe "LLVMSetInstructionCallConv" setInstructionCallConv ::-  Ptr Instruction -> CallConv -> IO ()+foreign import ccall unsafe "LLVM_General_SetCallSiteCallingConvention" setCallSiteCallingConvention ::+  Ptr Instruction -> CallingConvention -> IO () -foreign import ccall unsafe "LLVMIsTailCall" isTailCall ::-  Ptr Instruction -> IO LLVMBool+foreign import ccall unsafe "LLVM_General_GetTailCallKind" getTailCallKind ::+  Ptr Instruction -> IO TailCallKind -foreign import ccall unsafe "LLVMSetTailCall" setTailCall ::-  Ptr Instruction -> LLVMBool -> IO ()+foreign import ccall unsafe "LLVM_General_SetTailCallKind" setTailCallKind ::+  Ptr Instruction -> TailCallKind -> IO () -foreign import ccall unsafe "LLVM_General_GetCallInstCalledValue" getCallInstCalledValue ::+foreign import ccall unsafe "LLVM_General_GetCallSiteCalledValue" getCallSiteCalledValue ::   Ptr Instruction -> IO (Ptr Value) -foreign import ccall unsafe "LLVM_General_GetCallInstFunctionAttr" getCallInstFunctionAttr ::-  Ptr Instruction -> IO FunctionAttr--foreign import ccall unsafe "LLVM_General_AddCallInstFunctionAttr" addCallInstFunctionAttr ::-  Ptr Instruction -> FunctionAttr -> IO ()--foreign import ccall unsafe "LLVM_General_GetCallInstAttr" getCallInstAttr ::-  Ptr Instruction -> CUInt -> IO ParamAttr--foreign import ccall unsafe "LLVM_General_AddCallInstAttr" addCallInstAttr ::-  Ptr Instruction -> CUInt -> ParamAttr -> IO ()+foreign import ccall unsafe "LLVM_General_GetCallSiteAttributeSet" getCallSiteAttributeSet ::+  Ptr Instruction -> IO MixedAttributeSet +foreign import ccall unsafe "LLVM_General_SetCallSiteAttributeSet" setCallSiteAttributeSet ::+  Ptr Instruction -> MixedAttributeSet -> IO ()+                      foreign import ccall unsafe "LLVMAddIncoming" addIncoming' ::   Ptr Instruction -> Ptr (Ptr Value) -> Ptr (Ptr BasicBlock) -> CUInt -> IO () @@ -104,8 +99,11 @@ foreign import ccall unsafe "LLVM_General_GetAtomicOrdering" getAtomicOrdering ::   Ptr Instruction -> IO MemoryOrdering +foreign import ccall unsafe "LLVM_General_GetFailureAtomicOrdering" getFailureAtomicOrdering ::+  Ptr Instruction -> IO MemoryOrdering+ foreign import ccall unsafe "LLVM_General_GetSynchronizationScope" getSynchronizationScope ::-  Ptr Instruction -> IO LLVMBool+  Ptr Instruction -> IO SynchronizationScope  getAtomicity i = return (,) `ap` getSynchronizationScope i `ap` getAtomicOrdering i 

@@ -6,11 +6,13 @@ #include "llvm/IR/Operator.h" #include "llvm/IR/BasicBlock.h" #include "llvm/IR/Metadata.h"-#include "llvm/Support/CallSite.h"+#include "llvm/IR/CallSite.h"  #include "llvm-c/Core.h" +#include "LLVM/General/Internal/FFI/AttributeC.hpp" #include "LLVM/General/Internal/FFI/Instruction.h"+#include "LLVM/General/Internal/FFI/CallingConventionC.hpp"  using namespace llvm; @@ -75,31 +77,48 @@ 	return wrap(unwrap<Instruction>(val)->getFastMathFlags()); } -LLVMValueRef LLVM_General_GetCallInstCalledValue(-	LLVMValueRef callInst-) {-	return wrap(CallSite(unwrap<Instruction>(callInst)).getCalledValue());+LLVMValueRef LLVM_General_GetCallSiteCalledValue(LLVMValueRef i) {+	return wrap(CallSite(unwrap<Instruction>(i)).getCalledValue()); } -LLVMAttribute LLVM_General_GetCallInstAttr(LLVMValueRef callInst, unsigned i) {-	return (LLVMAttribute)CallSite(unwrap<Instruction>(callInst)).getAttributes().Raw(i);+const AttributeSetImpl *LLVM_General_GetCallSiteAttributeSet(LLVMValueRef i) {+	return wrap(CallSite(unwrap<Instruction>(i)).getAttributes()); } -void LLVM_General_AddCallInstAttr(LLVMValueRef callInst, unsigned i, LLVMAttribute attr) {-	CallSite callSite(unwrap<Instruction>(callInst));-	LLVMContext &context = callSite->getContext();-	AttrBuilder attrBuilder(attr);-	callSite.setAttributes(callSite.getAttributes().addAttributes(context, i, AttributeSet::get(context, i, attrBuilder)));+void LLVM_General_SetCallSiteAttributeSet(LLVMValueRef i, const AttributeSetImpl *asi) {+	CallSite(unwrap<Instruction>(i)).setAttributes(unwrap(asi)); } -LLVMAttribute LLVM_General_GetCallInstFunctionAttr(LLVMValueRef callInst) {-	return LLVM_General_GetCallInstAttr(callInst, AttributeSet::FunctionIndex);+unsigned LLVM_General_GetCallSiteCallingConvention(LLVMValueRef i) {+  LLVM_General_CallingConventionEnumMatches();+  return unsigned(CallSite(unwrap<Instruction>(i)).getCallingConv()); } -void LLVM_General_AddCallInstFunctionAttr(LLVMValueRef callInst, LLVMAttribute attr) {-	LLVM_General_AddCallInstAttr(callInst, AttributeSet::FunctionIndex, attr);+void LLVM_General_SetCallSiteCallingConvention(LLVMValueRef i, unsigned cc) {+  LLVM_General_CallingConventionEnumMatches();+  CallSite(unwrap<Instruction>(i)).setCallingConv(llvm::CallingConv::ID(cc)); } +void LLVM_General_TailCallKindEnumMatches() {+#define CHECK(name)																											\+	static_assert(																												\+			unsigned(llvm::CallInst::TCK_ ## name) == unsigned(LLVM_General_TailCallKind_ ## name), \+			"LLVM_General_TailCallKind enum out of sync w/ llvm::CallInst::TailCallKind for " #name \+	);+	LLVM_GENERAL_FOR_EACH_TAIL_CALL_KIND(CHECK)+#undef CHECK+}++unsigned LLVM_General_GetTailCallKind(LLVMValueRef i) {+	LLVM_General_TailCallKindEnumMatches();+	return unwrap<CallInst>(i)->getTailCallKind();+}++void LLVM_General_SetTailCallKind(LLVMValueRef i, unsigned kind) {+	LLVM_General_TailCallKindEnumMatches();+	return unwrap<CallInst>(i)->setTailCallKind(llvm::CallInst::TailCallKind(kind));+}+ LLVMValueRef LLVM_General_GetAllocaNumElements(LLVMValueRef a) { 	return wrap(unwrap<AllocaInst>(a)->getArraySize()); }@@ -134,25 +153,32 @@  // ------------------------------------------------------------ -#define LLVM_GENERAL_FOR_EACH_ATOMIC_INST(macro) \-	macro(Load) \-	macro(Store) \-	macro(Fence) \-	macro(AtomicCmpXchg) \-	macro(AtomicRMW)+#define LLVM_GENERAL_FOR_EACH_ATOMIC_INST(macro)	\+	macro(Load,)																		\+	macro(Store,)																		\+	macro(Fence,)																		\+	macro(AtomicCmpXchg,Success)										\+	macro(AtomicRMW,)  LLVMAtomicOrdering LLVM_General_GetAtomicOrdering(LLVMValueRef i) { 	switch(unwrap<Instruction>(i)->getOpcode()) {-#define ENUM_CASE(n) case Instruction::n: return wrap(unwrap<n ## Inst>(i)->getOrdering());+#define ENUM_CASE(n,s) case Instruction::n: return wrap(unwrap<n ## Inst>(i)->get ## s ## Ordering()); 		LLVM_GENERAL_FOR_EACH_ATOMIC_INST(ENUM_CASE) #undef ENUM_CASE 	default: return LLVMAtomicOrdering(0); 	} } +LLVMAtomicOrdering LLVM_General_GetFailureAtomicOrdering(LLVMValueRef i) {+	switch(unwrap<Instruction>(i)->getOpcode()) {+	case Instruction::AtomicCmpXchg: return wrap(unwrap<AtomicCmpXchgInst>(i)->getFailureOrdering());+	default: return LLVMAtomicOrdering(0);+	}+}+ LLVMSynchronizationScope LLVM_General_GetSynchronizationScope(LLVMValueRef i) { 	switch(unwrap<Instruction>(i)->getOpcode()) {-#define ENUM_CASE(n) case Instruction::n: return wrap(unwrap<n ## Inst>(i)->getSynchScope());+#define ENUM_CASE(n,s) case Instruction::n: return wrap(unwrap<n ## Inst>(i)->getSynchScope()); 		LLVM_GENERAL_FOR_EACH_ATOMIC_INST(ENUM_CASE) #undef ENUM_CASE 	default: return LLVMSynchronizationScope(0);@@ -249,4 +275,3 @@ }  }-

@@ -12,12 +12,13 @@ #include "llvm-c/Target.h" #include "llvm-c/TargetMachine.h" #include "llvm-c/Linker.h"-#include "LLVM/General/Internal/FFI/Instruction.h"+#include "LLVM/General/Internal/FFI/Attribute.h"+#include "LLVM/General/Internal/FFI/Instruction.h"  #include "LLVM/General/Internal/FFI/Value.h" #include "LLVM/General/Internal/FFI/SMDiagnostic.h" #include "LLVM/General/Internal/FFI/InlineAssembly.h" #include "LLVM/General/Internal/FFI/Target.h"-#include "LLVM/General/Internal/FFI/Function.h"+#include "LLVM/General/Internal/FFI/CallingConvention.h" #include "LLVM/General/Internal/FFI/GlobalValue.h" #include "LLVM/General/Internal/FFI/Type.h" #include "LLVM/General/Internal/FFI/Constant.h"@@ -117,6 +118,16 @@ #define MO_Rec(n) { #n, LLVMAtomicOrdering ## n }, #{inject ATOMIC_ORDERING, MemoryOrdering, MemoryOrdering, memoryOrdering, MO_Rec} +newtype SynchronizationScope = SynchronizationScope CUInt+  deriving (Eq, Typeable, Data)+#define SS_Rec(n) { #n, LLVM ## n ## SynchronizationScope },+#{inject SYNCRONIZATION_SCOPE, SynchronizationScope, SynchronizationScope, synchronizationScope, SS_Rec}++newtype TailCallKind = TailCallKind CUInt+  deriving (Eq, Typeable, Data)+#define TCK_Rec(n) { #n, LLVM_General_TailCallKind_ ## n },+#{inject TAIL_CALL_KIND, TailCallKind, TailCallKind, tailCallKind, TCK_Rec}+ newtype Linkage = Linkage CUInt   deriving (Eq, Read, Show, Typeable, Data) #define LK_Rec(n) { #n, LLVM ## n ## Linkage },@@ -127,11 +138,26 @@ #define VIS_Rec(n) { #n, LLVM ## n ## Visibility }, #{inject VISIBILITY, Visibility, Visibility, visibility, VIS_Rec} -newtype CallConv = CallConv CUInt+newtype COMDATSelectionKind = COMDATSelectionKind CUInt   deriving (Eq, Read, Show, Typeable, Data)-#define CC_Rec(n) { #n, LLVM ## n ## CallConv },-#{inject CALLCONV, CallConv, CallConv, callConv, CC_Rec}+#define CSK(n) { #n, LLVM_General_COMDAT_Selection_Kind_ ## n },+#{inject COMDAT_SELECTION_KIND, COMDATSelectionKind, COMDATSelectionKind, comdatSelectionKind, CSK} +newtype DLLStorageClass = DLLStorageClass CUInt+  deriving (Eq, Read, Show, Typeable, Data)+#define DLLSC_Rec(n) { #n, LLVM ## n ## StorageClass },+#{inject DLL_STORAGE_CLASS, DLLStorageClass, DLLStorageClass, dllStorageClass, DLLSC_Rec}++newtype CallingConvention = CallingConvention CUInt+  deriving (Eq, Read, Show, Typeable, Data)+#define CC_Rec(l, n) { #l, LLVM_General_CallingConvention_ ## l },+#{inject CALLING_CONVENTION, CallingConvention, CallingConvention, callingConvention, CC_Rec}++newtype ThreadLocalMode = ThreadLocalMode CUInt+  deriving (Eq, Read, Show, Typeable, Data)+#define TLS_Rec(n) { #n, LLVM ## n },+#{inject THREAD_LOCAL_MODE, ThreadLocalMode, ThreadLocalMode, threadLocalMode, TLS_Rec}+ newtype ValueSubclassId = ValueSubclassId CUInt   deriving (Eq, Read, Show, Typeable, Data) #define VSID_Rec(n) { #n, LLVM ## n ## SubclassId },@@ -192,15 +218,25 @@ #define TK_Rec(n) { #n, LLVM ## n ## TypeKind }, #{inject TYPE_KIND, TypeKind, TypeKind, typeKind, TK_Rec} -newtype ParamAttr = ParamAttr CUInt-  deriving (Eq, Read, Show, Bits, Typeable, Data, Num)-#define PA_Rec(n,a) { #n, LLVM ## n ## a },-#{inject PARAM_ATTR, ParamAttr, ParamAttr, paramAttr, PA_Rec}+#define COMMA ,+#define IF_T(z) z+#define IF_F(z)+#define IF2(x) IF_ ## x+#define IF(x) IF2(x)+#define OR_TT T+#define OR_TF T+#define OR_FT T+#define OR_FF F  +#define OR(x,y) OR_ ## x ## y+newtype ParameterAttributeKind = ParameterAttributeKind CUInt+  deriving (Eq, Read, Show, Typeable, Data)+#define PAK_Rec(n,p,r,f) IF(OR(p,r))({ #n COMMA LLVM_General_AttributeKind_ ## n} COMMA)+#{inject ATTRIBUTE_KIND, ParameterAttributeKind, ParameterAttributeKind, parameterAttributeKind, PAK_Rec} -newtype FunctionAttr = FunctionAttr CUInt-  deriving (Eq, Read, Show, Bits, Typeable, Data, Num)-#define FA_Rec(n,a) { #n, LLVM ## n ## a },-#{inject FUNCTION_ATTR, FunctionAttr, FunctionAttr, functionAttr, FA_Rec}+newtype FunctionAttributeKind = FunctionAttributeKind CUInt+  deriving (Eq, Read, Show, Typeable, Data)+#define FAK_Rec(n,p,r,f) IF(f)({ #n COMMA LLVM_General_AttributeKind_ ## n} COMMA)+#{inject ATTRIBUTE_KIND, FunctionAttributeKind, FunctionAttributeKind, functionAttributeKind, FAK_Rec}  newtype FloatSemantics = FloatSemantics CUInt   deriving (Eq, Read, Show, Typeable, Data)

@@ -26,7 +26,7 @@ 	macro(dunder_isoc99_sscanf)										\ 	macro(memcpy_chk)															\ 	macro(sincospi_stret)													\-	macro(sincospi_stretf)												\+	macro(sincospif_stret)												\ 	macro(sinpi)																	\ 	macro(sinpif)																	\ 	macro(sqrt_finite)														\@@ -118,6 +118,12 @@ 	macro(floor)																	\ 	macro(floorf)																	\ 	macro(floorl)																	\+	macro(fmax)																		\+	macro(fmaxf)																	\+	macro(fmaxl)																	\+	macro(fmin)																		\+	macro(fminf)																	\+	macro(fminl)																	\ 	macro(fmod)																		\ 	macro(fmodf)																	\ 	macro(fmodl)																	\@@ -162,6 +168,9 @@ 	macro(isdigit)																\ 	macro(labs)																		\ 	macro(lchown)																	\+	macro(ldexp)																	\+	macro(ldexpf)																	\+	macro(ldexpl)																	\ 	macro(llabs)																	\ 	macro(log)																		\ 	macro(log10)																	\

@@ -9,8 +9,10 @@ import Foreign.C  import LLVM.General.Internal.FFI.Context+import LLVM.General.Internal.FFI.GlobalValue (COMDAT) import LLVM.General.Internal.FFI.LLVMCTypes import LLVM.General.Internal.FFI.PtrHierarchy+import LLVM.General.Internal.FFI.Type  data Module @@ -50,6 +52,9 @@ foreign import ccall unsafe "LLVM_General_GetNextAlias" getNextAlias ::   Ptr GlobalAlias -> IO (Ptr GlobalAlias) +foreign import ccall unsafe "LLVM_General_GetOrInsertCOMDAT" getOrInsertCOMDAT ::+  Ptr Module -> CString -> IO (Ptr COMDAT)+ foreign import ccall unsafe "LLVMGetFirstFunction" getFirstFunction ::   Ptr Module -> IO (Ptr Function) @@ -66,7 +71,7 @@   Ptr Module -> Ptr Type -> CString -> CUInt -> IO (Ptr GlobalVariable)  foreign import ccall unsafe "LLVM_General_JustAddAlias" justAddAlias ::-  Ptr Module -> Ptr Type -> CString -> IO (Ptr GlobalAlias)+  Ptr Module -> Ptr Type -> AddrSpace -> CString -> IO (Ptr GlobalAlias)   foreign import ccall unsafe "LLVMAddFunction" addFunction ::

@@ -23,8 +23,12 @@ 	return wrap(i); } -LLVMValueRef LLVM_General_JustAddAlias(LLVMModuleRef m, LLVMTypeRef ty, const char *name) {-	return wrap(new GlobalAlias(unwrap(ty), GlobalValue::ExternalLinkage, name, 0, unwrap(m)));+Comdat *LLVM_General_GetOrInsertCOMDAT(LLVMModuleRef m, const char *name) {+  return unwrap(m)->getOrInsertComdat(name);+}++LLVMValueRef LLVM_General_JustAddAlias(LLVMModuleRef m, LLVMTypeRef ty, unsigned addrspace, const char *name) {+	return wrap(GlobalAlias::create(unwrap(ty), addrspace, GlobalValue::ExternalLinkage, name, 0, unwrap(m))); }  NamedMDNode *LLVM_General_GetOrAddNamedMetadata(LLVMModuleRef m, const char *name) {

@@ -3,8 +3,10 @@ #include "llvm/IR/DataLayout.h" #include "llvm/Transforms/Scalar.h" #include "llvm/Transforms/IPO.h"+#include "llvm/Transforms/IPO/PassManagerBuilder.h" #include "llvm/Transforms/Vectorize.h" #include "llvm/Transforms/Instrumentation.h"+#include "llvm/CodeGen/Passes.h" #include "llvm/PassManager.h" #include "llvm-c/Target.h" #include "llvm-c/Transforms/PassManagerBuilder.h"@@ -51,10 +53,6 @@  extern "C" { -void LLVM_General_AddDataLayoutPass(LLVMPassManagerRef PM, const char *dl) {-	unwrap(PM)->add(new DataLayout(dl));-}- void LLVM_General_LLVMAddAnalysisPasses(LLVMTargetMachineRef T, LLVMPassManagerRef PM) { 	unwrap(T)->addAnalysisPasses(*unwrap(PM)); }@@ -99,8 +97,8 @@ 	unwrap(PM)->add(createLoopStrengthReducePass()); } -void LLVM_General_AddLowerInvokePass(LLVMPassManagerRef PM, LLVMTargetMachineRef T, LLVMBool expensiveEH) {-	unwrap(PM)->add(createLowerInvokePass(unwrap(T), expensiveEH));+void LLVM_General_AddLowerInvokePass(LLVMPassManagerRef PM) {+	unwrap(PM)->add(createLowerInvokePass()); } 	 void LLVM_General_AddSROAPass(LLVMPassManagerRef PM, LLVMBool RequiresDomTree) {@@ -179,46 +177,28 @@ }  void LLVM_General_AddAddressSanitizerFunctionPass(-	LLVMPassManagerRef PM,-	LLVMBool checkInitOrder,-	LLVMBool checkUseAfterReturn,-	LLVMBool checkLifetime,-	char *blacklistFile,-	LLVMBool zeroBaseShadow+	LLVMPassManagerRef PM ) {-	unwrap(PM)->add(-		createAddressSanitizerFunctionPass(-			checkInitOrder,-			checkUseAfterReturn,-			checkLifetime,-			blacklistFile,-			zeroBaseShadow-		)-	);+	unwrap(PM)->add(createAddressSanitizerFunctionPass()); }  void LLVM_General_AddAddressSanitizerModulePass(-	LLVMPassManagerRef PM,-	LLVMBool checkInitOrder,-	const char *blacklistFile,-	bool zeroBaseShadow+	LLVMPassManagerRef PM ) {-	unwrap(PM)->add(createAddressSanitizerModulePass(checkInitOrder, blacklistFile, zeroBaseShadow));+	unwrap(PM)->add(createAddressSanitizerModulePass()); }  void LLVM_General_AddMemorySanitizerPass( 	LLVMPassManagerRef PM,-	LLVMBool trackOrigins,-	const char *blacklistFile+	LLVMBool trackOrigins ) {-	unwrap(PM)->add(createMemorySanitizerPass(trackOrigins, blacklistFile));+	unwrap(PM)->add(createMemorySanitizerPass(trackOrigins)); }  void LLVM_General_AddThreadSanitizerPass(-	LLVMPassManagerRef PM,-	const char *blacklistFile+	LLVMPassManagerRef PM ) {-	unwrap(PM)->add(createThreadSanitizerPass(blacklistFile));+	unwrap(PM)->add(createThreadSanitizerPass()); }  void LLVM_General_AddBoundsCheckingPass(LLVMPassManagerRef PM) {@@ -248,9 +228,10 @@  void LLVM_General_AddLoopVectorizePass( 	LLVMPassManagerRef PM,-	LLVMBool noUnrolling+	LLVMBool noUnrolling,+	LLVMBool alwaysVectorize ) {-	unwrap(PM)->add(createLoopVectorizePass(noUnrolling));+	unwrap(PM)->add(createLoopVectorizePass(noUnrolling, alwaysVectorize)); }  void LLVM_General_PassManagerBuilderSetLibraryInfo(

@@ -46,10 +46,15 @@  instance ChildOf Constant GlobalValue +-- | <http://llvm.org/doxygen/classllvm_1_1GlobalObject.html>+data GlobalObject++instance ChildOf GlobalValue GlobalObject+ -- | <http://llvm.org/doxygen/classllvm_1_1GlobalVariable.html> data GlobalVariable -instance ChildOf GlobalValue GlobalVariable+instance ChildOf GlobalObject GlobalVariable  -- | <http://llvm.org/doxygen/classllvm_1_1GlobalAlias.html> data GlobalAlias@@ -59,7 +64,7 @@ -- | <http://llvm.org/doxygen/classllvm_1_1Function.html> data Function -instance ChildOf GlobalValue Function+instance ChildOf GlobalObject Function  -- | <http://llvm.org/doxygen/classllvm_1_1BasicBlock.html> data BasicBlock

@@ -1,23 +1,24 @@ #define __STDC_LIMIT_MACROS #include "llvm/Support/raw_ostream.h"+#include "llvm/Support/FileSystem.h" #include "llvm-c/Core.h"  using namespace llvm; using sys::fs::F_None; using sys::fs::F_Excl;-using sys::fs::F_Binary;+using sys::fs::F_Text;  extern "C" {  LLVMBool LLVM_General_WithFileRawOStream( 	const char *filename, 	LLVMBool excl,-	LLVMBool binary,+	LLVMBool text, 	const char *&error, 	void (&callback)(raw_ostream &ostream) ) { 	std::string e;-	raw_fd_ostream os(filename, e, (excl ? F_Excl : F_None) | (binary ? F_Binary : F_None));+	raw_fd_ostream os(filename, e, (excl ? F_Excl : F_None) | (text ? F_Text : F_None)); 	if (!e.empty()) { 		error = strdup(e.c_str()); 		return false;

@@ -41,8 +41,10 @@ 	macro(DisableTailCalls)																\ 	macro(EnableFastISel)																	\ 	macro(PositionIndependentExecutable)									\-	macro(EnableSegmentedStacks)													\-	macro(UseInitArray)+	macro(UseInitArray)																		\+	macro(DisableIntegratedAS)														\+	macro(CompressDebugSections)													\+	macro(TrapUnreachable)  typedef enum { #define ENUM_CASE(n) LLVM_General_TargetOptionFlag_ ## n,

@@ -95,7 +95,7 @@   IO (OwnerTransfered CString)  foreign import ccall unsafe "LLVM_General_GetHostCPUName" getHostCPUName :: -  IO (OwnerTransfered CString)+  Ptr CSize -> IO CString  foreign import ccall unsafe "LLVM_General_GetHostCPUFeatures" getHostCPUFeatures ::    IO (OwnerTransfered CString)

@@ -254,19 +254,20 @@ 	return strdup(sys::getProcessTriple().c_str()); } -char *LLVM_General_GetHostCPUName() {-	return strdup(sys::getHostCPUName().c_str());+const char *LLVM_General_GetHostCPUName(size_t &len) {+	StringRef r = sys::getHostCPUName();+	len = r.size();+	return r.data(); }  char *LLVM_General_GetHostCPUFeatures() { 	StringMap<bool> featureMap; 	std::string features; 	if (sys::getHostCPUFeatures(featureMap)) {-		bool first = true; 		for(llvm::StringMap<bool>::const_iterator it = featureMap.begin(); it != featureMap.end(); ++it) {-			if (!first) { features += ","; }-			first = false;-			features += (it->second ? "+" : "-") + it->first().str();+			if (it->second) {+				features += it->first().str() + " ";+			} 		} 	} 	return strdup(features.c_str());@@ -338,7 +339,7 @@ 		return true; 	} 	PassManager passManager;-	passManager.add(new DataLayout(*td));+	passManager.add(new DataLayoutPass(*td)); 	if (tm.addPassesToEmitFile(passManager, destf, unwrap(codeGenFileType))) { 		*ErrorMessage = strdup("TargetMachine can't emit a file of this type"); 		return true;

@@ -9,11 +9,5 @@  import LLVM.General.Internal.FFI.LLVMCTypes -foreign import ccall unsafe "LLVMStartMultithreaded" startMultithreaded ::-  IO LLVMBool--foreign import ccall unsafe "LLVMStopMultithreaded" stopMultithreaded ::-  IO ()- foreign import ccall unsafe "LLVMIsMultithreaded" isMultithreaded ::   IO LLVMBool

@@ -5,7 +5,6 @@  -- | does the constructor for this pass require a TargetMachine object needsTargetMachine "CodeGenPrepare" = True-needsTargetMachine "LowerInvoke" = True needsTargetMachine _ = False  -- | Translate a Haskell name (used in the public Haskell interface, typically not abbreviated)

@@ -22,8 +22,6 @@ 	macro(MDNode) \ 	macro(MDString) \ 	macro(InlineAsm) \-	macro(PseudoSourceValue) \-	macro(FixedStackPseudoSourceValue) \ 	macro(Instruction)  typedef enum {

@@ -5,8 +5,12 @@ import Control.Monad.Trans import Control.Monad.AnyCont -import Foreign.Ptr+import Foreign.C (CUInt)+import Foreign.Ptr   +import Data.Map (Map)+import qualified Data.Map as Map+ import qualified LLVM.General.Internal.FFI.Function as FFI import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI @@ -14,34 +18,43 @@ import LLVM.General.Internal.EncodeAST import LLVM.General.Internal.Value import LLVM.General.Internal.Coding-import LLVM.General.Internal.Attribute ()+import LLVM.General.Internal.Constant ()+import LLVM.General.Internal.Attribute  import qualified LLVM.General.AST as A-import qualified LLVM.General.AST.Attribute as A.A--getFunctionAttrs :: Ptr FFI.Function -> IO [A.A.FunctionAttribute]-getFunctionAttrs = decodeM <=< FFI.getFunctionAttr+import qualified LLVM.General.AST.Constant as A+import qualified LLVM.General.AST.ParameterAttribute as A.PA   -setFunctionAttrs :: Ptr FFI.Function -> [A.A.FunctionAttribute] -> IO ()-setFunctionAttrs f = FFI.addFunctionAttr f <=< encodeM +getMixedAttributeSet :: Ptr FFI.Function -> DecodeAST MixedAttributeSet+getMixedAttributeSet = decodeM <=< liftIO . FFI.getMixedAttributeSet -getParameterAttrs :: Ptr FFI.Parameter -> IO [A.A.ParameterAttribute]-getParameterAttrs = decodeM <=< FFI.getAttribute+setFunctionAttributes :: Ptr FFI.Function -> MixedAttributeSet -> EncodeAST ()+setFunctionAttributes f = (liftIO . FFI.setMixedAttributeSet f) <=< encodeM -getParameters :: Ptr FFI.Function -> DecodeAST [A.Parameter]-getParameters f = scopeAnyCont $ do+getParameters :: Ptr FFI.Function -> Map CUInt [A.PA.ParameterAttribute] -> DecodeAST [A.Parameter]+getParameters f attrs = scopeAnyCont $ do   n <- liftIO (FFI.countParams f)   ps <- allocaArray n   liftIO $ FFI.getParams f ps   params <- peekArray n ps-  forM params $ \param -> +  forM (zip params [0..]) $ \(param, i) ->      return A.Parameter         `ap` typeOf param        `ap` getLocalName param-       `ap` (liftIO $ getParameterAttrs param)+       `ap` (return $ Map.findWithDefault [] i attrs)    getGC :: Ptr FFI.Function -> DecodeAST (Maybe String) getGC f = scopeAnyCont $ decodeM =<< liftIO (FFI.getGC f)  setGC :: Ptr FFI.Function -> Maybe String -> EncodeAST () setGC f gc = scopeAnyCont $ liftIO . FFI.setGC f =<< encodeM gc ++getPrefixData :: Ptr FFI.Function -> DecodeAST (Maybe A.Constant)+getPrefixData f = do+  has <- decodeM =<< (liftIO $ FFI.hasPrefixData f)+  if has+   then decodeM =<< (liftIO $ FFI.getPrefixData f)+   else return Nothing++setPrefixData :: Ptr FFI.Function -> Maybe A.Constant -> EncodeAST ()+setPrefixData f = maybe (return ()) (liftIO . FFI.setPrefixData f <=< encodeM)

@@ -6,9 +6,10 @@  import LLVM.General.Prelude -import Control.Monad.IO.Class-import Foreign.Ptr+import Control.Monad.State import Control.Monad.AnyCont+import Foreign.Ptr+import qualified Data.Map as Map  import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI@@ -20,6 +21,9 @@  import qualified LLVM.General.AST.Linkage as A.L import qualified LLVM.General.AST.Visibility as A.V+import qualified LLVM.General.AST.COMDAT as A.COMDAT+import qualified LLVM.General.AST.DLL as A.DLL+import qualified LLVM.General.AST.ThreadLocalStorage as A.TLS  genCodingInstance [t| A.L.Linkage |] ''FFI.Linkage [   (FFI.linkageExternal, A.L.External),@@ -31,12 +35,8 @@   (FFI.linkageAppending, A.L.Appending),   (FFI.linkageInternal, A.L.Internal),   (FFI.linkagePrivate, A.L.Private),-  (FFI.linkageDLLImport, A.L.DLLImport),-  (FFI.linkageDLLExport, A.L.DLLExport),   (FFI.linkageExternalWeak, A.L.ExternWeak),-  (FFI.linkageCommon, A.L.Common),-  (FFI.linkageLinkerPrivate, A.L.LinkerPrivate),-  (FFI.linkageLinkerPrivateWeak, A.L.LinkerPrivateWeak)+  (FFI.linkageCommon, A.L.Common)  ]  getLinkage :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST A.L.Linkage@@ -57,6 +57,18 @@ setVisibility :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> A.V.Visibility -> EncodeAST () setVisibility g v = liftIO . FFI.setVisibility (FFI.upCast g) =<< encodeM v +genCodingInstance [t| Maybe A.DLL.StorageClass |] ''FFI.DLLStorageClass [+  (FFI.dllStorageClassDefault, Nothing),+  (FFI.dllStorageClassDLLImport, Just A.DLL.Import),+  (FFI.dllStorageClassDLLExport, Just A.DLL.Export)+ ]++getDLLStorageClass :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe A.DLL.StorageClass)+getDLLStorageClass g = liftIO $ decodeM =<< FFI.getDLLStorageClass (FFI.upCast g)++setDLLStorageClass :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe A.DLL.StorageClass -> EncodeAST ()+setDLLStorageClass g sc = liftIO . FFI.setDLLStorageClass (FFI.upCast g) =<< encodeM sc+ getSection :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe String) getSection g = liftIO $ do   s <- decodeM =<< FFI.getSection (FFI.upCast g)@@ -67,8 +79,56 @@   s <- encodeM (maybe "" id s)   liftIO $ FFI.setSection (FFI.upCast g) s +genCodingInstance [t| A.COMDAT.SelectionKind |] ''FFI.COMDATSelectionKind [+  (FFI.comdatSelectionKindAny, A.COMDAT.Any),+  (FFI.comdatSelectionKindExactMatch, A.COMDAT.ExactMatch),+  (FFI.comdatSelectionKindLargest, A.COMDAT.Largest),+  (FFI.comdatSelectionKindNoDuplicates, A.COMDAT.NoDuplicates),+  (FFI.comdatSelectionKindSameSize, A.COMDAT.SameSize)+ ]++instance DecodeM DecodeAST (String, A.COMDAT.SelectionKind) (Ptr FFI.COMDAT) where+  decodeM c = return (,)+              `ap` (decodeM $ FFI.getCOMDATName c)+              `ap` (decodeM =<< liftIO (FFI.getCOMDATSelectionKind c))++getCOMDATName :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe String)+getCOMDATName g = do+  c <- liftIO $ FFI.getCOMDAT (FFI.upCast g)+  if c == nullPtr+   then return Nothing+   else do+     cds <- gets comdats+     liftM Just $ case Map.lookup c cds of+       Just (name, _) -> return name+       Nothing -> do+          cd@(name, _) <- decodeM c+          modify $ \s -> s { comdats = Map.insert c cd cds }+          return name++setCOMDAT :: FFI.DescendentOf FFI.GlobalObject v => Ptr v -> Maybe String -> EncodeAST ()+setCOMDAT _ Nothing = return ()+setCOMDAT g (Just name) = do+  cd <- referCOMDAT name+  liftIO $ FFI.setCOMDAT (FFI.upCast g) cd+ setAlignment :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Word32 -> EncodeAST () setAlignment g i = liftIO $ FFI.setAlignment (FFI.upCast g) (fromIntegral i)  getAlignment :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST Word32 getAlignment g = liftIO $ fromIntegral <$> FFI.getAlignment (FFI.upCast g)++genCodingInstance [t| Maybe A.TLS.Model |] ''FFI.ThreadLocalMode [+  (FFI.threadLocalModeNotThreadLocal, Nothing),+  (FFI.threadLocalModeGeneralDynamicTLSModel, Just A.TLS.GeneralDynamic),+  (FFI.threadLocalModeLocalDynamicTLSModel, Just A.TLS.LocalDynamic),+  (FFI.threadLocalModeInitialExecTLSModel, Just A.TLS.InitialExec),+  (FFI.threadLocalModeLocalExecTLSModel, Just A.TLS.LocalExec)+ ]++getThreadLocalMode :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe A.TLS.Model)+getThreadLocalMode g = liftIO $ decodeM =<< FFI.getThreadLocalMode (FFI.upCast g)++setThreadLocalMode :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe A.TLS.Model -> EncodeAST ()+setThreadLocalMode g m = liftIO . FFI.setThreadLocalMode (FFI.upCast g) =<< encodeM m+                        

@@ -33,7 +33,7 @@ import qualified LLVM.General.Internal.FFI.BasicBlock as FFI  import LLVM.General.Internal.Atomicity ()-import LLVM.General.Internal.Attribute ()+import LLVM.General.Internal.Attribute import LLVM.General.Internal.CallingConvention () import LLVM.General.Internal.Coding import LLVM.General.Internal.DecodeAST@@ -42,13 +42,15 @@ import LLVM.General.Internal.Metadata () import LLVM.General.Internal.Operand () import LLVM.General.Internal.RMWOperation ()+import LLVM.General.Internal.TailCallKind () import LLVM.General.Internal.Type import LLVM.General.Internal.Value  import qualified LLVM.General.AST as A import qualified LLVM.General.AST.Constant as A.C -callInstAttr i j = liftIO $ decodeM =<< FFI.getCallInstAttr i j+callInstAttributeSet :: Ptr FFI.Instruction -> DecodeAST MixedAttributeSet+callInstAttributeSet = decodeM <=< liftIO . FFI.getCallSiteAttributeSet  meta :: Ptr FFI.Instruction -> DecodeAST A.InstructionMetadata meta i = do@@ -121,20 +123,21 @@            A.metadata' = md         }       [instrP|Invoke|] -> do-        cc <- decodeM =<< liftIO (FFI.getInstructionCallConv i)-        rAttrs <- callInstAttr i 0-        fv <- liftIO $ FFI.getCallInstCalledValue i+        cc <- decodeM =<< liftIO (FFI.getCallSiteCallingConvention i)+        attrs <- callInstAttributeSet i+        fv <- liftIO $ FFI.getCallSiteCalledValue i         f <- decodeM fv-        args <- forM [1..nOps-3] $ \j -> return (,) `ap` op (j-1) `ap` callInstAttr i j-        fAttrs <- decodeM =<< liftIO (FFI.getCallInstFunctionAttr i)+        args <- forM [1..nOps-3] $ \j -> do+                  let pAttrs = Map.findWithDefault [] (j-1) (parameterAttributes attrs)+                  return (, pAttrs) `ap` op (j-1)          rd <- successor (nOps - 2)         ed <- successor (nOps - 1)         return A.Invoke {           A.callingConvention' = cc,-          A.returnAttributes' = rAttrs,+          A.returnAttributes' = returnAttributes attrs,           A.function' = f,           A.arguments' = args,-          A.functionAttributes' = fAttrs,+          A.functionAttributes' = functionAttributes attrs,           A.returnDest = rd,           A.exceptionDest = ed,           A.metadata' = md@@ -204,13 +207,10 @@         let (argvs, argAttrs) = unzip args         (n, argvs) <- encodeM argvs         i <- liftIO $ FFI.buildInvoke builder fv argvs n rb eb s-        forM (zip (rAttrs : argAttrs) [0..]) $ \(attrs, j) -> do-          attrs <- encodeM attrs-          liftIO $ FFI.addCallInstAttr i j attrs-        fAttrs <- encodeM fAttrs-        liftIO $ FFI.addCallInstFunctionAttr i fAttrs+        attrs <- encodeM $ MixedAttributeSet fAttrs rAttrs (Map.fromList (zip [0..] argAttrs))+        liftIO $ FFI.setCallSiteAttributeSet i attrs         cc <- encodeM cc-        liftIO $ FFI.setInstructionCallConv i cc+        liftIO $ FFI.setCallSiteCallingConvention i cc         return $ FFI.upCast i       A.Resume {          A.operand0' = op0@@ -269,20 +269,23 @@                 "metadata" -> ([], [| meta i |])                 "iPredicate" -> ([], [| decodeM =<< liftIO (FFI.getICmpPredicate i) |])                 "fpPredicate" -> ([], [| decodeM =<< liftIO (FFI.getFCmpPredicate i) |])-                "isTailCall" -> ([], [| decodeM =<< liftIO (FFI.isTailCall i) |])-                "callingConvention" -> ([], [| decodeM =<< liftIO (FFI.getInstructionCallConv i) |])-                "returnAttributes" -> ([], [| callInstAttr i 0 |])-                "f" -> ([], [| liftIO $ FFI.getCallInstCalledValue i |])+                "tailCallKind" -> ([], [| decodeM =<< liftIO (FFI.getTailCallKind i) |])+                "callingConvention" -> ([], [| decodeM =<< liftIO (FFI.getCallSiteCallingConvention i) |])+                "attrs" -> ([], [| callInstAttributeSet i |])+                "returnAttributes" -> (["attrs"], [| return $ returnAttributes $(TH.dyn "attrs") |])+                "f" -> ([], [| liftIO $ FFI.getCallSiteCalledValue i |])                 "function" -> (["f"], [| decodeM $(TH.dyn "f") |])-                "arguments" -> ([], [| forM [1..nOps-1] $ \j -> return (,) `ap` op (j-1) `ap` callInstAttr i j |])+                "arguments" -> ([], [| forM [1..nOps-1] $ \j -> do+                                         let pAttrs = Map.findWithDefault [] (j-1) (parameterAttributes $(TH.dyn "attrs"))+                                         p <- op (j-1)+                                         return (p, pAttrs) |])                 "clauses" ->                    ([], [| forM [1..nOps-1] $ \j -> do                           v <- liftIO $ FFI.getOperand (FFI.upCast i) j                           c <- decodeM =<< (liftIO $ FFI.isAConstant v)                           t <- typeOf v                           return $ case t of { A.ArrayType _ _ -> A.Filter; _ -> A.Catch} $ c |])-                "functionAttributes" ->-                    ([], [| decodeM =<< liftIO (FFI.getCallInstFunctionAttr i) |])+                "functionAttributes" -> (["attrs"], [| return $ functionAttributes $(TH.dyn "attrs") |])                 "type'" -> ([], [| return t |])                 "incomingValues" ->                     ([], [| do@@ -304,6 +307,7 @@                 "atomicity" -> ([], [| decodeM =<< liftIO (FFI.getAtomicity i) |])                 "volatile" -> ([], [| decodeM =<< liftIO (FFI.getVolatile i) |])                 "inBounds" -> ([], [| decodeM =<< liftIO (FFI.getInBounds (FFI.upCast i)) |])+                "failureMemoryOrdering" -> ([], [| decodeM =<< liftIO (FFI.getFailureAtomicOrdering i) |])                 "indices" -> ([], [| mapM op [1..nOps-1] |])                 "indices'" ->                   ([], [| do@@ -376,7 +380,7 @@                  liftIO $ FFI.addIncoming i ivs3' bs3'                )           A.Call {-            A.isTailCall = tc,+            A.tailCallKind = tck,             A.callingConvention = cc,             A.returnAttributes = rAttrs,             A.function = f,@@ -387,16 +391,12 @@             let (argvs, argAttrs) = unzip args             (n, argvs) <- encodeM argvs             i <- liftIO $ FFI.buildCall builder fv argvs n s-            forM (zip (rAttrs : argAttrs) [0..]) $ \(attrs, j) -> do-              attrs <- encodeM attrs-              liftIO $ FFI.addCallInstAttr i j attrs-            fAttrs <- encodeM fAttrs-            liftIO $ FFI.addCallInstFunctionAttr i fAttrs-            when tc $ do-              tc <- encodeM tc-              liftIO $ FFI.setTailCall i tc+            attrs <- encodeM $ MixedAttributeSet fAttrs rAttrs (Map.fromList (zip [0..] argAttrs))+            liftIO $ FFI.setCallSiteAttributeSet i attrs     +            tck <- encodeM tck+            liftIO $ FFI.setTailCallKind i tck             cc <- encodeM cc-            liftIO $ FFI.setInstructionCallConv i cc+            liftIO $ FFI.setCallSiteCallingConvention i cc             return' i           A.Select { A.condition' = c, A.trueValue = t, A.falseValue = f } -> do             c' <- encodeM c

@@ -10,6 +10,7 @@ import LLVM.General.Prelude  import Control.Monad.Trans+import Control.Monad.Trans.Except (runExcept) import Control.Monad.State (gets) import Control.Monad.Exceptable import Control.Monad.AnyCont@@ -38,7 +39,8 @@ import qualified LLVM.General.Internal.FFI.Target as FFI import qualified LLVM.General.Internal.FFI.Value as FFI -import LLVM.General.Internal.BasicBlock+import LLVM.General.Internal.Attribute+import LLVM.General.Internal.BasicBlock   import LLVM.General.Internal.Coding import LLVM.General.Internal.Context import LLVM.General.Internal.DecodeAST@@ -135,7 +137,7 @@ -- | write LLVM assembly for a 'Module' to a file writeLLVMAssemblyToFile :: File -> Module -> ExceptT String IO () writeLLVMAssemblyToFile (File path) (Module m) = unExceptableT $ flip runAnyContT return $ do-  withFileRawOStream path False False $ liftIO . FFI.writeLLVMAssembly m+  withFileRawOStream path False True $ liftIO . FFI.writeLLVMAssembly m  class BitcodeInput b where   bitcodeMemoryBuffer :: (Inject String e, MonadError e m, MonadIO m, MonadAnyCont IO m)@@ -165,7 +167,7 @@ -- | write LLVM bitcode from a 'Module' into a file writeBitcodeToFile :: File -> Module -> ExceptT String IO () writeBitcodeToFile (File path) (Module m) = unExceptableT $ flip runAnyContT return $ do-  withFileRawOStream path False True $ liftIO . FFI.writeBitcode m+  withFileRawOStream path False False $ liftIO . FFI.writeBitcode m  targetMachineEmit :: FFI.CodeGenFileType -> TargetMachine -> Module -> Ptr FFI.RawOStream -> ExceptT String IO () targetMachineEmit fileType (TargetMachine tm) (Module m) os = unExceptableT $ flip runAnyContT return $ do@@ -175,7 +177,7 @@  emitToFile :: FFI.CodeGenFileType -> TargetMachine -> File -> Module -> ExceptT String IO () emitToFile fileType tm (File path) m = unExceptableT$ flip runAnyContT return $ do-  withFileRawOStream path False True $ targetMachineEmit fileType tm m+  withFileRawOStream path False False $ targetMachineEmit fileType tm m  emitToByteString :: FFI.CodeGenFileType -> TargetMachine -> Module -> ExceptT String IO BS.ByteString emitToByteString fileType tm m = unExceptableT $ flip runAnyContT return $ do@@ -213,7 +215,9 @@   liftIO $ FFI.setDataLayout m s  getDataLayout :: Ptr FFI.Module -> IO (Maybe A.DataLayout)-getDataLayout m = parseDataLayout <$> (decodeM =<< FFI.getDataLayout m)+getDataLayout m = do+  dlString <- decodeM =<< FFI.getDataLayout m+  either fail return . runExcept . parseDataLayout A.BigEndian $ dlString  -- | Build an LLVM.General.'Module' from a LLVM.General.AST.'LLVM.General.AST.Module' - i.e. -- lower an AST from Haskell into C++ objects.@@ -232,8 +236,16 @@      defineType n t'      return $ do        maybe (return ()) (setNamedType t') t-       return . return . return $ return ()+       return . return . return . return $ () +   A.COMDAT n csk -> do+     n' <- encodeM n+     csk <- encodeM csk+     cd <- liftIO $ FFI.getOrInsertCOMDAT m n'+     liftIO $ FFI.setCOMDATSelectionKind cd csk+     defineCOMDAT n cd+     return . return . return . return . return $ ()+         A.MetadataNodeDefinition i os -> return . return $ do      t <- liftIO $ FFI.createTemporaryMDNodeInContext c      defineMDNode i t@@ -254,8 +266,13 @@    A.ModuleInlineAssembly s -> do      s <- encodeM s      liftIO $ FFI.moduleAppendInlineAsm m (FFI.ModuleAsm s)-     return . return . return . return $ return ()+     return . return . return . return . return $ () +   A.FunctionAttributes gid attrs -> do+     attrs <- encodeM attrs+     defineAttributeGroup gid attrs+     return . return . return . return . return $ ()+    A.GlobalDefinition g -> return . phase $ do      eg' :: EncodeAST (Ptr FFI.GlobalValue) <- case g of        g@(A.GlobalVariable { A.G.name = n }) -> do@@ -264,9 +281,8 @@                    FFI.addGlobalInAddressSpace m typ gName                           (fromIntegral ((\(A.AddrSpace a) -> a) $ A.G.addrSpace g))          defineGlobal n g'+         setThreadLocalMode g' (A.G.threadLocalMode g)          liftIO $ do-           tl <- encodeM (A.G.isThreadLocal g)-           FFI.setThreadLocal g' tl            hua <- encodeM (A.G.hasUnnamedAddr g)            FFI.setUnnamedAddr (FFI.upCast g') hua            ic <- encodeM (A.G.isConstant g)@@ -274,25 +290,32 @@          return $ do            maybe (return ()) ((liftIO . FFI.setInitializer g') <=< encodeM) (A.G.initializer g)            setSection g' (A.G.section g)+           setCOMDAT g' (A.G.comdat g)            setAlignment g' (A.G.alignment g)            return (FFI.upCast g')        (a@A.G.GlobalAlias { A.G.name = n }) -> do-         typ <- encodeM (A.G.type' a)-         a' <- liftIO $ withName n $ \name -> FFI.justAddAlias m typ name+         let A.PointerType typ as = A.G.type' a+         typ <- encodeM typ+         as <- encodeM as+         a' <- liftIO $ withName n $ \name -> FFI.justAddAlias m typ as name          defineGlobal n a'+         liftIO $ do+           hua <- encodeM (A.G.hasUnnamedAddr a)+           FFI.setUnnamedAddr (FFI.upCast a') hua          return $ do+           setThreadLocalMode a' (A.G.threadLocalMode a)            (liftIO . FFI.setAliasee a') =<< encodeM (A.G.aliasee a)            return (FFI.upCast a')-       (A.Function _ _ cc rAttrs resultType fName (args,isVarArgs) attrs _ _ gc blocks) -> do-         typ <- encodeM $ A.FunctionType resultType (map (\(A.Parameter t _ _) -> t) args) isVarArgs+       (A.Function _ _ _ cc rAttrs resultType fName (args, isVarArgs) attrs _ _ _ gc prefix blocks) -> do+         typ <- encodeM $ A.FunctionType resultType [t | A.Parameter t _ _ <- args] isVarArgs          f <- liftIO . withName fName $ \fName -> FFI.addFunction m fName typ          defineGlobal fName f          cc <- encodeM cc-         liftIO $ FFI.setFunctionCallConv f cc-         rAttrs <- encodeM rAttrs-         liftIO $ FFI.addFunctionRetAttr f rAttrs-         liftIO $ setFunctionAttrs f attrs+         liftIO $ FFI.setFunctionCallingConvention f cc+         setFunctionAttributes f (MixedAttributeSet attrs rAttrs (Map.fromList $ zip [0..] [pa | A.Parameter _ _ pa <- args]))+         setPrefixData f prefix          setSection f (A.G.section g)+         setCOMDAT f (A.G.comdat g)          setAlignment f (A.G.alignment g)          setGC f gc          forM blocks $ \(A.BasicBlock bName _ _) -> do@@ -303,15 +326,10 @@            ps <- allocaArray nParams            liftIO $ FFI.getParams f ps            params <- peekArray nParams ps-           forM (zip args params) $ \(A.Parameter _ n attrs, p) -> do+           forM (zip args params) $ \(A.Parameter _ n _, p) -> do              defineLocal n p              n <- encodeM n              liftIO $ FFI.setValueName (FFI.upCast p) n-             unless (null attrs) $-                    do attrs <- encodeM attrs-                       liftIO $ FFI.addAttribute p attrs-                       return ()-             return ()            finishInstrs <- forM blocks $ \(A.BasicBlock bName namedInstrs term) -> do              b <- encodeM bName              (do@@ -328,6 +346,7 @@        g' <- eg'        setLinkage g' (A.G.linkage g)        setVisibility g' (A.G.visibility g)+       setDLLStorageClass g' (A.G.dllStorageClass g)        return $ return ()    liftIO $ f (Module m)@@ -356,7 +375,8 @@                `ap` return n                `ap` getLinkage g                `ap` getVisibility g-               `ap` (liftIO $ decodeM =<< FFI.isThreadLocal g)+               `ap` getDLLStorageClass g+               `ap` getThreadLocalMode g                `ap` return as                `ap` (liftIO $ decodeM =<< FFI.hasUnnamedAddr (FFI.upCast g))                `ap` (liftIO $ decodeM =<< FFI.isGlobalConstant g)@@ -365,6 +385,7 @@                       i <- liftIO $ FFI.getInitializer g                       if i == nullPtr then return Nothing else Just <$> decodeM i)                `ap` getSection g+               `ap` getCOMDATName g                `ap` getAlignment g,            do@@ -375,6 +396,9 @@                `ap` return n                `ap` getLinkage a                `ap` getVisibility a+               `ap` getDLLStorageClass a+               `ap` getThreadLocalMode a+               `ap` (liftIO $ decodeM =<< FFI.hasUnnamedAddr (FFI.upCast a))                `ap` typeOf a                `ap` (decodeM =<< (liftIO $ FFI.getAliasee a)), @@ -383,7 +407,8 @@             liftM sequence . forM ffiFunctions $ \f -> localScope $ do               A.PointerType (A.FunctionType returnType _ isVarArg) _ <- typeOf f               n <- getGlobalName f-              parameters <- getParameters f+              MixedAttributeSet fAttrs rAttrs pAttrs <- getMixedAttributeSet f+              parameters <- getParameters f pAttrs               decodeBlocks <- do                 ffiBasicBlocks <- liftIO $ FFI.getXs (FFI.getFirstBasicBlock f) FFI.getNextBasicBlock                 liftM sequence . forM ffiBasicBlocks $ \b -> do@@ -394,15 +419,18 @@               return $ return A.Function                  `ap` getLinkage f                  `ap` getVisibility f-                 `ap` (liftIO $ decodeM =<< FFI.getFunctionCallConv f)-                 `ap` (liftIO $ decodeM =<< FFI.getFunctionRetAttr f)+                 `ap` getDLLStorageClass f+                 `ap` (liftIO $ decodeM =<< FFI.getFunctionCallingConvention f)+                 `ap` return rAttrs                  `ap` return returnType                  `ap` return n                  `ap` return (parameters, isVarArg)-                 `ap` (liftIO $ getFunctionAttrs f)+                 `ap` return fAttrs                  `ap` getSection f+                 `ap` getCOMDATName f                  `ap` getAlignment f                  `ap` getGC f+                 `ap` getPrefixData f                  `ap` decodeBlocks         ] @@ -422,5 +450,11 @@         mds <- getMetadataDefinitions -       return $ tds ++ ias ++ gs ++ nmds ++ mds+       ags <- do+         ags <- gets $ Map.toList . functionAttributeSetIDs+         forM ags $ \(as, gid) -> return A.FunctionAttributes `ap` return gid `ap` decodeM as++       cds <- gets $ map (uncurry A.COMDAT) . Map.elems . comdats++       return $ tds ++ ias ++ gs ++ nmds ++ mds ++ ags ++ cds    )

@@ -22,13 +22,13 @@   -> Bool   -> (Ptr FFI.RawOStream -> ExceptT String IO ())   -> m ()-withFileRawOStream path excl binary c = do+withFileRawOStream path excl text c = do   path <- encodeM path   excl <- encodeM excl-  binary <- encodeM binary+  text <- encodeM text   msgPtr <- alloca   errorRef <- liftIO $ newIORef undefined-  succeeded <- decodeM =<< (liftIO $ FFI.withFileRawOStream path excl binary msgPtr $ \os -> do+  succeeded <- decodeM =<< (liftIO $ FFI.withFileRawOStream path excl text msgPtr $ \os -> do                               r <- runExceptableT (ExceptableT  $ c os)                               writeIORef errorRef r)   unless succeeded $ do

@@ -0,0 +1,18 @@+{-# LANGUAGE+  TemplateHaskell,+  MultiParamTypeClasses+  #-}+module LLVM.General.Internal.TailCallKind where++import LLVM.General.Prelude++import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI++import LLVM.General.Internal.Coding+import qualified LLVM.General.AST as A++genCodingInstance [t| Maybe A.TailCallKind |] ''FFI.TailCallKind [+  (FFI.tailCallKindNone, Nothing),+  (FFI.tailCallKindTail, Just A.Tail),+  (FFI.tailCallKindMustTail, Just A.MustTail)+ ]

@@ -8,16 +8,15 @@  import LLVM.General.Prelude +import Control.Monad.Trans.Except (runExcept) import Control.Monad.Exceptable import Control.Exception import Control.Monad.AnyCont  import Foreign.Ptr import Data.List (intercalate)-import Data.Map (Map)-import qualified Data.Map as Map--import Text.ParserCombinators.Parsec hiding (many)+import Data.Set (Set)+import qualified Data.Set as Set  import LLVM.General.Internal.Coding import LLVM.General.Internal.String ()@@ -76,21 +75,12 @@ newtype CPUFeature = CPUFeature String   deriving (Eq, Ord, Read, Show) -instance EncodeM e String es => EncodeM e (Map CPUFeature Bool) es where-  encodeM = encodeM . intercalate "," . map (\(CPUFeature f, enabled) -> (if enabled then "+" else "-") ++ f) . Map.toList+instance EncodeM e String es => EncodeM e (Set CPUFeature) es where+  encodeM = encodeM . intercalate " " . map (\(CPUFeature f) -> f) . Set.toList -instance (Monad d, DecodeM d String es) => DecodeM d (Map CPUFeature Bool) es where-  decodeM es = do-    s <- decodeM es-    let flag = do-          en <- choice [char '-' >> return False, char '+' >> return True]-          s <- many1 (noneOf ",")-          return (CPUFeature s, en)-        features = liftM Map.fromList (flag `sepBy` (char ','))-    case parse (do f <- features; eof; return f) "CPU Feature string" (s :: String) of-      Right features -> return features-      Left _ -> fail "failure to parse CPUFeature string"-                       +instance (Monad d, DecodeM d String es) => DecodeM d (Set CPUFeature) es where+  decodeM = liftM (Set.fromList . map CPUFeature . words) . decodeM+ -- | Find a 'Target' given an architecture and/or a \"triple\". -- | <http://llvm.org/doxygen/structllvm_1_1TargetRegistry.html#a3105b45e546c9cc3cf78d0f2ec18ad89> -- | Be sure to run either 'initializeAllTargets' or 'initializeNativeTarget' before expecting this to succeed, depending on what target(s) you want to use.@@ -133,8 +123,10 @@     (FFI.targetOptionFlagDisableTailCalls, TO.disableTailCalls),     (FFI.targetOptionFlagEnableFastISel, TO.enableFastInstructionSelection),     (FFI.targetOptionFlagPositionIndependentExecutable, TO.positionIndependentExecutable),-    (FFI.targetOptionFlagEnableSegmentedStacks, TO.enableSegmentedStacks),-    (FFI.targetOptionFlagUseInitArray, TO.useInitArray)+    (FFI.targetOptionFlagUseInitArray, TO.useInitArray),+    (FFI.targetOptionFlagDisableIntegratedAS, TO.disableIntegratedAssembler),+    (FFI.targetOptionFlagCompressDebugSections, TO.compressDebugSections),+    (FFI.targetOptionFlagTrapUnreachable, TO.trapUnreachable)    ]   FFI.setStackAlignmentOverride cOpts =<< encodeM (TO.stackAlignmentOverride hOpts)   flip runAnyContT return $ do@@ -177,10 +169,14 @@     <- gof FFI.targetOptionFlagEnableFastISel   positionIndependentExecutable     <- gof FFI.targetOptionFlagPositionIndependentExecutable-  enableSegmentedStacks-    <- gof FFI.targetOptionFlagEnableSegmentedStacks   useInitArray     <- gof FFI.targetOptionFlagUseInitArray+  disableIntegratedAssembler+    <- gof FFI.targetOptionFlagDisableIntegratedAS+  compressDebugSections+    <- gof FFI.targetOptionFlagCompressDebugSections+  trapUnreachable+    <- gof FFI.targetOptionFlagTrapUnreachable   stackAlignmentOverride <- decodeM =<< FFI.getStackAlignmentOverride tOpts   trapFunctionName <- decodeM =<< FFI.getTrapFuncName tOpts   floatABIType <- decodeM =<< FFI.getFloatABIType tOpts@@ -195,7 +191,7 @@     Target     -> String -- ^ triple     -> String -- ^ cpu-    -> Map CPUFeature Bool -- ^ features+    -> Set CPUFeature -- ^ features     -> TargetOptions     -> Reloc.Model     -> CodeModel.Model@@ -256,26 +252,22 @@  -- | the LLVM name for the host CPU getHostCPUName :: IO String-getHostCPUName = decodeM =<< FFI.getHostCPUName+getHostCPUName = decodeM FFI.getHostCPUName  -- | a space-separated list of LLVM feature names supported by the host CPU-getHostCPUFeatures :: IO (Map CPUFeature Bool)+getHostCPUFeatures :: IO (Set CPUFeature) getHostCPUFeatures = decodeM =<< FFI.getHostCPUFeatures  -- | 'DataLayout' to use for the given 'TargetMachine' getTargetMachineDataLayout :: TargetMachine -> IO DataLayout getTargetMachineDataLayout (TargetMachine m) = do-  dl <- decodeM =<< FFI.getTargetMachineDataLayout m-  maybe (fail "parseDataLayout failed") return $ parseDataLayout dl+  dlString <- decodeM =<< FFI.getTargetMachineDataLayout m+  let Right (Just dl) = runExcept . parseDataLayout BigEndian $ dlString+  return dl  -- | Initialize all targets so they can be found by 'lookupTarget' initializeAllTargets :: IO () initializeAllTargets = FFI.initializeAllTargets--{-# DEPRECATED withDefaultTargetMachine "use withHostTargetMachine or withTargetMachine" #-}--- | Bracket creation and destruction of a 'TargetMachine' configured for the host.-withDefaultTargetMachine :: (TargetMachine -> IO a) -> ExceptT String IO a-withDefaultTargetMachine = withHostTargetMachine  -- | Bracket creation and destruction of a 'TargetMachine' configured for the host withHostTargetMachine :: (TargetMachine -> IO a) -> ExceptT String IO a

@@ -1,33 +1,12 @@ module LLVM.General.Internal.Threading (-  setMultithreaded,   isMultithreaded   ) where  import LLVM.General.Prelude -import Control.Concurrent.MVar-import System.IO.Unsafe- import qualified LLVM.General.Internal.FFI.Threading as FFI  import LLVM.General.Internal.Coding--lock :: MVar ()-{-# NOINLINE lock #-}-lock = unsafePerformIO $ newMVar ()---- | Set the multithreading mode of LLVM. If it is disabled (as by default) locks are not enforced.-setMultithreaded :: Bool -> IO ()-setMultithreaded s = do-  takeMVar lock-  multi <- isMultithreaded-  case (s,multi) of-    (True,False) -> do-      success <- decodeM =<< FFI.startMultithreaded-      when (not success) $ error "setMultithreaded: LLVM not built with threading support"-    (False,True) -> FFI.stopMultithreaded-    _            -> return ()-  putMVar lock ()  -- | Check if multithreading is enabled in LLVM isMultithreaded :: IO Bool

@@ -7,7 +7,7 @@    Target, TargetMachine, TargetLowering,    CPUFeature(..),    withTargetOptions, peekTargetOptions, pokeTargetOptions,-   withTargetMachine, withHostTargetMachine, withDefaultTargetMachine,+   withTargetMachine, withHostTargetMachine,    getTargetLowering,    getDefaultTargetTriple, getProcessTargetTriple, getHostCPUName, getHostCPUFeatures,    getTargetMachineDataLayout, initializeNativeTarget, initializeAllTargets,

@@ -35,8 +35,10 @@   disableTailCalls :: Bool,   enableFastInstructionSelection :: Bool,   positionIndependentExecutable :: Bool,-  enableSegmentedStacks :: Bool,   useInitArray :: Bool,+  disableIntegratedAssembler :: Bool,+  compressDebugSections :: Bool,+  trapUnreachable :: Bool,   stackAlignmentOverride :: Word32,   trapFunctionName :: String,   floatABIType :: FloatABI,

@@ -4,4 +4,21 @@   isMultithreaded   ) where +import LLVM.General.Prelude+ import LLVM.General.Internal.Threading++{-# DEPRECATED setMultithreaded "LLVM no longer features runtime control of multithreading support" #-}+-- | This function used set the multithreading mode of LLVM, but that feature no longer exists. Threading is+-- controlled only at runtime with the configure flag --enable-threads (default is YES). This function will+-- now check that the the compiled-in multithreading support (returned by 'isMultithreaded') is+-- sufficient to support the requested access, and fail if not, so as to prevent uncontrolled use of a+-- version of LLVM compiled to be capable only of singled threaded use by haskell code requesting+-- multithreading support.+setMultithreaded :: Bool -> IO ()+setMultithreaded desired = do+  actual <- isMultithreaded+  when (desired && not actual) $+     fail $ "Multithreading support requested but not available. " ++ +            "Please use an LLVM built with threading enabled"+  return ()

@@ -37,8 +37,7 @@   | LoopUnroll { loopUnrollThreshold :: Maybe Word, count :: Maybe Word, allowPartial :: Maybe Bool }   | LoopUnswitch { optimizeForSize :: Bool }   | LowerAtomic-  -- | can use a 'LLVM.General.Target.TargetMachine'-  | LowerInvoke { useExpensiveExceptionHandlingSupport :: Bool } +  | LowerInvoke   | LowerSwitch   | LowerExpectIntrinsic   | MemcpyOptimization@@ -104,7 +103,8 @@       fastDependencyAnalysis :: Bool     }   | LoopVectorize {-      noUnrolling :: Bool+      noUnrolling :: Bool,+      alwaysVectorize :: Bool     }   | SuperwordLevelParallelismVectorize @@ -117,25 +117,12 @@       noRedZone :: Bool,       functionNamesInData :: Bool     }-  | AddressSanitizer {-      checkInitOrder :: Bool,-      checkUseAfterReturn :: Bool,-      checkLifetime :: Bool,-      blackListFile :: Maybe FilePath,-      zeroBaseShadow :: Bool-    }-  | AddressSanitizerModule {-      checkInitOrder :: Bool,-      blackListFile :: Maybe FilePath,-      zeroBaseShadow :: Bool-    }+  | AddressSanitizer+  | AddressSanitizerModule   | MemorySanitizer {-      trackOrigins :: Bool,-      blackListFile :: Maybe FilePath-    }-  | ThreadSanitizer {-      blackListFile :: Maybe FilePath+      trackOrigins :: Bool     }+  | ThreadSanitizer   | BoundsChecking   | DebugGeneratedIR {       hideDebugIntrinsics :: Bool,@@ -148,7 +135,8 @@  -- | Defaults for the 'LoopVectorize' pass defaultLoopVectorize = LoopVectorize {-    noUnrolling = False+    noUnrolling = False,+    alwaysVectorize = True   }  -- | Defaults for the 'BasicBlockVectorize' pass - copied from the C++ code to keep these defaults@@ -195,31 +183,18 @@   }  -- | Defaults for 'AddressSanitizer'.-defaultAddressSanitizer = AddressSanitizer {-  checkInitOrder = True,-  checkUseAfterReturn = False,-  checkLifetime = False,-  blackListFile = Nothing,-  zeroBaseShadow = False-}+defaultAddressSanitizer = AddressSanitizer  -- | Defaults for 'AddressSanitizerModule'.-defaultAddressSanitizerModule = AddressSanitizerModule {-  checkInitOrder = True,-  blackListFile = Nothing,-  zeroBaseShadow = False-}+defaultAddressSanitizerModule = AddressSanitizerModule  -- | Defaults for 'MemorySanitizer'. defaultMemorySanitizer = MemorySanitizer {-  trackOrigins = False,-  blackListFile = Nothing+  trackOrigins = False }  -- | Defaults for 'ThreadSanitizer'.-defaultThreadSanitizer = ThreadSanitizer {-  blackListFile = Nothing-}+defaultThreadSanitizer = ThreadSanitizer  -- | Defaults for 'DebugGeneratedIR'. defaultDebugGeneratedIR = DebugGeneratedIR {

@@ -0,0 +1,57 @@+module LLVM.General.Test.CallingConvention where++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++import LLVM.General.Test.Support++import Data.Maybe+import qualified Data.Set as Set+import qualified Data.Map as Map++import LLVM.General.Context+import LLVM.General.Module+import LLVM.General.AST+import LLVM.General.AST.Type as T+import qualified LLVM.General.AST.CallingConvention as CC+import qualified LLVM.General.AST.Global as G++tests = testGroup "CallingConvention" [+  testCase name $ strCheck (defaultModule {+    moduleDefinitions = [+     GlobalDefinition $ functionDefaults {+       G.returnType = i32,+       G.name = Name "foo",+       G.callingConvention = cc+     }+    ]+   }) ("; ModuleID = '<string>'\n\+       \\n\+       \declare" ++ (if name == "" then "" else (" " ++ name)) ++ " i32 @foo()\n")+   | (name, cc) <- [+   ("", CC.C),+   ("fastcc", CC.Fast),+   ("coldcc", CC.Cold),+   ("cc10", CC.GHC),+   ("cc11", CC.HiPE),+   ("webkit_jscc", CC.WebKit_JS),+   ("anyregcc", CC.AnyReg),+   ("preserve_mostcc", CC.PreserveMost),+   ("preserve_allcc", CC.PreserveAll),+   ("x86_stdcallcc", CC.X86_StdCall),+   ("x86_fastcallcc", CC.X86_FastCall),+   ("arm_apcscc", CC.ARM_APCS),+   ("arm_aapcscc", CC.ARM_AAPCS),+   ("arm_aapcs_vfpcc", CC.ARM_AAPCS_VFP),+   ("msp430_intrcc", CC.MSP430_INTR),+   ("x86_thiscallcc", CC.X86_ThisCall),+   ("ptx_kernel", CC.PTX_Kernel),+   ("ptx_device", CC.PTX_Device),+   ("spir_func", CC.SPIR_FUNC),+   ("spir_kernel", CC.SPIR_KERNEL),+   ("intel_ocl_bicc", CC.Intel_OCL_BI),+   ("x86_64_sysvcc", CC.X86_64_SysV),+   ("x86_64_win64cc", CC.X86_64_Win64)+  ]+ ]

@@ -19,6 +19,7 @@  m s = "; ModuleID = '<string>'\n" ++ s t s = "target datalayout = \"" ++ s ++ "\"\n"+ddl = defaultDataLayout BigEndian  tests = testGroup "DataLayout" [   testCase name $ strCheckC (Module "<string>" mdl Nothing []) (m sdl) (m sdlc)@@ -27,12 +28,12 @@   ] ++ [    (name, Just mdl, t sdl, t (fromMaybe sdl msdlc))    | (name, mdl, sdl, msdlc) <- [-    ("little-endian", defaultDataLayout { endianness = Just LittleEndian }, "e", Nothing),-    ("big-endian", defaultDataLayout { endianness = Just BigEndian }, "E", Nothing),-    ("native", defaultDataLayout { nativeSizes = Just (Set.fromList [8,32]) }, "n8:32", Nothing),+    ("little-endian", defaultDataLayout LittleEndian, "e", Nothing),+    ("big-endian", defaultDataLayout BigEndian, "E", Nothing),+    ("native", ddl { nativeSizes = Just (Set.fromList [8,32]) }, "E-n8:32", Nothing),     (      "no pref",-     defaultDataLayout {+     ddl {        pointerLayouts =           Map.singleton          (AddrSpace 0) @@ -44,50 +45,42 @@           }          )      },-     "p:8:64",+     "E-p:8:64",      Nothing     ), (      "no pref",-     defaultDataLayout {+     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",      Nothing     ), (      "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-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128-n8:16:32:64-S128",-     Just "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-f32:32:256-f64:64:256-v64:64:256-v128:128:256-a:0:256-f80:128:256-n8:16:32:64-S128",+     Just "e-m:e-p:8:8:16-i1:8:256-i8:8:256-i16:16:256-i32:32:256-i64:64:256-f32:32:256-f64:64:256-v64:64:256-v128:128:256-a:0:256-f80:128:256-n8:16:32:64-S128"     )    ]   ]

@@ -29,7 +29,7 @@                     G.basicBlocks = [                       BasicBlock (UnName 0) [                         UnName 1 := Call {-                          isTailCall = False,+                          tailCallKind = Nothing,                           callingConvention = CC.C,                           returnAttributes = [],                           function = Left $ InlineAssembly {

@@ -282,7 +282,7 @@            Load {              volatile = False,              address = a 2,-             maybeAtomicity = Just (Atomicity { crossThread = True, memoryOrdering = Acquire }),+             maybeAtomicity = Just (CrossThread, Acquire),              alignment = 1,              metadata = []             },@@ -291,7 +291,7 @@            Load {              volatile = False,              address = a 2,-             maybeAtomicity = Just (Atomicity { crossThread = False, memoryOrdering = Monotonic }),+             maybeAtomicity = Just (SingleThread, Monotonic),              alignment = 1,              metadata = []             },@@ -318,17 +318,18 @@              address = a 2,              expected = a 0,              replacement = a 0,-             atomicity = Atomicity { crossThread = True, memoryOrdering = Monotonic },+             atomicity = (CrossThread, Monotonic),+             failureMemoryOrdering = Monotonic,              metadata = []             },-           "cmpxchg i32* %2, i32 %0, i32 %0 monotonic"),+           "cmpxchg i32* %2, i32 %0, i32 %0 monotonic monotonic"),           ("atomicrmw",            AtomicRMW {              volatile = False,              rmwOperation = RMWOp.UMax,              address = a 2,              value = a 0,-             atomicity = Atomicity { crossThread = True, memoryOrdering = Release },+             atomicity = (CrossThread, Release),              metadata = []            },            "atomicrmw umax i32* %2, i32 %0 release"),@@ -553,13 +554,13 @@           "store i32 %0, i32* %2"),          ("fence",           Do $ Fence {-            atomicity = Atomicity { crossThread = True, memoryOrdering = Acquire },+            atomicity = (CrossThread, Acquire),             metadata = []            },           "fence acquire"),           ("call",            Do $ Call {-             isTailCall = False,+             tailCallKind = Nothing,              callingConvention = CC.C,              returnAttributes = [],              function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void ts False)) (UnName 0))),

@@ -113,7 +113,7 @@     G.basicBlocks = [       BasicBlock (UnName 0) [         UnName 1 := Call {-          isTailCall = False,+          tailCallKind = Nothing,           callingConvention = CC.C,           returnAttributes = [],           function = Right (ConstantOperand (C.GlobalReference (FunctionType i32 [i32, ptr (ptr i8)] False) (Name "foo"))),@@ -142,8 +142,10 @@         (names ast') `List.intersect` (names ast) @?= names ast     | (n,p) <- [      ("GCOVProfiler", defaultGCOVProfiler),+{-      ("AddressSanitizer", defaultAddressSanitizer),      ("AddressSanitizerModule", defaultAddressSanitizerModule),+-}      ("MemorySanitizer", defaultMemorySanitizer),      ("ThreadSanitizer", defaultThreadSanitizer),      ("BoundsChecking", BoundsChecking),

@@ -10,7 +10,7 @@ import Data.Bits import Data.Word -import qualified Data.Map as Map+import qualified Data.Set as Set  import LLVM.General.Context import LLVM.General.Module@@ -18,16 +18,20 @@ import LLVM.General.Diagnostic import LLVM.General.Target import LLVM.General.AST-import LLVM.General.AST.Type as A.T+import LLVM.General.AST.Type as T import LLVM.General.AST.AddrSpace import qualified LLVM.General.AST.IntegerPredicate as IPred  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.Attribute as A+import qualified LLVM.General.AST.FunctionAttribute as FA+import qualified LLVM.General.AST.ParameterAttribute as PA+import qualified LLVM.General.AST.ThreadLocalStorage as TLS import qualified LLVM.General.AST.Global as G import qualified LLVM.General.AST.Constant as C+import qualified LLVM.General.AST.COMDAT as COMDAT  import qualified LLVM.General.Relocation as R import qualified LLVM.General.CodeModel as CM@@ -38,18 +42,22 @@     \%0 = type { i32, %1*, %0* }\n\     \%1 = type opaque\n\     \\n\+    \$bob = comdat largest\n\+    \\n\     \@0 = global i32 1\n\-    \@1 = external protected addrspace(3) global i32, section \"foo\"\n\+    \@1 = external protected addrspace(3) global i32, section \"foo\", comdat $bob\n\     \@2 = unnamed_addr global i8 2\n\-    \@3 = external global %0\n\+    \@3 = external dllimport global %0\n\     \@4 = external global [4294967296 x i32]\n\     \@.argyle = thread_local global i32 0\n\+    \@5 = thread_local(localdynamic) global i32 1\n\     \\n\     \@three = alias private i32 addrspace(3)* @1\n\-    \@two = alias i32 addrspace(3)* @three\n\+    \@two = unnamed_addr alias i32 addrspace(3)* @three\n\+    \@one = thread_local(initialexec) alias i32* @5\n\     \\n\-    \define i32 @bar() {\n\-    \  %1 = call zeroext i32 @foo(i32 inreg align 16 1, i8 signext 4) #0\n\+    \define i32 @bar() prefix i32 1 {\n\+    \  %1 = musttail call zeroext i32 @foo(i32 inreg align 16 1, i8 signext 4) #0\n\     \  ret i32 %1\n\     \}\n\     \\n\@@ -71,7 +79,7 @@     \  ret i32 %r\n\     \}\n\     \\n\-    \attributes #0 = { nounwind readnone uwtable }\n"+    \attributes #0 = { nounwind readnone uwtable \"eep\" }\n"  handAST = Module "<string>" Nothing Nothing [       TypeDefinition (UnName 0) (@@ -91,7 +99,8 @@         G.visibility = V.Protected,         G.type' = i32,         G.addrSpace = AddrSpace 3,-        G.section = Just "foo"+        G.section = Just "foo",+        G.comdat = Just "bob"       },       GlobalDefinition $ globalVariableDefaults {         G.name = UnName 2,@@ -101,6 +110,7 @@       },       GlobalDefinition $ globalVariableDefaults {         G.name = UnName 3,+        G.dllStorageClass = Just DLL.Import,         G.type' = NamedTypeReference (UnName 0)       },       GlobalDefinition $ globalVariableDefaults {@@ -111,34 +121,48 @@         G.name = Name ".argyle",         G.type' = i32,         G.initializer = Just (C.Int 32 0),-        G.isThreadLocal = True+        G.threadLocalMode = Just TLS.GeneralDynamic       },+      GlobalDefinition $ globalVariableDefaults {+        G.name = UnName 5,+        G.type' = i32,+        G.threadLocalMode = Just TLS.LocalDynamic,+        G.initializer = Just (C.Int 32 1)+      },       GlobalDefinition $ globalAliasDefaults {-        G.name = Name "three", -        G.linkage = L.Private,-        G.type' = PointerType i32 (AddrSpace 3),-        G.aliasee = C.GlobalReference (PointerType i32 (AddrSpace 3)) (UnName 1)+         G.name = Name "three",+         G.linkage = L.Private,+         G.type' = PointerType i32 (AddrSpace 3),+         G.aliasee = C.GlobalReference (PointerType i32 (AddrSpace 3)) (UnName 1)       },       GlobalDefinition $ globalAliasDefaults {         G.name = Name "two",+        G.hasUnnamedAddr = True,         G.type' = PointerType i32 (AddrSpace 3),         G.aliasee = C.GlobalReference (PointerType i32 (AddrSpace 3)) (Name "three")       },+      GlobalDefinition $ globalAliasDefaults {+        G.name = Name "one",+        G.type' = ptr i32,+        G.aliasee = C.GlobalReference (ptr i32) (UnName 5),+        G.threadLocalMode = Just TLS.InitialExec+      },       GlobalDefinition $ functionDefaults {         G.returnType = i32,         G.name = Name "bar",+        G.prefix = Just (C.Int 32 1),         G.basicBlocks = [           BasicBlock (UnName 0) [            UnName 1 := Call {-             isTailCall = False,+             tailCallKind = Just MustTail,              callingConvention = CC.C,-             returnAttributes = [A.ZeroExt],+             returnAttributes = [PA.ZeroExt],              function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType i32 [i32, i8] False)) (Name "foo"))),              arguments = [-              (ConstantOperand (C.Int 32 1), [A.InReg, A.Alignment 16]),-              (ConstantOperand (C.Int 8 4), [A.SignExt])+              (ConstantOperand (C.Int 32 1), [PA.InReg, PA.Alignment 16]),+              (ConstantOperand (C.Int 8 4), [PA.SignExt])              ],-             functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable],+             functionAttributes = [Left (FA.GroupID 0)],              metadata = []            }          ] (@@ -147,14 +171,14 @@         ]       },       GlobalDefinition $ functionDefaults {-        G.returnAttributes = [A.ZeroExt],+        G.returnAttributes = [PA.ZeroExt],         G.returnType = i32,         G.name = Name "foo",         G.parameters = ([-          Parameter i32 (Name "x") [A.InReg, A.Alignment 16],-          Parameter i8 (Name "y") [A.SignExt]+          Parameter i32 (Name "x") [PA.InReg, PA.Alignment 16],+          Parameter i8 (Name "y") [PA.SignExt]          ], False),-        G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable],+        G.functionAttributes = [Left (FA.GroupID 0)],         G.basicBlocks = [           BasicBlock (UnName 0) [            UnName 1 := Mul {@@ -206,8 +230,10 @@              Do $ Ret (Just (LocalReference i32 (Name "r"))) []            )          ]-        }-      ]+        },+      FunctionAttributes (FA.GroupID 0) [FA.NoUnwind, FA.ReadNone, FA.UWTable, FA.StringAttribute "eep" ""],+      COMDAT "bob" COMDAT.Largest+     ]  tests = testGroup "Module" [   testGroup "withModuleFromString" [@@ -233,17 +259,17 @@       a <- withModuleFromLLVMAssembly' context s $ \m -> do         (t, _) <- failInIO $ lookupTarget Nothing "x86_64-unknown-linux"         withTargetOptions $ \to -> do-          withTargetMachine t "" "" Map.empty to R.Default CM.Default CGO.Default $ \tm -> do+          withTargetMachine t "x86_64-unknown-linux" "" Set.empty to R.Default CM.Default CGO.Default $ \tm -> do             failInIO $ moduleTargetAssembly tm m-      a @?= "\t.file\t\"<string>\"\n\-            \\t.text\n\+      a @?= "\t.text\n\+            \\t.file\t\"<string>\"\n\             \\t.globl\tmain\n\             \\t.align\t16, 0x90\n\             \\t.type\tmain,@function\n\             \main:\n\             \\t.cfi_startproc\n\             \\txorl\t%eax, %eax\n\-            \\tret\n\+            \\tretq\n\             \.Ltmp0:\n\             \\t.size\tmain, .Ltmp0-main\n\             \\t.cfi_endproc\n\@@ -293,7 +319,7 @@               \}\n"           ast = Module "<string>" Nothing Nothing [              GlobalDefinition $ functionDefaults {-                G.returnType = A.T.void,+                G.returnType = T.void,                 G.name = Name "trouble",                 G.basicBlocks = [                  BasicBlock (Name "entry") [

@@ -13,7 +13,7 @@ import LLVM.General.Module import LLVM.General.Context import LLVM.General.PassManager-import LLVM.General.Transforms+import qualified LLVM.General.Transforms as T import LLVM.General.Target  import LLVM.General.AST as A@@ -39,7 +39,7 @@         G.returnType = i32,         G.name = Name "foo",         G.parameters = ([Parameter i32 (Name "x") []], False),-        G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable], +        G.functionAttributes = [Left (A.GroupID 0)],         G.basicBlocks = [           BasicBlock (UnName 0) [            UnName 1 := Mul {@@ -91,7 +91,8 @@              Do $ Ret (Just (LocalReference i32 (Name "r"))) []            )          ]-       }+       },+      FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable]      ]  isVectory :: A.Module -> Assertion@@ -116,26 +117,27 @@         G.returnType = i32,          G.name = Name "foo",          G.parameters = ([Parameter i32 (Name "x") []], False),-         G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable],+         G.functionAttributes = [Left (A.GroupID 0)],          G.basicBlocks = [            BasicBlock (Name "here") [               ] (               Do $ Ret (Just (ConstantOperand (C.Int 32 0))) []             )           ]-        }+        },+      FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable]       ],    testGroup "individual" [     testCase "ConstantPropagation" $ do-      mOut <- optimize defaultPassSetSpec { transforms = [ConstantPropagation] } handAST+      mOut <- optimize defaultPassSetSpec { transforms = [T.ConstantPropagation] } handAST        mOut @?= Module "<string>" Nothing Nothing [         GlobalDefinition $ functionDefaults {           G.returnType = i32,           G.name = Name "foo",           G.parameters = ([Parameter i32 (Name "x") []], False),-          G.functionAttributes = [A.NoUnwind, A.ReadNone, A.UWTable],+          G.functionAttributes = [Left (A.GroupID 0)],           G.basicBlocks = [             BasicBlock (UnName 0) [] (Do $ Br (Name "here") []),             BasicBlock (Name "here") [] (@@ -167,7 +169,8 @@               Do $ Ret (Just (LocalReference i32 (Name "r"))) []             )            ]-         }+         },+        FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable]        ],      testCase "BasicBlockVectorization" $ do@@ -196,9 +199,9 @@          ]       mOut <- optimize (defaultPassSetSpec {                     transforms = [-                     defaultVectorizeBasicBlocks { requiredChainDepth = 3 },-                     InstructionCombining, -                     GlobalValueNumbering False+                     T.defaultVectorizeBasicBlocks { T.requiredChainDepth = 3 },+                     T.InstructionCombining, +                     T.GlobalValueNumbering False                     ] }) mIn       isVectory mOut,       @@ -207,51 +210,57 @@         mIn =            Module {             moduleName = "<string>",-            moduleDataLayout = Just $ defaultDataLayout { +            moduleDataLayout = Just $ (defaultDataLayout BigEndian) {                typeLayouts = Map.singleton (VectorAlign, 128) (AlignmentInfo 128 Nothing)              },             moduleTargetTriple = Just "x86_64",             moduleDefinitions = [+              GlobalDefinition $ globalVariableDefaults {+                G.name = Name "a",+                G.linkage = L.Common,+                G.type' = A.T.ArrayType 2048 i32,+                G.initializer = Just (C.Null (A.T.ArrayType 2048 i32))+               },               GlobalDefinition $ functionDefaults {                 G.returnType = A.T.void,-                G.name = Name "foo",-                G.parameters = ([Parameter (ptr i32) (Name "x") []], False),+                G.name = Name "inc",+                G.functionAttributes = [Left (A.GroupID 0)],+                G.parameters = ([Parameter i32 (Name "n") []], False),                 G.basicBlocks = [-                  BasicBlock (UnName 0) [] (Do $ Br (UnName 1) []),-                  BasicBlock (UnName 1) [-                    Name "i.0" := Phi i32 [ -                      (ConstantOperand (C.Int 32 0), UnName 0),-                      (LocalReference i32 (UnName 8), UnName 7)-                     ] [],-                    Name ".0" := Phi (ptr i32) [ -                      (LocalReference (ptr i32) (Name "x"), UnName 0),-                      (LocalReference (ptr i32) (UnName 4), UnName 7)+                  BasicBlock (UnName 0) [+                    UnName 1 := ICmp IPred.SGT (LocalReference i32 (Name "n")) (ConstantOperand (C.Int 32 0)) []+                   ] (Do $ CondBr (LocalReference i1 (UnName 1)) (Name ".lr.ph") (Name "._crit_edge") []),+                  BasicBlock (Name ".lr.ph") [+                    Name "indvars.iv" := Phi i64 [ +                      (ConstantOperand (C.Int 64 0), UnName 0),+                      (LocalReference i64 (Name "indvars.iv.next"), Name ".lr.ph")                      ] [],-                    UnName 2 := ICmp IPred.SLT (LocalReference i32 (Name "i.0")) (ConstantOperand (C.Int 32 2048)) []-                   ] (Do $ CondBr (LocalReference i1 (UnName 2)) (UnName 3) (UnName 9) []),-                  BasicBlock (UnName 3) [-                    UnName 4 := GetElementPtr True (LocalReference (ptr i32) (Name ".0")) [ -                      ConstantOperand (C.Int 32 1)+                    UnName 2 := GetElementPtr True (ConstantOperand (C.GlobalReference (A.T.ArrayType 2048 i32) (Name "a"))) [ +                      ConstantOperand (C.Int 64 0),+                      (LocalReference i64 (Name "indvars.iv"))                      ] [],-                    UnName 5 := Load False (LocalReference (ptr i32) (Name ".0")) Nothing 4 [],-                    UnName 6 := Add True False (LocalReference i32 (UnName 5)) (ConstantOperand (C.Int 32 1)) [],-                    Do $ Store False (LocalReference (ptr i32) (Name ".0")) (LocalReference i32 (UnName 6)) Nothing 4 []  -                   ] (Do $ Br (UnName 7) []),-                  BasicBlock (UnName 7) [-                    UnName 8 := Add True False (LocalReference i32 (Name "i.0")) (ConstantOperand (C.Int 32 1)) []-                   ] (Do $ Br (UnName 1) []),-                  BasicBlock (UnName 9) [] (Do $ Ret Nothing [])+                    UnName 3 := Load False (LocalReference (ptr i32) (UnName 2)) Nothing 4 [],+                    UnName 4 := Trunc (LocalReference i64 (Name "indvars.iv")) i32 [],+                    UnName 5 := Add True False (LocalReference i32 (UnName 3)) (LocalReference i32 (UnName 4)) [],+                    Do $ Store False (LocalReference (ptr i32) (UnName 2)) (LocalReference i32 (UnName 5)) Nothing 4 [],+                    Name "indvars.iv.next" := Add False False (LocalReference i64 (Name "indvars.iv")) (ConstantOperand (C.Int 64 1)) [],+                    Name "lftr.wideiv" := Trunc (LocalReference i64 (Name "indvars.iv.next")) i32 [],+                    Name "exitcond" := ICmp IPred.EQ (LocalReference i32 (Name "lftr.wideiv")) (LocalReference i32 (Name "n")) []+                   ] (Do $ CondBr (LocalReference i1 (Name "exitcond")) (Name "._crit_edge") (Name ".lr.ph") []),+                  BasicBlock (Name "._crit_edge") [+                   ] (Do $ Ret Nothing [])                  ]-               }+               },+              FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable, A.StackProtect]              ]            }       mOut <- do         let triple = "x86_64"         (target, _) <- failInIO $ lookupTarget Nothing triple         withTargetOptions $ \targetOptions -> do-          withTargetMachine target triple "" Map.empty targetOptions R.Default CM.Default CGO.Default $ \tm -> do+          withTargetMachine target triple "" Set.empty targetOptions R.Default CM.Default CGO.Default $ \tm -> do             optimize (defaultPassSetSpec { -                        transforms = [ defaultLoopVectorize ],+                        transforms = [ T.defaultLoopVectorize ],                         dataLayout = moduleDataLayout mIn,                         targetMachine = Just tm                       }) mIn@@ -262,45 +271,36 @@       -- The pass seems to be quite deeply dependent on weakly documented presumptions about       -- how unwinding works (as is the invoke instruction)       withContext $ \context -> do-        let triple = "x86_64-apple-darwin"-        (target, _) <- failInIO $ lookupTarget Nothing triple-        withTargetOptions $ \targetOptions -> do-          withTargetMachine target triple "" Map.empty targetOptions-                            R.Default CM.Default CGO.Default $ \tm -> do-            withPassManager (defaultPassSetSpec { transforms = [LowerInvoke False], targetMachine = Just tm}) $ \passManager -> do-              let astIn = -                    Module "<string>" Nothing Nothing [-                      GlobalDefinition $ functionDefaults {-                        G.returnType = i32,-                        G.name = Name "foo",-                        G.parameters = ([Parameter i32 (Name "x") []], False),-                        G.basicBlocks = [-                          BasicBlock (Name "here") [-                          ] (-                            Do $ Ret (Just (ConstantOperand (C.Int 32 0))) []-                          )-                         ]-                       }-                     ] -              astOut <- withModuleFromAST' context astIn $ \mIn -> do-                runPassManager passManager mIn-                moduleAST mIn-              astOut @?= Module "<string>" Nothing Nothing [-                      GlobalDefinition $ functionDefaults {-                        G.returnType = i32,-                        G.name = Name "foo",-                        G.parameters = ([Parameter i32 (Name "x") []], False),-                        G.basicBlocks = [-                          BasicBlock (Name "here") [-                          ] (-                            Do $ Ret (Just (ConstantOperand (C.Int 32 0))) []-                          )-                        ]-                      },-                      GlobalDefinition $ functionDefaults {-                        G.returnType = A.T.void,-                        G.name = Name "abort"-                      }+        withPassManager (defaultPassSetSpec { transforms = [T.LowerInvoke] }) $ \passManager -> do+          let astIn = +                Module "<string>" Nothing Nothing [+                  GlobalDefinition $ functionDefaults {+                    G.returnType = i32,+                    G.name = Name "foo",+                    G.parameters = ([Parameter i32 (Name "x") []], False),+                    G.basicBlocks = [+                      BasicBlock (Name "here") [+                      ] (+                        Do $ Ret (Just (ConstantOperand (C.Int 32 0))) []+                      )                      ]+                   }+                 ] +          astOut <- withModuleFromAST' context astIn $ \mIn -> do+            runPassManager passManager mIn+            moduleAST mIn+          astOut @?= Module "<string>" Nothing Nothing [+                  GlobalDefinition $ functionDefaults {+                    G.returnType = i32,+                    G.name = Name "foo",+                    G.parameters = ([Parameter i32 (Name "x") []], False),+                    G.basicBlocks = [+                      BasicBlock (Name "here") [+                      ] (+                        Do $ Ret (Just (ConstantOperand (C.Int 32 0))) []+                      )+                    ]+                  }+                 ]    ]  ]

@@ -39,8 +39,10 @@     disableTailCalls <- arbitrary     enableFastInstructionSelection <- arbitrary     positionIndependentExecutable <- arbitrary-    enableSegmentedStacks <- arbitrary     useInitArray <- arbitrary+    disableIntegratedAssembler <- arbitrary+    compressDebugSections <- arbitrary+    trapUnreachable <- arbitrary     stackAlignmentOverride <- arbitrary     trapFunctionName <- elements [ "foo", "bar", "baz" ]     floatABIType <- arbitrary@@ -70,8 +72,5 @@       withTargetLibraryInfo triple $ \tli -> do         lf <- getLibraryFunction tli "printf"         lf @?= Just LF__printf-   ],-  testCase "Host" $ do-    features <- getHostCPUFeatures-    return ()+   ]  ]

@@ -2,6 +2,7 @@  import Test.Framework +import qualified LLVM.General.Test.CallingConvention as CallingConvention import qualified LLVM.General.Test.Constants as Constants import qualified LLVM.General.Test.DataLayout as DataLayout import qualified LLVM.General.Test.ExecutionEngine as ExecutionEngine@@ -17,6 +18,7 @@ import qualified LLVM.General.Test.Instrumentation as Instrumentation  tests = testGroup "llvm-general" [+    CallingConvention.tests,     Constants.tests,     DataLayout.tests,     ExecutionEngine.tests,