packages feed

llvm-general 3.3.0.2 → 3.3.0.3

raw patch · 13 files changed

+113/−32 lines, 13 filessetup-changed

Files

Setup.hs view
@@ -61,6 +61,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"]        let genericPackageDescription' = genericPackageDescription {             condLibrary = do@@ -72,8 +73,8 @@                 condTreeComponents = condTreeComponents libraryCondTree ++ [                   (                     Var (Flag (FlagName "shared-llvm")),-                    CondNode (mempty { libBuildInfo = mempty { extraLibs = [sharedLib] } }) [] [],-                    Just (CondNode (mempty { libBuildInfo = mempty { extraLibs = staticLibs } }) [] [])+                    CondNode (mempty { libBuildInfo = mempty { extraLibs = [sharedLib] ++ externLibs } }) [] [],+                    Just (CondNode (mempty { libBuildInfo = mempty { extraLibs = staticLibs ++ externLibs } }) [] [])                   )                 ]                }
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.3.0.2+version: 3.3.0.3 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -34,7 +34,7 @@   type: git   location: git://github.com/bscarlet/llvm-general.git   branch: llvm-3.3-  tag: v3.3.0.2+  tag: v3.3.0.3  flag shared-llvm   description: link against llvm shared rather than static library
src/Control/Monad/AnyCont.hs view
@@ -6,10 +6,10 @@ module Control.Monad.AnyCont (     MonadAnyCont(..),     AnyContT(..),+    LiftAnyCont(..),     runAnyContT,     withAnyContT,     mapAnyContT,-    anyContIOToM,     anyContT   ) where
src/Control/Monad/AnyCont/Class.hs view
@@ -13,7 +13,6 @@ import Control.Monad.Trans.Error as Error import Control.Monad.Trans.State as State import Control.Monad.Trans.Phased as Phased-import Control.Monad.IO.Class  class MonadAnyCont b m | m -> b where   anyContToM :: (forall r . (a -> b r) -> b r) -> m a@@ -35,5 +34,17 @@   anyContToM = lift . anyContToM   scopeAnyCont = StateT . (scopeAnyCont .) . runStateT -anyContIOToM :: MonadIO m => (forall r . (a -> IO r) -> IO r) -> AnyContT m a-anyContIOToM ioac = AnyCont.anyContT (\c -> liftIO (ioac return) >>= c)+class LiftAnyCont b m where+  liftAnyCont :: (forall r . (a -> b r) -> b r) -> (forall r . (a -> m r) -> m r)++instance LiftAnyCont b b where+  liftAnyCont c = c++instance LiftAnyCont b m => LiftAnyCont b (PhasedT m) where+  liftAnyCont c = \q -> PhasedT (liftAnyCont c (unPhasedT . q))++instance LiftAnyCont b m => LiftAnyCont b (StateT s m) where+  liftAnyCont c = \q -> StateT $ \s -> (liftAnyCont c (($ s) . runStateT . q))++instance LiftAnyCont b m => LiftAnyCont b (ErrorT e m) where+  liftAnyCont c = \q -> ErrorT (liftAnyCont c (runErrorT . q))
src/LLVM/General/AST/Global.hs view
@@ -67,14 +67,14 @@ globalVariableDefaults :: Global globalVariableDefaults =    GlobalVariable {-  name = undefined,+  name = error "global variable name not defined",   linkage = L.External,   visibility = V.Default,   isThreadLocal = False,   addrSpace = AddrSpace 0,   hasUnnamedAddr = False,   isConstant = False,-  type' = undefined,+  type' = error "global variable type not defined",   initializer = Nothing,   section = Nothing,   alignment = 0@@ -84,11 +84,11 @@ globalAliasDefaults :: Global globalAliasDefaults =   GlobalAlias {-    name = undefined,+    name = error "global alias name not defined",     linkage = L.External,     visibility = V.Default,-    type' = undefined,-    aliasee = undefined+    type' = error "global alias type not defined",+    aliasee = error "global alias aliasee not defined"   }  -- | helper for making 'Function's@@ -99,9 +99,9 @@     visibility = V.Default,     callingConvention = CC.C,     returnAttributes = [],-    returnType = undefined,-    name = undefined,-    parameters = undefined,+    returnType = error "function return type not defined",+    name = error "function name not defined",+    parameters = ([], False),     functionAttributes = [],     section = Nothing,     alignment = 0,
src/LLVM/General/Internal/DecodeAST.hs view
@@ -67,7 +67,7 @@   )  instance MonadAnyCont IO DecodeAST where-  anyContToM = DecodeAST . anyContIOToM+  anyContToM c = DecodeAST (anyContToM (liftAnyCont c))   scopeAnyCont = DecodeAST . scopeAnyCont . unDecodeAST  runDecodeAST :: DecodeAST a -> IO a
src/LLVM/General/Internal/EncodeAST.hs view
@@ -52,7 +52,7 @@      )  instance MonadAnyCont IO EncodeAST where-  anyContToM = EncodeAST . anyContIOToM+  anyContToM c = EncodeAST (anyContToM (liftAnyCont c))   scopeAnyCont = EncodeAST . scopeAnyCont . unEncodeAST  lookupNamedType :: A.Name -> EncodeAST (Ptr FFI.Type)
src/LLVM/General/Internal/FFI/Builder.hs view
@@ -100,8 +100,15 @@ foreign import ccall unsafe "LLVM_General_BuildStore" buildStore ::   Ptr Builder -> Ptr Value -> Ptr Value -> CUInt -> LLVMBool -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildGEP" buildGetElementPtr ::+foreign import ccall unsafe "LLVMBuildGEP" buildGetElementPtr' ::   Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)++foreign import ccall unsafe "LLVMBuildInBoundsGEP" buildInBoundsGetElementPtr' ::+  Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)++buildGetElementPtr :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)+buildGetElementPtr builder (LLVMBool 1) = buildInBoundsGetElementPtr' builder+buildGetElementPtr builder (LLVMBool 0) = buildGetElementPtr' builder  foreign import ccall unsafe "LLVMBuildFence" buildFence ::   Ptr Builder -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)
src/LLVM/General/Internal/FFI/Instruction.hs view
@@ -119,9 +119,6 @@ foreign import ccall unsafe "LLVM_General_GetInBounds" getInBounds ::   Ptr Value -> IO LLVMBool -foreign import ccall unsafe "LLVM_General_SetInBounds" setInBounds ::-  Ptr Instruction -> LLVMBool -> IO ()- foreign import ccall unsafe "LLVM_General_GetAtomicRMWBinOp" getAtomicRMWBinOp ::   Ptr Instruction -> IO RMWOperation
src/LLVM/General/Internal/FFI/InstructionC.cpp view
@@ -168,10 +168,6 @@ 	return unwrap<GEPOperator>(i)->isInBounds(); } -void LLVM_General_SetInBounds(LLVMValueRef i, LLVMBool b) {-	unwrap<GetElementPtrInst>(i)->setIsInBounds(b);-}- LLVMAtomicRMWBinOp LLVM_General_GetAtomicRMWBinOp(LLVMValueRef i) { 	return wrap(unwrap<AtomicRMWInst>(i)->getOperation()); }
src/LLVM/General/Internal/Instruction.hs view
@@ -500,10 +500,8 @@               A.GetElementPtr { A.address = a, A.indices = is, A.inBounds = ib } -> do                  a' <- encodeM a                  (n, is') <- encodeM is-                 i <- liftIO $ FFI.buildGetElementPtr builder a' is' n s-                 when ib $ do-                   ib <- encodeM ib -                   liftIO $ FFI.setInBounds i ib+                 ib <- encodeM ib +                 i <- liftIO $ FFI.buildGetElementPtr builder ib a' is' n s                  return' i               A.Fence { A.atomicity = at } -> do                  (ss, mo) <- encodeM at
test/LLVM/General/Test/Instructions.hs view
@@ -538,6 +538,46 @@         ]       )    ],+  testCase "GEP inBounds constant" $ do+    let mAST = Module "<string>" Nothing Nothing [+          GlobalDefinition $ globalVariableDefaults {+            G.name = Name "fortytwo",+            G.type' = IntegerType 32,+            G.isConstant = True,+            G.initializer = Just $ C.Int 32 42+          },+          GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (UnName 0) ([+            ],False) [] Nothing 0 [+              BasicBlock (UnName 1) [+                 UnName 2 := GetElementPtr {+                   inBounds = True,+                   address = ConstantOperand (C.GlobalReference (Name "fortytwo")),+                   indices = [ ConstantOperand (C.Int 32 0) ],+                   metadata = []+                 },+                 UnName 3 := Load {+                   volatile = False,+                   address = LocalReference (UnName 2),+                   maybeAtomicity = Nothing,+                   alignment = 1,+                   metadata = []+                 }+               ] (+                Do $ Ret (Just (LocalReference (UnName 3))) []+               )+             ]+            ]+        mStr = "; ModuleID = '<string>'\n\+               \\n\+               \@0 = constant i32 42\n\+               \\n\+               \define i32 @1() {\n\+               \  %1 = load i32* @0, align 1\n\+               \  ret i32 %1\n\+               \}\n"+    s <- withContext $ \context -> withModuleFromAST context mAST moduleString+    s @?= Right mStr,+       testGroup "terminators" [     testCase name $ strCheck mAST mStr     | (name, mAST, mStr) <- [
test/LLVM/General/Test/Module.hs view
@@ -7,6 +7,7 @@ import LLVM.General.Test.Support  import Data.Bits+import Data.Word import Data.Functor  import LLVM.General.Context@@ -301,9 +302,39 @@               \there:                                            ; preds = %elsewhere\n\               \  ret i32 %1\n\               \}\n"-      strCheck ast s-   ],+      strCheck ast s, +      testCase "switchblock" $ do+        let count = 450+            start = 2 -- won't come back the same w/o start = 2+            ns = [start..count + start - 1]+            vbps = zip [ ConstantOperand (C.Int 32 i) | i <- [0..] ] [ UnName n | n <- (1:ns) ]+            cbps = zip [ C.Int 32 i | i <- [0..] ] [ UnName n | n <- ns ]++        withContext $ \context -> do+          let ast = Module "<string>" Nothing Nothing [+                GlobalDefinition $ functionDefaults {+                  G.name = Name "foo",+                  G.returnType = IntegerType 32,+                  G.parameters = ([Parameter (IntegerType 32) (UnName 0) []], False),+                  G.basicBlocks = [+                   BasicBlock (UnName 1) [] (Do $ Switch (LocalReference $ UnName 0) (Name "end") cbps [])+                  ] ++ [+                   BasicBlock (UnName n) [] (Do $ Br (Name "end") []) | n <- ns+                  ] ++ [+                   BasicBlock (Name "end") [+                     Name "val" := Phi (IntegerType 32) vbps []+                   ] (+                     Do $ Ret (Just (LocalReference (Name "val"))) []+                   )+                  ]+                }+               ]+          Right s <- withModuleFromAST context ast moduleString+          Right m <- withModuleFromString context s moduleAST+          m @?= ast+   ],+           testGroup "failures" [     testCase "bad block reference" $ withContext $ \context -> do       let badAST = Module "<string>" Nothing Nothing [