packages feed

llvm-general 3.3.8.2 → 3.3.9.0

raw patch · 30 files changed

+457/−137 lines, 30 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.3.8.2+version: 3.3.9.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.3.8.2/doc/html/llvm-general/index.html>.+  For haddock, see <http://bscarlet.github.io/llvm-general/3.3.9.0/doc/html/llvm-general/index.html>. extra-source-files:   src/LLVM/General/Internal/FFI/Analysis.h   src/LLVM/General/Internal/FFI/Constant.h@@ -38,7 +38,7 @@   type: git   location: git://github.com/bscarlet/llvm-general.git   branch: llvm-3.3-  tag: v3.3.8.2+  tag: v3.3.9.0  flag shared-llvm   description: link against llvm shared rather than static library@@ -62,7 +62,7 @@     parsec >= 3.1.3,     array >= 0.4.0.0,     setenv >= 0.1.0,-    llvm-general-pure == 3.3.8.2+    llvm-general-pure == 3.3.9.0   extra-libraries: stdc++   hs-source-dirs: src   extensions:@@ -119,6 +119,7 @@     LLVM.General.Internal.Module     LLVM.General.Internal.Operand     LLVM.General.Internal.PassManager+    LLVM.General.Internal.RawOStream     LLVM.General.Internal.RMWOperation     LLVM.General.Internal.String     LLVM.General.Internal.Target@@ -128,7 +129,9 @@     LLVM.General.Internal.FFI.Assembly     LLVM.General.Internal.FFI.BasicBlock     LLVM.General.Internal.FFI.BinaryOperator+    LLVM.General.Internal.FFI.Bitcode     LLVM.General.Internal.FFI.Builder+    LLVM.General.Internal.FFI.ByteRangeCallback     LLVM.General.Internal.FFI.Cleanup     LLVM.General.Internal.FFI.CommandLine     LLVM.General.Internal.FFI.Constant@@ -149,6 +152,7 @@     LLVM.General.Internal.FFI.Module     LLVM.General.Internal.FFI.PassManager     LLVM.General.Internal.FFI.PtrHierarchy+    LLVM.General.Internal.FFI.RawOStream     LLVM.General.Internal.FFI.SMDiagnostic     LLVM.General.Internal.FFI.Target     LLVM.General.Internal.FFI.Transforms@@ -159,6 +163,7 @@   include-dirs: src   c-sources:      src/LLVM/General/Internal/FFI/AssemblyC.cpp+    src/LLVM/General/Internal/FFI/BitcodeC.cpp     src/LLVM/General/Internal/FFI/BuilderC.cpp     src/LLVM/General/Internal/FFI/ConstantC.cpp     src/LLVM/General/Internal/FFI/CommandLineC.cpp@@ -170,6 +175,7 @@     src/LLVM/General/Internal/FFI/InstructionC.cpp     src/LLVM/General/Internal/FFI/MetadataC.cpp     src/LLVM/General/Internal/FFI/ModuleC.cpp+    src/LLVM/General/Internal/FFI/RawOStreamC.cpp     src/LLVM/General/Internal/FFI/PassManagerC.cpp     src/LLVM/General/Internal/FFI/SMDiagnosticC.cpp     src/LLVM/General/Internal/FFI/TargetC.cpp@@ -188,8 +194,8 @@     HUnit >= 1.2.4.2,     test-framework-quickcheck2 >= 0.3.0.1,     QuickCheck >= 2.5.1.1,-    llvm-general == 3.3.8.2,-    llvm-general-pure == 3.3.8.2,+    llvm-general == 3.3.9.0,+    llvm-general-pure == 3.3.9.0,     containers >= 0.4.2.1,     mtl >= 2.0.1.0   hs-source-dirs: test
src/LLVM/General/Internal/Coding.hs view
@@ -83,7 +83,7 @@  instance Monad m => DecodeM m Bool FFI.LLVMBool where   decodeM (FFI.LLVMBool 0) = return $ False-  decodeM (FFI.LLVMBool 1) = return $ True+  decodeM (FFI.LLVMBool _) = return $ True  instance (Monad m, EncodeM m h (Ptr c)) => EncodeM m (Maybe h) (Ptr c) where   encodeM = maybe (return nullPtr) encodeM
src/LLVM/General/Internal/ExecutionEngine.hs view
@@ -14,7 +14,7 @@ import Data.Word import Data.IORef import Foreign.Ptr-import Foreign.C.Types (CUInt)+import Foreign.C (CUInt, CString) import Foreign.Marshal.Alloc (allocaBytes)  import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI@@ -61,7 +61,7 @@ withExecutionEngine ::    Context ->   Maybe (Ptr FFI.Module) -> -  (Ptr (Ptr FFI.ExecutionEngine) -> Ptr FFI.Module -> Ptr FFI.MallocedCString -> IO CUInt) ->+  (Ptr (Ptr FFI.ExecutionEngine) -> Ptr FFI.Module -> Ptr (FFI.OwnerTransfered CString) -> IO CUInt) ->   (Ptr FFI.ExecutionEngine -> IO a) ->   IO a withExecutionEngine c m createEngine f = flip runAnyContT return $ do
src/LLVM/General/Internal/FFI/Analysis.hs view
@@ -10,4 +10,4 @@ import LLVM.General.Internal.FFI.Module  foreign import ccall unsafe "LLVMVerifyModule" verifyModule ::-  Ptr Module -> VerifierFailureAction -> Ptr MallocedCString -> IO LLVMBool+  Ptr Module -> VerifierFailureAction -> Ptr (OwnerTransfered CString) -> IO LLVMBool
src/LLVM/General/Internal/FFI/Assembly.hs view
@@ -6,20 +6,21 @@ module LLVM.General.Internal.FFI.Assembly where  import LLVM.General.Internal.FFI.Context +import LLVM.General.Internal.FFI.MemoryBuffer import LLVM.General.Internal.FFI.Module+import LLVM.General.Internal.FFI.RawOStream import LLVM.General.Internal.FFI.SMDiagnostic import LLVM.General.Internal.FFI.LLVMCTypes -import Foreign.C import Foreign.Ptr --- | Use LLVM's parser to parse a string of llvm assembly to get a module-foreign import ccall unsafe "LLVM_General_GetModuleFromAssemblyInContext" getModuleFromAssemblyInContext ::-    Ptr Context -> CString -> Ptr SMDiagnostic -> IO (Ptr Module)+-- | Use LLVM's parser to parse a string of llvm assembly in a memory buffer to get a module+foreign import ccall unsafe "LLVM_General_ParseLLVMAssembly" parseLLVMAssembly ::+  Ptr Context -> OwnerTransfered (Ptr MemoryBuffer) -> Ptr SMDiagnostic -> IO (Ptr Module)  -- | LLVM's serializer to generate a string of llvm assembly from a module-foreign import ccall unsafe "LLVM_General_GetModuleAssembly" getModuleAssembly ::-    Ptr Module -> IO MallocedCString+foreign import ccall unsafe "LLVM_General_WriteLLVMAssembly" writeLLVMAssembly ::+  Ptr Module -> Ptr RawOStream -> IO ()
src/LLVM/General/Internal/FFI/AssemblyC.cpp view
@@ -6,6 +6,7 @@ #include "llvm/Pass.h" #include "llvm/Support/SourceMgr.h" #include "llvm/Support/raw_ostream.h"+#include "llvm/Support/MemoryBuffer.h"  #include "llvm-c/Core.h" @@ -13,21 +14,16 @@  extern "C" { -LLVMModuleRef LLVM_General_GetModuleFromAssemblyInContext(+LLVMModuleRef LLVM_General_ParseLLVMAssembly( 	LLVMContextRef context,-	const char *assembly,+	LLVMMemoryBufferRef memoryBuffer, 	SMDiagnostic *error ) {-	return wrap(ParseAssemblyString(assembly, NULL, *error, *unwrap(context))); +	return wrap(ParseAssembly(unwrap(memoryBuffer), NULL, *error, *unwrap(context))); } -char *LLVM_General_GetModuleAssembly(LLVMModuleRef module) {-	std::string s;-	raw_string_ostream buf(s);-	ModulePass *printPass = createPrintModulePass(&buf);-	printPass->runOnModule(*unwrap(module));-	delete printPass;-	return strdup(buf.str().c_str());+void LLVM_General_WriteLLVMAssembly(LLVMModuleRef module, raw_ostream &os) {+	os << *unwrap(module); }  }
+ src/LLVM/General/Internal/FFI/Bitcode.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE+  ForeignFunctionInterface+  #-}++-- | Functions to read and write LLVM bitcode+module LLVM.General.Internal.FFI.Bitcode where++import LLVM.General.Internal.FFI.RawOStream+import LLVM.General.Internal.FFI.Context +import LLVM.General.Internal.FFI.MemoryBuffer+import LLVM.General.Internal.FFI.Module+import LLVM.General.Internal.FFI.LLVMCTypes++import Foreign.C+import Foreign.Ptr++foreign import ccall unsafe "LLVM_General_ParseBitcode" parseBitcode ::+  Ptr Context -> Ptr MemoryBuffer -> Ptr (OwnerTransfered CString) -> IO (Ptr Module)++foreign import ccall unsafe "LLVM_General_WriteBitcode" writeBitcode ::+  Ptr Module -> Ptr RawOStream -> IO ()++                               +
+ src/LLVM/General/Internal/FFI/BitcodeC.cpp view
@@ -0,0 +1,30 @@+#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"+#include "llvm/Support/raw_ostream.h"+#include "llvm/Support/MemoryBuffer.h"+#include "llvm/Bitcode/ReaderWriter.h"++using namespace llvm;++extern "C" {++LLVMModuleRef LLVM_General_ParseBitcode(+	LLVMContextRef c,+	LLVMMemoryBufferRef mb, +	char **error+) {+	std::string msg;+	Module *m = ParseBitcodeFile(unwrap(mb), *unwrap(c), &msg);+	if (m == 0) *error = strdup(msg.c_str());+	return wrap(m);+}++void LLVM_General_WriteBitcode(LLVMModuleRef m, raw_ostream &os) {+	WriteBitcodeToFile(unwrap(m), os);+}++}+
src/LLVM/General/Internal/FFI/Builder.hs view
@@ -102,7 +102,7 @@ buildGetElementPtr builder (LLVMBool 1) = buildInBoundsGetElementPtr' builder buildGetElementPtr builder (LLVMBool 0) = buildGetElementPtr' builder -foreign import ccall unsafe "LLVMBuildFence" buildFence ::+foreign import ccall unsafe "LLVM_General_BuildFence" buildFence ::   Ptr Builder -> MemoryOrdering -> LLVMBool -> CString -> IO (Ptr Instruction)  foreign import ccall unsafe "LLVM_General_BuildAtomicCmpXchg" buildCmpXchg ::
src/LLVM/General/Internal/FFI/BuilderC.cpp view
@@ -113,7 +113,7 @@ 	return wrap(i); } -LLVMValueRef LLVMBuildFence(+LLVMValueRef LLVM_General_BuildFence( 	LLVMBuilderRef b, LLVMAtomicOrdering lao, LLVMSynchronizationScope lss, const char *name ) { 	FenceInst *i = unwrap(b)->CreateFence(unwrap(lao), unwrap(lss));
+ src/LLVM/General/Internal/FFI/ByteRangeCallback.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE+  ForeignFunctionInterface+  #-}+module LLVM.General.Internal.FFI.ByteRangeCallback where++import Foreign.C+import Foreign.Ptr++type ByteRangeCallback = Ptr CChar -> CSize -> IO ()+foreign import ccall "wrapper" wrapByteRangeCallback :: +  ByteRangeCallback -> IO (FunPtr ByteRangeCallback)+
src/LLVM/General/Internal/FFI/DataLayout.hs view
@@ -21,4 +21,4 @@   Ptr DataLayout -> IO ()  foreign import ccall unsafe "LLVMCopyStringRepOfTargetData" dataLayoutToString ::-  Ptr DataLayout -> IO MallocedCString+  Ptr DataLayout -> IO (OwnerTransfered CString)
src/LLVM/General/Internal/FFI/ExecutionEngine.hs view
@@ -14,16 +14,16 @@ data ExecutionEngine  foreign import ccall unsafe "LLVMCreateExecutionEngineForModule" createExecutionEngineForModule ::-  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr MallocedCString -> IO CUInt+  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr (OwnerTransfered CString) -> IO CUInt  foreign import ccall unsafe "LLVMCreateInterpreterForModule" createInterpreterForModule ::-  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr MallocedCString -> IO CUInt+  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr (OwnerTransfered CString) -> IO CUInt  foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule ::-  Ptr (Ptr ExecutionEngine) -> Ptr Module -> CUInt -> Ptr MallocedCString -> IO CUInt+  Ptr (Ptr ExecutionEngine) -> Ptr Module -> CUInt -> Ptr (OwnerTransfered CString) -> IO CUInt  foreign import ccall unsafe "LLVMCreateMCJITCompilerForModule" createMCJITCompilerForModule ::-  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr MCJITCompilerOptions -> CSize -> Ptr MallocedCString -> IO CUInt+  Ptr (Ptr ExecutionEngine) -> Ptr Module -> Ptr MCJITCompilerOptions -> CSize -> Ptr (OwnerTransfered CString) -> IO CUInt  foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine ::   Ptr ExecutionEngine -> IO ()
src/LLVM/General/Internal/FFI/LLVMCTypes.hsc view
@@ -54,7 +54,7 @@  newtype LLVMBool = LLVMBool CUInt -newtype MallocedCString = MallocedCString CString+newtype OwnerTransfered a = OwnerTransfered a   deriving (Storable)  newtype NothingAsMinusOne h = NothingAsMinusOne CInt
src/LLVM/General/Internal/FFI/MemoryBuffer.hs view
@@ -3,10 +3,18 @@   #-} module LLVM.General.Internal.FFI.MemoryBuffer where +import LLVM.General.Internal.FFI.LLVMCTypes+ import Foreign.Ptr import Foreign.C  data MemoryBuffer++foreign import ccall unsafe "LLVMCreateMemoryBufferWithContentsOfFile" createMemoryBufferWithContentsOfFile ::+  Ptr CChar -> Ptr (Ptr MemoryBuffer) -> Ptr (OwnerTransfered CString) -> IO LLVMBool++foreign import ccall unsafe "LLVMCreateMemoryBufferWithMemoryRange" createMemoryBufferWithMemoryRange ::+  Ptr CChar -> CSize -> CString -> LLVMBool -> IO (Ptr MemoryBuffer)  foreign import ccall unsafe "LLVMGetBufferStart" getBufferStart ::   Ptr MemoryBuffer -> IO (Ptr CChar)
src/LLVM/General/Internal/FFI/Module.hs view
@@ -34,7 +34,7 @@   Ptr Module -> CString -> IO ()  foreign import ccall unsafe "LLVM_General_GetModuleIdentifier" getModuleIdentifier ::-  Ptr Module -> IO MallocedCString+  Ptr Module -> IO (OwnerTransfered CString)  foreign import ccall unsafe "LLVMGetFirstGlobal" getFirstGlobal ::   Ptr Module -> IO (Ptr GlobalVariable)@@ -86,8 +86,5 @@ 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 MallocedCString -> IO LLVMBool- foreign import ccall unsafe "LLVMLinkModules" linkModules ::-  Ptr Module -> Ptr Module -> LinkerMode -> Ptr MallocedCString -> IO LLVMBool+  Ptr Module -> Ptr Module -> LinkerMode -> Ptr (OwnerTransfered CString) -> IO LLVMBool
src/LLVM/General/Internal/FFI/ModuleC.cpp view
@@ -1,10 +1,6 @@ #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"-#include "llvm/Support/raw_ostream.h"-#include "llvm/Bitcode/ReaderWriter.h"  using namespace llvm; @@ -55,18 +51,4 @@ 	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/RawOStream.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE+  ForeignFunctionInterface+  #-}+module LLVM.General.Internal.FFI.RawOStream where++import LLVM.General.Internal.FFI.ByteRangeCallback++import Foreign.Ptr+import Foreign.C+import Control.Exception (bracket)++import LLVM.General.Internal.FFI.LLVMCTypes++data RawOStream++type RawOStreamCallback = Ptr RawOStream -> IO ()+foreign import ccall "wrapper" wrapRawOStreamCallback ::+  RawOStreamCallback -> IO (FunPtr RawOStreamCallback)++foreign import ccall safe "LLVM_General_WithFileRawOStream" withFileRawOStream' ::+  CString -> LLVMBool -> LLVMBool -> Ptr (OwnerTransfered CString) -> FunPtr RawOStreamCallback -> IO LLVMBool+ +withFileRawOStream :: CString -> LLVMBool -> LLVMBool -> Ptr (OwnerTransfered CString) -> RawOStreamCallback -> IO LLVMBool+withFileRawOStream p ex bin err c = +  bracket (wrapRawOStreamCallback c) freeHaskellFunPtr (withFileRawOStream' p ex bin err)++foreign import ccall safe "LLVM_General_WithBufferRawOStream" withBufferRawOStream' ::+  FunPtr ByteRangeCallback -> FunPtr RawOStreamCallback -> IO ()++withBufferRawOStream :: ByteRangeCallback -> RawOStreamCallback -> IO ()+withBufferRawOStream oc c = +  bracket (wrapRawOStreamCallback c) freeHaskellFunPtr $ \c -> +  bracket (wrapByteRangeCallback oc) freeHaskellFunPtr $ \oc ->+    withBufferRawOStream' oc c
+ src/LLVM/General/Internal/FFI/RawOStreamC.cpp view
@@ -0,0 +1,41 @@+#define __STDC_LIMIT_MACROS+#include "llvm/Support/raw_ostream.h"+#include "llvm-c/Core.h"++using namespace llvm;+static const unsigned F_None = 0;+static const unsigned F_Excl = raw_fd_ostream::F_Excl;+static const unsigned F_Binary = raw_fd_ostream::F_Binary;++extern "C" {++LLVMBool LLVM_General_WithFileRawOStream(+	const char *filename,+	LLVMBool excl,+	LLVMBool binary,+	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));+	if (!e.empty()) {+		error = strdup(e.c_str());+		return false;+	}+	callback(os);+	return true;+}++void LLVM_General_WithBufferRawOStream(+	void (&outputCallback)(const char *start, size_t length),+	void (&streamCallback)(raw_ostream &ostream)+) {+	std::string s;+	{+		raw_string_ostream os(s);+		streamCallback(os);+	}+	outputCallback(s.data(), s.size());+}+	+}
src/LLVM/General/Internal/FFI/Target.hs view
@@ -8,8 +8,8 @@ import Foreign.C  import LLVM.General.Internal.FFI.LLVMCTypes-import LLVM.General.Internal.FFI.MemoryBuffer import LLVM.General.Internal.FFI.Module+import LLVM.General.Internal.FFI.RawOStream  data Target @@ -17,7 +17,7 @@     IO LLVMBool  foreign import ccall unsafe "LLVM_General_LookupTarget" lookupTarget ::-    CString -> CString -> Ptr MallocedCString -> Ptr MallocedCString -> IO (Ptr Target)+    CString -> CString -> Ptr (OwnerTransfered CString) -> Ptr (OwnerTransfered CString) -> IO (Ptr Target)  data TargetOptions @@ -79,15 +79,12 @@ foreign import ccall unsafe "LLVMDisposeTargetMachine" disposeTargetMachine ::   Ptr TargetMachine -> IO () -foreign import ccall unsafe "LLVMTargetMachineEmitToFile" targetMachineEmitToFile ::-  Ptr TargetMachine -> Ptr Module -> CString -> CodeGenFileType -> Ptr MallocedCString -> IO LLVMBool--foreign import ccall unsafe "LLVMTargetMachineEmitToMemoryBuffer" targetMachineEmitToMemoryBuffer ::+foreign import ccall unsafe "LLVM_General_TargetMachineEmit" targetMachineEmit ::   Ptr TargetMachine   -> Ptr Module   -> CodeGenFileType-  -> Ptr MallocedCString-  -> Ptr (Ptr MemoryBuffer)+  -> Ptr (OwnerTransfered CString)+  -> Ptr RawOStream   -> IO LLVMBool  data TargetLowering@@ -96,19 +93,19 @@   Ptr TargetMachine -> IO (Ptr TargetLowering)  foreign import ccall unsafe "LLVM_General_GetDefaultTargetTriple" getDefaultTargetTriple :: -  IO MallocedCString+  IO (OwnerTransfered CString)  foreign import ccall unsafe "LLVM_General_GetProcessTargetTriple" getProcessTargetTriple :: -  IO MallocedCString+  IO (OwnerTransfered CString)  foreign import ccall unsafe "LLVM_General_GetHostCPUName" getHostCPUName :: -  IO MallocedCString+  IO (OwnerTransfered CString)  foreign import ccall unsafe "LLVM_General_GetHostCPUFeatures" getHostCPUFeatures :: -  IO MallocedCString+  IO (OwnerTransfered CString)  foreign import ccall unsafe "LLVM_General_GetTargetMachineDataLayout" getTargetMachineDataLayout ::-  Ptr TargetMachine -> IO MallocedCString+  Ptr TargetMachine -> IO (OwnerTransfered CString)  data TargetLibraryInfo
src/LLVM/General/Internal/FFI/TargetC.cpp view
@@ -2,11 +2,14 @@ #include "llvm/Support/TargetRegistry.h" #include "llvm/Support/TargetSelect.h" #include "llvm/Support/Host.h"+#include "llvm/Support/FormattedStream.h" #include "llvm/Target/TargetMachine.h" #include "llvm/Target/TargetLibraryInfo.h"+#include "llvm/PassManager.h" #include "llvm/ADT/Triple.h" #include "llvm/ExecutionEngine/Interpreter.h" #include "llvm/IR/DataLayout.h"+#include "llvm/IR/Module.h" #include "llvm-c/Target.h" #include "llvm-c/TargetMachine.h" #include "llvm-c/Core.h"@@ -97,7 +100,16 @@ 	default: return  LLVM_General_FPOpFusionMode(0); 	} }++static TargetMachine::CodeGenFileType unwrap(LLVMCodeGenFileType x) {+	switch(x) {+#define ENUM_CASE(x) case LLVM ## x ## File: return TargetMachine::CGFT_ ## x ## File;+		LLVM_GENERAL_FOR_EACH_CODE_GEN_FILE_TYPE(ENUM_CASE)+#undef ENUM_CASE+	default: return TargetMachine::CodeGenFileType(0);+	} }+}  extern "C" { @@ -270,5 +282,31 @@ 	InitializeAllAsmPrinters(); 	// None of the other components are bound yet }++LLVMBool LLVM_General_TargetMachineEmit(+	LLVMTargetMachineRef TM,+	LLVMModuleRef M,+	LLVMCodeGenFileType codeGenFileType,+	char **ErrorMessage,+	raw_ostream &dest+) {+	formatted_raw_ostream destf(dest);+	TargetMachine &tm = *unwrap(TM);+	const DataLayout *td = tm.getDataLayout();+	if (!td) {+		*ErrorMessage = strdup("No DataLayout in TargetMachine");+		return true;+	}+	PassManager passManager;+	passManager.add(new DataLayout(*td));+	if (tm.addPassesToEmitFile(passManager, destf, unwrap(codeGenFileType))) {+		*ErrorMessage = strdup("TargetMachine can't emit a file of this type");+		return true;+	}++	passManager.run(*unwrap(M));+	return false;+}+  }
src/LLVM/General/Internal/MemoryBuffer.hs view
@@ -4,20 +4,49 @@   #-} module LLVM.General.Internal.MemoryBuffer where +import Control.Exception import Control.Monad+import Control.Monad.AnyCont import Control.Monad.IO.Class-import Data.ByteString+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS import Foreign.Ptr  import LLVM.General.Internal.Coding import LLVM.General.Internal.String+import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI import qualified LLVM.General.Internal.FFI.MemoryBuffer as FFI -instance MonadIO d => DecodeM d ByteString (Ptr FFI.MemoryBuffer) where+data Specification +  = Bytes { name :: String,  content :: BS.ByteString }+  | File { pathName :: String }++instance (Monad e, MonadIO e, MonadAnyCont IO e) => EncodeM e Specification (FFI.OwnerTransfered (Ptr FFI.MemoryBuffer)) where+  encodeM spec = liftM FFI.OwnerTransfered $ do+    case spec of+      Bytes name content -> do+        (s,l) <- anyContToM $ BS.unsafeUseAsCStringLen (BS.snoc content 0)+        name <- encodeM name+        nullTerminate <- encodeM True+        liftIO $ FFI.createMemoryBufferWithMemoryRange s (fromIntegral (l-1)) name nullTerminate+      File pathName -> do+        pathName <- encodeM pathName+        mbPtr <- alloca+        msgPtr <- alloca+        result <- decodeM =<< (liftIO $ FFI.createMemoryBufferWithContentsOfFile pathName mbPtr msgPtr)+        when result $ fail =<< decodeM msgPtr+        peek mbPtr          ++instance (Monad e, MonadIO e, MonadAnyCont IO e) => EncodeM e Specification (Ptr FFI.MemoryBuffer) where+  encodeM spec = do+    FFI.OwnerTransfered mb <- encodeM spec+    anyContToM $ bracket (return mb) FFI.disposeMemoryBuffer++instance MonadIO d => DecodeM d BS.ByteString (Ptr FFI.MemoryBuffer) where   decodeM p = do     s <- liftIO $ FFI.getBufferStart p     l <- liftIO $ FFI.getBufferSize p-    liftIO $ packCStringLen (s, fromIntegral l)+    liftIO $ BS.packCStringLen (s, fromIntegral l)  instance MonadIO d => DecodeM d String (Ptr FFI.MemoryBuffer) where   decodeM = decodeM . UTF8ByteString <=< decodeM
src/LLVM/General/Internal/Module.hs view
@@ -15,10 +15,13 @@ import Control.Exception  import Foreign.Ptr-import Data.ByteString (ByteString)+import Foreign.C+import Data.IORef+import qualified Data.ByteString as BS  import qualified LLVM.General.Internal.FFI.Assembly as FFI import qualified LLVM.General.Internal.FFI.Builder as FFI+import qualified LLVM.General.Internal.FFI.Bitcode as FFI import qualified LLVM.General.Internal.FFI.Function as FFI import qualified LLVM.General.Internal.FFI.GlobalAlias as FFI import qualified LLVM.General.Internal.FFI.GlobalValue as FFI@@ -29,6 +32,7 @@ import qualified LLVM.General.Internal.FFI.Metadata as FFI import qualified LLVM.General.Internal.FFI.Module as FFI import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.General.Internal.FFI.RawOStream as FFI import qualified LLVM.General.Internal.FFI.Target as FFI import qualified LLVM.General.Internal.FFI.Value as FFI @@ -41,9 +45,10 @@ import LLVM.General.Internal.Function import LLVM.General.Internal.Global import LLVM.General.Internal.Instruction ()-import LLVM.General.Internal.MemoryBuffer ()+import qualified LLVM.General.Internal.MemoryBuffer as MB  import LLVM.General.Internal.Metadata import LLVM.General.Internal.Operand+import LLVM.General.Internal.RawOStream import LLVM.General.Internal.String import LLVM.General.Internal.Target import LLVM.General.Internal.Type@@ -60,6 +65,9 @@ -- | <http://llvm.org/doxygen/classllvm_1_1Module.html> newtype Module = Module (Ptr FFI.Module) +newtype File = File FilePath+  deriving (Eq, Ord, Read, Show)+ instance Error (Either String Diagnostic) where     strMsg = Left @@ -83,60 +91,102 @@   result <- decodeM =<< (liftIO $ FFI.linkModules m m' preserveRight msgPtr)   when result $ fail =<< decodeM msgPtr +class LLVMAssemblyInput s where+  llvmAssemblyMemoryBuffer :: (MonadIO e, MonadAnyCont IO e) => s -> e (FFI.OwnerTransfered (Ptr FFI.MemoryBuffer))++instance LLVMAssemblyInput (String, String) where+  llvmAssemblyMemoryBuffer (id, s) = do+    UTF8ByteString bs <- encodeM s+    encodeM (MB.Bytes id bs)++instance LLVMAssemblyInput String where+  llvmAssemblyMemoryBuffer s = llvmAssemblyMemoryBuffer ("<string>", s)++instance LLVMAssemblyInput File where+  llvmAssemblyMemoryBuffer (File p) = encodeM (MB.File p)+ -- | parse 'Module' from LLVM assembly-withModuleFromString :: Context -> String -> (Module -> IO a) -> ErrorT (Either String Diagnostic) IO a-withModuleFromString (Context c) s f = flip runAnyContT return $ do-  s <- encodeM s+withModuleFromLLVMAssembly :: LLVMAssemblyInput s => Context -> s -> (Module -> IO a) -> ErrorT (Either String Diagnostic) IO a+withModuleFromLLVMAssembly (Context c) s f = flip runAnyContT return $ do+  mb <- llvmAssemblyMemoryBuffer s   smDiag <- anyContToM withSMDiagnostic-  m <- anyContToM $ bracket (FFI.getModuleFromAssemblyInContext c s smDiag) FFI.disposeModule+  m <- anyContToM $ bracket (FFI.parseLLVMAssembly c mb smDiag) FFI.disposeModule   when (m == nullPtr) $ throwError . Right =<< liftIO (getDiagnostic smDiag)   liftIO $ f (Module m)  -- | generate LLVM assembly from a 'Module'-moduleString :: Module -> IO String-moduleString (Module m) = decodeM =<< FFI.getModuleAssembly m+moduleLLVMAssembly :: Module -> IO String+moduleLLVMAssembly (Module m) = do+  resultRef <- newIORef Nothing+  let saveBuffer :: Ptr CChar -> CSize -> IO ()+      saveBuffer start size = do+        r <- decodeM (start, fromIntegral size)+        writeIORef resultRef (Just r)+  FFI.withBufferRawOStream saveBuffer $ FFI.writeLLVMAssembly m+  Just s <- readIORef resultRef+  return s --- | generate LLVM bitcode from a 'Module'-writeBitcodeToFile :: FilePath -> Module -> ErrorT String IO ()-writeBitcodeToFile path (Module m) = flip runAnyContT return $ do-  msgPtr <- alloca-  path <- encodeM path-  result <- decodeM =<< (liftIO $ FFI.writeBitcodeToFile m path msgPtr)-  when result $ fail =<< decodeM msgPtr+-- | write LLVM assembly for a 'Module' to a file+writeLLVMAssemblyToFile :: File -> Module -> ErrorT String IO ()+writeLLVMAssemblyToFile (File path) (Module m) = flip runAnyContT return $ do+  withFileRawOStream path False False $ liftIO . FFI.writeLLVMAssembly m -emitToFile :: FFI.CodeGenFileType -> TargetMachine -> FilePath -> Module -> ErrorT String IO ()-emitToFile fileType (TargetMachine tm) path (Module m) = flip runAnyContT return $ do+class BitcodeInput b where+  bitcodeMemoryBuffer :: (MonadIO e, MonadAnyCont IO e) => b -> e (Ptr FFI.MemoryBuffer)++instance BitcodeInput (String, BS.ByteString) where+  bitcodeMemoryBuffer (s, bs) = encodeM (MB.Bytes s bs)++instance BitcodeInput File where+  bitcodeMemoryBuffer (File p) = encodeM (MB.File p)++-- | parse 'Module' from LLVM bitcode+withModuleFromBitcode :: BitcodeInput b => Context -> b -> (Module -> IO a) -> ErrorT String IO a+withModuleFromBitcode (Context c) b f = flip runAnyContT return $ do+  mb <- bitcodeMemoryBuffer b   msgPtr <- alloca-  path <- encodeM path-  result <- decodeM =<< (liftIO $ FFI.targetMachineEmitToFile tm m path fileType msgPtr)-  when result $ fail =<< decodeM msgPtr+  m <- anyContToM $ bracket (FFI.parseBitcode c mb msgPtr) FFI.disposeModule+  when (m == nullPtr) $ fail =<< decodeM msgPtr+  liftIO $ f (Module m) --- | write target-specific assembly directly into a file-writeAssemblyToFile :: TargetMachine -> FilePath -> Module -> ErrorT String IO ()-writeAssemblyToFile = emitToFile FFI.codeGenFileTypeAssembly+-- | generate LLVM bitcode from a 'Module'+moduleBitcode :: Module -> IO BS.ByteString+moduleBitcode (Module m) = withBufferRawOStream (liftIO . FFI.writeBitcode m) --- | write target-specific object code directly into a file-writeObjectToFile :: TargetMachine -> FilePath -> Module -> ErrorT String IO ()-writeObjectToFile = emitToFile FFI.codeGenFileTypeObject+-- | write LLVM bitcode from a 'Module' into a file+writeBitcodeToFile :: File -> Module -> ErrorT String IO ()+writeBitcodeToFile (File path) (Module m) = flip runAnyContT return $ do+  withFileRawOStream path False True $ liftIO . FFI.writeBitcode m -emitToByteString :: FFI.CodeGenFileType -> TargetMachine -> Module -> ErrorT String IO ByteString-emitToByteString fileType (TargetMachine tm) (Module m) = flip runAnyContT return $ do+targetMachineEmit :: FFI.CodeGenFileType -> TargetMachine -> Module -> Ptr FFI.RawOStream -> ErrorT String IO ()+targetMachineEmit fileType (TargetMachine tm) (Module m) os = flip runAnyContT return $ do   msgPtr <- alloca-  memoryBufferPtr <- alloca-  result <- decodeM =<< (liftIO $ FFI.targetMachineEmitToMemoryBuffer tm m fileType msgPtr memoryBufferPtr)-  if result -    then-        fail =<< decodeM msgPtr-    else-        decodeM =<< anyContToM (bracket (peek memoryBufferPtr) FFI.disposeMemoryBuffer)+  r <- decodeM =<< (liftIO $ FFI.targetMachineEmit tm m fileType msgPtr os)+  when r $ fail =<< decodeM msgPtr +emitToFile :: FFI.CodeGenFileType -> TargetMachine -> File -> Module -> ErrorT String IO ()+emitToFile fileType tm (File path) m = flip runAnyContT return $ do+  withFileRawOStream path False True $ targetMachineEmit fileType tm m++emitToByteString :: FFI.CodeGenFileType -> TargetMachine -> Module -> ErrorT String IO BS.ByteString+emitToByteString fileType tm m = flip runAnyContT return $ do+  withBufferRawOStream $ targetMachineEmit fileType tm m++-- | write target-specific assembly directly into a file+writeTargetAssemblyToFile :: TargetMachine -> File -> Module -> ErrorT String IO ()+writeTargetAssemblyToFile = emitToFile FFI.codeGenFileTypeAssembly+ -- | produce target-specific assembly as a 'String'-moduleAssembly :: TargetMachine -> Module -> ErrorT String IO String-moduleAssembly tm m = decodeM . UTF8ByteString =<< emitToByteString FFI.codeGenFileTypeAssembly tm m+moduleTargetAssembly :: TargetMachine -> Module -> ErrorT String IO String+moduleTargetAssembly tm m = decodeM . UTF8ByteString =<< emitToByteString FFI.codeGenFileTypeAssembly tm m  -- | produce target-specific object code as a 'ByteString'-moduleObject :: TargetMachine -> Module -> ErrorT String IO ByteString+moduleObject :: TargetMachine -> Module -> ErrorT String IO BS.ByteString moduleObject = emitToByteString FFI.codeGenFileTypeObject++-- | write target-specific object code directly into a file+writeObjectToFile :: TargetMachine -> File -> Module -> ErrorT String IO ()+writeObjectToFile = emitToFile FFI.codeGenFileTypeObject  setTargetTriple :: Ptr FFI.Module -> String -> EncodeAST () setTargetTriple m t = do
+ src/LLVM/General/Internal/RawOStream.hs view
@@ -0,0 +1,61 @@+module LLVM.General.Internal.RawOStream where++import Control.Monad+import Control.Monad.Error+import Control.Monad.AnyCont++import Data.IORef+import Foreign.C+import Foreign.Ptr++import qualified  LLVM.General.Internal.FFI.RawOStream as FFI++import LLVM.General.Internal.Coding+import LLVM.General.Internal.String ()++withFileRawOStream :: +  (MonadAnyCont IO m, MonadIO m) +  => String+  -> Bool+  -> Bool+  -> (Ptr FFI.RawOStream -> ErrorT String IO ())+  -> m ()+withFileRawOStream path excl binary c = do+  path <- encodeM path+  excl <- encodeM excl+  binary <- encodeM binary+  outputRef <- liftIO $ newIORef Nothing+  msgPtr <- alloca+  errorRef <- liftIO $ newIORef undefined+  failed <- decodeM =<< (liftIO $ FFI.withFileRawOStream path excl binary msgPtr $ \os -> do+                           r <- runErrorT (c os)+                           writeIORef errorRef r)+  when failed $ fail =<< decodeM msgPtr+  e <- liftIO $ readIORef errorRef+  case e of+    Left e -> fail e+    _ -> do+      Just r <- liftIO $ readIORef outputRef+      return r++withBufferRawOStream :: +  (MonadIO m, DecodeM IO a (Ptr CChar, CSize))+  => (Ptr FFI.RawOStream -> ErrorT String IO ())+  -> m a+withBufferRawOStream c = do+  resultRef <- liftIO $ newIORef Nothing+  errorRef <- liftIO $ newIORef undefined+  let saveBuffer :: Ptr CChar -> CSize -> IO ()+      saveBuffer start size = do+        r <- decodeM (start, size)+        writeIORef resultRef (Just r)+      saveError os = do+        r <- runErrorT (c os)+        writeIORef errorRef r+  liftIO $ FFI.withBufferRawOStream saveBuffer saveError+  e <- liftIO $ readIORef errorRef+  case e of+    Left e -> fail e+    _ -> do+      Just r <- liftIO $ readIORef resultRef+      return r
src/LLVM/General/Internal/String.hs view
@@ -20,6 +20,7 @@ import LLVM.General.Internal.Coding  import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.UTF8 as BSUTF8  newtype UTF8ByteString = UTF8ByteString { utf8Bytes :: BS.ByteString }@@ -30,9 +31,8 @@ instance (Monad d) => DecodeM d String UTF8ByteString where   decodeM = return . BSUTF8.toString . utf8Bytes - instance (MonadAnyCont IO e) => EncodeM e String CString where-  encodeM s = anyContToM (BS.useAsCString . utf8Bytes =<< encodeM s)+  encodeM s = anyContToM (BS.unsafeUseAsCString . utf8Bytes =<< encodeM (s ++ "\0"))  instance (Integral i, MonadAnyCont IO e) => EncodeM e String (Ptr CChar, i) where   encodeM s = anyContToM ((. (. second fromIntegral)) $ BS.useAsCStringLen . utf8Bytes =<< encodeM s)@@ -40,14 +40,17 @@ instance (MonadIO d) => DecodeM d String CString where   decodeM = decodeM . UTF8ByteString <=< liftIO . BS.packCString -instance (MonadIO d) => DecodeM d String MallocedCString where-  decodeM (MallocedCString s) = liftIO $ finally (decodeM s) (free s)+instance (MonadIO d) => DecodeM d String (OwnerTransfered CString) where+  decodeM (OwnerTransfered s) = liftIO $ finally (decodeM s) (free s) -instance (MonadIO d) => DecodeM d String (Ptr MallocedCString) where+instance (MonadIO d) => DecodeM d String (Ptr (OwnerTransfered CString)) where   decodeM = liftIO . decodeM <=< peek  instance (Integral i, MonadIO d) => DecodeM d String (Ptr CChar, i) where   decodeM = decodeM . UTF8ByteString <=< liftIO . BS.packCStringLen . second fromIntegral++instance (Integral i, MonadIO d) => DecodeM d BS.ByteString (Ptr CChar, i) where+  decodeM = liftIO . BS.packCStringLen . second fromIntegral  instance (Integral i, Storable i, MonadIO d) => DecodeM d String (Ptr i -> IO (Ptr CChar)) where   decodeM f = decodeM =<< (liftIO $ F.M.alloca $ \p -> (,) `liftM` f p `ap` peek p)
src/LLVM/General/Internal/Target.hs view
@@ -293,4 +293,3 @@ withTargetLibraryInfo triple f = flip runAnyContT return $ do   triple <- encodeM triple   liftIO $ bracket (FFI.createTargetLibraryInfo triple) FFI.disposeTargetLibraryInfo (f . TargetLibraryInfo)-
src/LLVM/General/Module.hs view
@@ -2,16 +2,22 @@ -- added to an 'LLVM.General.ExecutionEngine.ExecutionEngine' and so JIT compiled to get function pointers. module LLVM.General.Module (     Module,+     withModuleFromAST,     moduleAST,-    withModuleFromString,-    moduleString, -    moduleAssembly,-    moduleObject,+    withModuleFromLLVMAssembly,+    moduleLLVMAssembly,+    writeLLVMAssemblyToFile, +    withModuleFromBitcode,+    moduleBitcode,     writeBitcodeToFile,-    writeAssemblyToFile,++    moduleTargetAssembly,+    writeTargetAssemblyToFile,++    moduleObject,     writeObjectToFile,      linkModules
test/LLVM/General/Test/Instructions.hs view
@@ -590,7 +590,7 @@                \  %1 = load i32* @0, align 1\n\                \  ret i32 %1\n\                \}\n"-    s <- withContext $ \context -> withModuleFromAST' context mAST moduleString+    s <- withContext $ \context -> withModuleFromAST' context mAST moduleLLVMAssembly     s @?= mStr,        testGroup "terminators" [
test/LLVM/General/Test/Module.hs view
@@ -211,7 +211,7 @@ tests = testGroup "Module" [   testGroup "withModuleFromString" [     testCase "basic" $ withContext $ \context -> do-      z <- withModuleFromString' context handString (const $ return 0)+      z <- withModuleFromLLVMAssembly' context handString (const $ return 0)       z @?= 0,     testCase "numbering" $ withContext $ \context -> do       let s = "@0 = global i32 3\@@ -220,7 +220,7 @@               \  %2 = add i32 %1, 3\n\               \  ret i32 %2\n\               \}\n"-      z <- withModuleFromString' context s (const $ return 0)+      z <- withModuleFromLLVMAssembly' context s (const $ return 0)       z @?= 0    ], @@ -229,11 +229,11 @@       let s = "define i32 @main(i32 %argc, i8** %argv) {\n\               \  ret i32 0\n\               \}\n"-      a <- withModuleFromString' context s $ \m -> do+      a <- withModuleFromLLVMAssembly' context s $ \m -> do         (t, _) <- failInIO $ lookupTarget Nothing "x86_64-unknown-linux"         withTargetOptions $ \to -> do           withTargetMachine t "" "" Set.empty to R.Default CM.Default CGO.Default $ \tm -> do-            failInIO $ moduleAssembly tm m+            failInIO $ moduleTargetAssembly tm m       a @?= "\t.file\t\"<string>\"\n\             \\t.text\n\             \\t.globl\tmain\n\@@ -252,21 +252,26 @@    ],    testCase "handStringIsCanonical" $ withContext $ \context -> do-    s <- withModuleFromString' context handString moduleString+    s <- withModuleFromLLVMAssembly' context handString moduleLLVMAssembly     s @?= handString,    testCase "moduleAST" $ withContext $ \context -> do-    ast <- withModuleFromString' context handString moduleAST+    ast <- withModuleFromLLVMAssembly' context handString moduleAST     ast @?= handAST,        testCase "withModuleFromAST" $ withContext $ \context -> do-   s <- withModuleFromAST' context handAST moduleString-   s @?= handString,+    s <- withModuleFromAST' context handAST moduleLLVMAssembly+    s @?= handString, +  testCase "bitcode" $ withContext $ \context -> do+    bs <- withModuleFromAST' context handAST moduleBitcode+    s <- withModuleFromBitcode' context bs moduleLLVMAssembly+    s @?= handString,+   testCase "triple" $ withContext $ \context -> do    let hAST = "; ModuleID = '<string>'\n\               \target triple = \"x86_64-unknown-linux\"\n"-   ast <- withModuleFromString' context hAST moduleAST+   ast <- withModuleFromLLVMAssembly' context hAST moduleAST    ast @?= defaultModule { moduleTargetTriple = Just "x86_64-unknown-linux" },    testGroup "regression" [@@ -376,8 +381,8 @@                   ]                 }                ]-          s <- withModuleFromAST' context ast moduleString-          m <- withModuleFromString' context s moduleAST+          s <- withModuleFromAST' context ast moduleLLVMAssembly+          m <- withModuleFromLLVMAssembly' context s moduleAST           m @?= ast    ],
test/LLVM/General/Test/Support.hs view
@@ -25,8 +25,9 @@ instance FailInIO (Either String Diagnostic) where   errorToString = either id diagnosticDisplay -withModuleFromString' c s f  = failInIO $ withModuleFromString c s f+withModuleFromLLVMAssembly' c s f  = failInIO $ withModuleFromLLVMAssembly c s f withModuleFromAST' c a f = failInIO $ withModuleFromAST c a f+withModuleFromBitcode' c a f = failInIO $ withModuleFromBitcode c ("<string>", a) f  assertEqPretty :: (Eq a, PrettyShow a) => a -> a -> Assertion assertEqPretty actual expected = do@@ -36,8 +37,8 @@    (expected == actual)  strCheckC mAST mStr mStrCanon = withContext $ \context -> do-  a <- withModuleFromString' context mStr moduleAST-  s <- withModuleFromAST' context mAST moduleString+  a <- withModuleFromLLVMAssembly' context mStr moduleAST+  s <- withModuleFromAST' context mAST moduleLLVMAssembly   (a,s) `assertEqPretty` (mAST, mStrCanon)  strCheck mAST mStr = strCheckC mAST mStr mStr