packages feed

llvm-general 3.4.0.1 → 3.4.1.0

raw patch · 6 files changed

+50/−14 lines, 6 filesdep ~llvm-generaldep ~llvm-general-pure

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

Files

llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.4.0.1+version: 3.4.1.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -16,7 +16,7 @@ 	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.   .-  For haddock, see <http://bscarlet.github.io/llvm-general/3.4.0.1/doc/html/llvm-general/index.html>.+  For haddock, see <http://bscarlet.github.io/llvm-general/3.4.1.0/doc/html/llvm-general/index.html>. extra-source-files:   src/LLVM/General/Internal/FFI/Analysis.h   src/LLVM/General/Internal/FFI/Constant.h@@ -56,7 +56,7 @@     parsec >= 3.1.3,     array >= 0.4.0.0,     setenv >= 0.1.0,-    llvm-general-pure == 3.4.0.1+    llvm-general-pure == 3.4.1.0   extra-libraries: stdc++   hs-source-dirs: src   extensions:@@ -188,8 +188,8 @@     HUnit >= 1.2.4.2,     test-framework-quickcheck2 >= 0.3.0.1,     QuickCheck >= 2.5.1.1,-    llvm-general == 3.4.0.1,-    llvm-general-pure == 3.4.0.1,+    llvm-general == 3.4.1.0,+    llvm-general-pure == 3.4.1.0,     containers >= 0.4.2.1,     mtl >= 2.0.1.0   hs-source-dirs: test
src/LLVM/General/Internal/Constant.hs view
@@ -26,6 +26,7 @@ import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI import LLVM.General.Internal.FFI.LLVMCTypes (valueSubclassIdP) import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.General.Internal.FFI.Type as FFI import qualified LLVM.General.Internal.FFI.User as FFI import qualified LLVM.General.Internal.FFI.Value as FFI import qualified LLVM.General.Internal.FFI.BinaryOperator as FFI@@ -92,11 +93,16 @@       f' <- referGlobal f       b' <- getBlockForAddress f b       liftIO $ FFI.blockAddress (FFI.upCast f') b'-    A.C.Struct p ms -> do-      Context context <- gets encodeStateContext+    A.C.Struct nm p ms -> do       p <- encodeM p       ms <- encodeM ms-      liftIO $ FFI.constStructInContext context ms p+      case nm of+        Nothing -> do+          Context context <- gets encodeStateContext+          liftIO $ FFI.constStructInContext context ms p+        Just nm -> do+          t <- lookupNamedType nm+          liftIO $ FFI.constNamedStruct t ms     o -> $(do       let constExprInfo =  ID.outerJoin ID.astConstantRecs (ID.innerJoin ID.astInstructionRecs ID.instructionDefs)       TH.caseE [| o |] $ do@@ -127,7 +133,8 @@   decodeM c = scopeAnyCont $ do     let v = FFI.upCast c :: Ptr FFI.Value         u = FFI.upCast c :: Ptr FFI.User-    t <- decodeM =<< liftIO (FFI.typeOf v)+    ft <- liftIO (FFI.typeOf v)+    t <- decodeM ft     valueSubclassId <- liftIO $ FFI.getValueSubclassId v     nOps <- liftIO $ FFI.getNumOperands u     let globalRef = return A.C.GlobalReference `ap` (getGlobalName =<< liftIO (FFI.isAGlobalValue v))@@ -171,8 +178,11 @@             return A.C.BlockAddress                 `ap` (getGlobalName =<< do liftIO $ FFI.isAGlobalValue =<< FFI.getBlockAddressFunction c)                `ap` (getLocalName =<< do liftIO $ FFI.getBlockAddressBlock c)-      [valueSubclassIdP|ConstantStruct|] -> -            return A.C.Struct `ap` (return $ A.isPacked t) `ap` getConstantOperands+      [valueSubclassIdP|ConstantStruct|] -> do+            return A.C.Struct+               `ap` (return $ case t of A.NamedTypeReference n -> Just n; _ -> Nothing)+               `ap` (decodeM =<< liftIO (FFI.isPackedStruct ft))+               `ap` getConstantOperands       [valueSubclassIdP|ConstantDataArray|] ->              return A.C.Array `ap` (return $ A.elementType t) `ap` getConstantData       [valueSubclassIdP|ConstantArray|] -> 
src/LLVM/General/Internal/FFI/Constant.hs view
@@ -53,6 +53,11 @@  constStructInContext ctx (n, cs) p = constStructInContext' ctx cs n p +foreign import ccall unsafe "LLVMConstNamedStruct" constNamedStruct' ::+  Ptr Type -> Ptr (Ptr Constant) -> CUInt -> IO (Ptr Constant)++constNamedStruct ty (n, cs) = constNamedStruct' ty cs n + foreign import ccall unsafe "LLVM_General_GetConstantDataSequentialElementAsConstant" getConstantDataSequentialElementAsConstant ::   Ptr Constant -> CUInt -> IO (Ptr Constant) 
src/LLVM/General/Internal/FFI/Value.hs view
@@ -32,3 +32,6 @@  foreign import ccall unsafe "LLVMReplaceAllUsesWith" replaceAllUsesWith ::   Ptr Value -> Ptr Value -> IO ()++foreign import ccall unsafe "LLVMDumpValue" dumpValue ::+  Ptr Value -> IO ()
test/LLVM/General/Test/Constants.hs view
@@ -91,7 +91,7 @@     ), (       "struct",       StructureType False (replicate 2 (IntegerType 32)),-      C.Struct False (replicate 2 (C.Int 32 1)),+      C.Struct Nothing False (replicate 2 (C.Int 32 1)),       "global { i32, i32 } { i32 1, i32 1 }"     ), (       "dataarray",@@ -101,7 +101,7 @@     ), (       "array",       ArrayType 3 (StructureType False [IntegerType 32]),-      C.Array (StructureType False [IntegerType 32]) [C.Struct False [C.Int 32 i] | i <- [1,2,1]],+      C.Array (StructureType False [IntegerType 32]) [C.Struct Nothing False [C.Int 32 i] | i <- [1,2,1]],       "global [3 x { i32 }] [{ i32 } { i32 1 }, { i32 } { i32 2 }, { i32 } { i32 1 }]"     ), (       "datavector",
test/LLVM/General/Test/Module.hs view
@@ -383,7 +383,25 @@                ]           s <- withModuleFromAST' context ast moduleLLVMAssembly           m <- withModuleFromLLVMAssembly' context s moduleAST-          m @?= ast+          m @?= ast,++      testCase "struct constant" $ do+        let s = "; ModuleID = '<string>'\n\+                \\n\+                \%0 = type { i32 }\n\+                \\n\+                \@0 = constant %0 { i32 1 }, align 4\n"+            ast = Module "<string>" Nothing Nothing [+              TypeDefinition (UnName 0) (Just $ StructureType False [IntegerType 32]),+              GlobalDefinition $ globalVariableDefaults {+                G.name = UnName 0,+                G.isConstant = True,+                G.type' = NamedTypeReference (UnName 0),+                G.initializer = Just $ C.Struct (Just $ UnName 0) False [ C.Int 32 1 ],+                G.alignment = 4+              }+             ]+        strCheck ast s    ],            testGroup "failures" [