packages feed

llvm-general 3.2.0.2 → 3.2.0.3

raw patch · 12 files changed

+100/−29 lines, 12 filessetup-changed

Files

Setup.hs view
@@ -1,10 +1,12 @@ import Control.Monad-import Data.List (isPrefixOf, (\\))+import Data.Monoid+import Data.Maybe+import Data.List (isPrefixOf, (\\), intercalate, stripPrefix) import Data.Map (Map) import qualified Data.Map as Map import Distribution.Simple import Distribution.Simple.Program-import Distribution.Simple.Setup+import Distribution.Simple.Setup hiding (Flag) import Distribution.Simple.LocalBuildInfo import Distribution.PackageDescription import System.Environment@@ -45,25 +47,35 @@             defaultMainWithHooks simpleUserHooks {     hookedPrograms = [ llvmProgram ],+     confHook = \(genericPackageDescription, hookedBuildInfo) configFlags -> do       llvmConfig <- getLLVMConfig configFlags -      cppflags <- llvmConfig ["--cppflags"]-      let useCppFlags = (filter ("-D" `isPrefixOf`) $ words cppflags) \\ (map ("-D"++) uncheckedHsFFIDefines)+      llvmCppFlags <- do+        l <- llvmConfig ["--cppflags"]+        return $ (filter ("-D" `isPrefixOf`) $ words l) \\ (map ("-D"++) uncheckedHsFFIDefines)       includeDirs <- liftM lines $ llvmConfig ["--includedir"]       libDirs@[libDir] <- liftM lines $ llvmConfig ["--libdir"]+      [llvmVersion] <- liftM lines $ llvmConfig ["--version"]+      let sharedLib = case llvmVersion of+                        "3.2" -> "LLVM-3.2svn"+                        x -> "LLVM-" ++ x+      staticLibs <- liftM (map (fromJust . stripPrefix "-l") . words) $ llvmConfig ["--libs"]        let genericPackageDescription' = genericPackageDescription {             condLibrary = do               libraryCondTree <- condLibrary genericPackageDescription               return libraryCondTree {-                condTreeData = -                  let library = condTreeData libraryCondTree-                  in library { -                    libBuildInfo = -                      let buildInfo = libBuildInfo library -                      in buildInfo { ccOptions = ccOptions buildInfo ++ useCppFlags }-                    }+                condTreeData = condTreeData libraryCondTree <> mempty {+                    libBuildInfo = mempty { ccOptions = llvmCppFlags }+                  },+                condTreeComponents = condTreeComponents libraryCondTree ++ [+                  (+                    Var (Flag (FlagName "shared-llvm")),+                    CondNode (mempty { libBuildInfo = mempty { extraLibs = [sharedLib] } }) [] [],+                    Just (CondNode (mempty { libBuildInfo = mempty { extraLibs = staticLibs } }) [] [])+                  )+                ]                }            }           configFlags' = configFlags {@@ -72,11 +84,20 @@            }       addLLVMToLdLibraryPath configFlags'       confHook simpleUserHooks (genericPackageDescription', hookedBuildInfo) configFlags',+     buildHook = \packageDescription localBuildInfo userHooks buildFlags -> do       addLLVMToLdLibraryPath (configFlags localBuildInfo)       buildHook simpleUserHooks packageDescription localBuildInfo userHooks buildFlags,+     testHook = \packageDescription localBuildInfo userHooks testFlags -> do       addLLVMToLdLibraryPath (configFlags localBuildInfo)-      testHook simpleUserHooks packageDescription localBuildInfo userHooks testFlags+      testHook simpleUserHooks packageDescription localBuildInfo userHooks testFlags,++    haddockHook = \packageDescription localBuildInfo userHooks haddockFlags -> do+       let v = "GHCRTS"+       oldGhcRts <- lookupEnv v+       setEnv v (maybe id (\o n -> o ++ " " ++ n) oldGhcRts "-K32M")+       haddockHook simpleUserHooks packageDescription localBuildInfo userHooks haddockFlags+       maybe (unsetEnv v) (setEnv v) oldGhcRts    }
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.2.0.2+version: 3.2.0.3 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -33,7 +33,11 @@   type: git   location: git://github.com/bscarlet/llvm-general.git   branch: llvm-3.2-  tag: v3.2.0.2+  tag: v3.2.0.3++flag shared-llvm+  description: link against llvm shared rather than static library+  default: False  library   build-tools: llvm-config
src/LLVM/General/Internal/FFI/ExecutionEngine.hs view
@@ -14,19 +14,34 @@ data ExecutionEngine  foreign import ccall unsafe "LLVMCreateExecutionEngineForModule" createExecutionEngineForModule ::-    Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr CString -> IO CUInt+  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr CString -> IO CUInt +foreign import ccall unsafe "LLVMCreateInterpreterForModule" createInterpreterForModule ::+  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr CString -> IO CUInt++foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule ::+  Ptr (Ptr ExecutionEngine) -> Ptr Module -> CUInt -> Ptr CString -> IO CUInt+ foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine ::-    Ptr ExecutionEngine -> IO ()+  Ptr ExecutionEngine -> IO ()  foreign import ccall unsafe "LLVMAddModule" addModule ::-    Ptr ExecutionEngine -> Ptr Module -> IO ()+  Ptr ExecutionEngine -> Ptr Module -> IO ()  foreign import ccall unsafe "LLVMRemoveModule" removeModule ::-    Ptr ExecutionEngine -> Ptr Module -> Ptr (Ptr Module) -> Ptr CString -> IO CUInt+  Ptr ExecutionEngine -> Ptr Module -> Ptr (Ptr Module) -> Ptr CString -> IO CUInt  foreign import ccall unsafe "LLVMFindFunction" findFunction ::-    Ptr ExecutionEngine -> CString -> Ptr (Ptr Function) -> IO CUInt+  Ptr ExecutionEngine -> CString -> Ptr (Ptr Function) -> IO CUInt  foreign import ccall unsafe "LLVMGetPointerToGlobal" getPointerToGlobal ::-    Ptr ExecutionEngine -> Ptr GlobalValue -> IO (Ptr ())+  Ptr ExecutionEngine -> Ptr GlobalValue -> IO (Ptr ())++foreign import ccall unsafe "LLVMLinkInInterpreter" linkInInterpreter :: +  IO ()++foreign import ccall unsafe "LLVMLinkInJIT" linkInJIT :: +  IO ()++foreign import ccall unsafe "LLVMLinkInMCJIT" linkInMCJIT :: +  IO ()
src/LLVM/General/Internal/FFI/Module.hs view
@@ -84,3 +84,6 @@  foreign import ccall unsafe "LLVM_General_ModuleGetInlineAsm" moduleGetInlineAsm ::   Ptr Module -> IO (ModuleAsm CString)++foreign import ccall unsafe "LLVM_General_WriteBitcodeToFile" writeBitcodeToFile ::+  Ptr Module -> CString -> Ptr CString -> IO Int
src/LLVM/General/Internal/FFI/ModuleC.cpp view
@@ -3,7 +3,8 @@ #include "llvm/Module.h"  #include "llvm-c/Core.h"-#include <iostream>+#include "llvm/Support/raw_ostream.h"+#include "llvm/Bitcode/ReaderWriter.h"  using namespace llvm; @@ -52,6 +53,19 @@  const char *LLVM_General_ModuleGetInlineAsm(LLVMModuleRef m) { 	return unwrap(m)->getModuleInlineAsm().c_str();+}++LLVMBool LLVM_General_WriteBitcodeToFile(LLVMModuleRef m, const char *path, char **error) {+  std::string ErrorInfo;+  raw_fd_ostream OS(path, ErrorInfo, raw_fd_ostream::F_Binary);++  if (!ErrorInfo.empty()) {+    *error = strdup(ErrorInfo.c_str());+    return -1;+  }++  WriteBitcodeToFile(unwrap(m), OS);+  return 0; }  }
src/LLVM/General/Internal/FFI/TargetC.cpp view
@@ -2,6 +2,7 @@ #include "llvm/Support/TargetRegistry.h" #include "llvm/Target/TargetMachine.h" #include "llvm/ADT/Triple.h"+#include "llvm/ExecutionEngine/Interpreter.h" #include "llvm-c/Target.h" #include "llvm-c/TargetMachine.h" #include "llvm-c/Core.h"
src/LLVM/General/Internal/Instruction.hs view
@@ -247,8 +247,8 @@                 "exact" -> (["b"], [| get_exact $(TH.dyn "b") |])                 "operand0" -> ([], [| op 0 |])                 "operand1" -> ([], [| op 1 |])-                "address" -> ([], [| op 0 |])-                "value" -> ([], [| op 1 |])+                "address" -> ([], case lrn of "Store" -> [| op 1 |]; _ -> [| op 0 |])+                "value" -> ([], case lrn of "Store" -> [| op 0 |]; _ -> [| op 1 |])                 "expected" -> ([], [| op 1 |])                 "replacement" -> ([], [| op 2 |])                 "condition'" -> ([], [| op 0 |])@@ -491,7 +491,7 @@                  al <- encodeM al                  vol <- encodeM vol                  (ss, mo) <- encodeM mat-                 i <- liftIO $ FFI.buildStore builder a' v' al vol mo ss s+                 i <- liftIO $ FFI.buildStore builder v' a' al vol mo ss s                  return $ FFI.upCast i               A.GetElementPtr { A.address = a, A.indices = is, A.inBounds = ib } -> do                  a' <- encodeM a
src/LLVM/General/Internal/Module.hs view
@@ -68,6 +68,15 @@ moduleString :: Module -> IO String moduleString (Module m) = bracket (FFI.getModuleAssembly m) free $ decodeM +writeBitcodeToFile :: FilePath -> Module -> IO ()+writeBitcodeToFile path (Module m) = flip runAnyContT return $ do+  msgPtr <- alloca+  path <- encodeM path+  result <- liftIO $ FFI.writeBitcodeToFile m path msgPtr+  when (result /= 0) $ do+    msg <- anyContT $ bracket (peek msgPtr) free+    fail =<< decodeM msg+ setTargetTriple :: Ptr FFI.Module -> String -> IO () setTargetTriple m t = flip runAnyContT return $ do   t <- encodeM t@@ -86,7 +95,8 @@ getDataLayout :: Ptr FFI.Module -> IO (Maybe A.DataLayout) getDataLayout m = parseDataLayout <$> (decodeM =<< FFI.getDataLayout m) --- | Build a 'Module' from a 'LLVM.General.AST.Module'.+-- | Build an LLVM.General.'Module' from a LLVM.General.AST.'LLVM.General.AST.Module' - i.e.+-- lower an AST from Haskell into C++ objects. withModuleFromAST :: Context -> A.Module -> (Module -> IO a) -> IO (Either String a) withModuleFromAST context@(Context c) (A.Module moduleId dataLayout triple definitions) f = do   let makeModule = flip runAnyContT return $ do@@ -189,7 +199,8 @@      either (return . Left) (const $ Right <$> f (Module m)) r --- | Get a 'LLVM.General.AST.Module' from a 'Module'.+-- | Get an LLVM.General.AST.'LLVM.General.AST.Module' from a LLVM.General.'Module' - i.e.+-- raise C++ objects into an Haskell AST. moduleAST :: Module -> IO A.Module moduleAST (Module mod) = runDecodeAST $ do   c <- return Context `ap` liftIO (FFI.getModuleContext mod)
src/LLVM/General/Module.hs view
@@ -1,9 +1,10 @@ -- | A 'Module' holds a C++ LLVM IR module. 'Module's may be converted to or from strings or Haskell ASTs, or--- added to an 'LLVM.General.ExecutionEngine' and so JIT compiled to get funciton pointers.+-- added to an 'LLVM.General.ExecutionEngine' and so JIT compiled to get function pointers. module LLVM.General.Module (     Module,     withModuleFromAST,     moduleAST,+    writeBitcodeToFile,     withModuleFromString,     moduleString   ) where
test/LLVM/General/Test/ExecutionEngine.hs view
@@ -44,6 +44,7 @@                    )                  ]                 ]+         s <- withModuleFromAST context mAST $ \m -> do           withModuleInEngine executionEngine m $ do             Just p <- findFunction executionEngine (Name "foo")
test/LLVM/General/Test/Instructions.hs view
@@ -511,8 +511,8 @@          ("store",           Do $ Store {             volatile = False,-            address = a 0,-            value = a 2,+            address = a 2,+            value = a 0,             maybeAtomicity = Nothing,             alignment = 0,             metadata = []
test/Test.hs view