llvm-hs 4.1.0.0 → 4.2.0

raw patch · 19 files changed

+862/−391 lines, 19 filesdep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• llvm-hs.cabal +5/−3
• src/LLVM/Internal/FFI/OrcJIT.hs +9/−3
• src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs +37/−0
• src/LLVM/Internal/FFI/OrcJIT/CompileOnDemandLayer.hs +5/−30
• src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs +5/−24
• src/LLVM/Internal/FFI/OrcJIT/IRTransformLayer.hs +21/−0
• src/LLVM/Internal/FFI/OrcJITC.cpp +296/−124
• src/LLVM/Internal/OrcJIT.hs +46/−9
• src/LLVM/Internal/OrcJIT/CompileLayer.hs +107/−0
• src/LLVM/Internal/OrcJIT/CompileOnDemandLayer.hs +115/−88
• src/LLVM/Internal/OrcJIT/IRCompileLayer.hs +27/−50
• src/LLVM/Internal/OrcJIT/IRTransformLayer.hs +69/−0
• src/LLVM/Internal/Target.hs +2/−2
• src/LLVM/OrcJIT.hs +48/−3
• src/LLVM/OrcJIT/CompileOnDemandLayer.hs +0/−14
• src/LLVM/OrcJIT/IRCompileLayer.hs +0/−10
• test/LLVM/Test/OrcJIT.hs +49/−27
• test/LLVM/Test/Target.hs +9/−4

@@ -1,3 +1,15 @@+## 4.2.0 (2017-06-20)++* Revamp OrcJIT API+  * The user facing API is now exposed using `LLVM.OrcJIT`.+  * All user facing functions have been documented.+  * In addition the bracket-style API, there are now `new*` and+    `dispose*` functions making it easier to ingegrate OrcJIT in+    custom monad transformer stacks.+  * There is a new `CompileLayer` typeclass which abstracts over the+    various compile layers in `OrcJIT`.+* Support QuickCheck 2.10+ ## 4.1.0 (2017-05-17)  * Switch most of the API from `String` to `ByteString`.

@@ -1,5 +1,5 @@ name: llvm-hs-version: 4.1.0.0+version: 4.2.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer <moritz.kiefer@purelyfunctional.org>, Benjamin S. Scarlet@@ -130,8 +130,10 @@     LLVM.Internal.Metadata     LLVM.Internal.Module     LLVM.Internal.OrcJIT+    LLVM.Internal.OrcJIT.CompileLayer     LLVM.Internal.OrcJIT.CompileOnDemandLayer     LLVM.Internal.OrcJIT.IRCompileLayer+    LLVM.Internal.OrcJIT.IRTransformLayer     LLVM.Internal.Operand     LLVM.Internal.PassManager     LLVM.Internal.RawOStream@@ -169,8 +171,10 @@     LLVM.Internal.FFI.Metadata     LLVM.Internal.FFI.Module     LLVM.Internal.FFI.OrcJIT+    LLVM.Internal.FFI.OrcJIT.CompileLayer     LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer     LLVM.Internal.FFI.OrcJIT.IRCompileLayer+    LLVM.Internal.FFI.OrcJIT.IRTransformLayer     LLVM.Internal.FFI.PassManager     LLVM.Internal.FFI.PtrHierarchy     LLVM.Internal.FFI.RawOStream@@ -184,8 +188,6 @@     LLVM.Internal.FFI.Value     LLVM.Module     LLVM.OrcJIT-    LLVM.OrcJIT.CompileOnDemandLayer-    LLVM.OrcJIT.IRCompileLayer     LLVM.PassManager     LLVM.Relocation     LLVM.Target

@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MultiParamTypeClasses, ForeignFunctionInterface #-}  module LLVM.Internal.FFI.OrcJIT where @@ -9,11 +9,17 @@  import LLVM.Internal.FFI.DataLayout import LLVM.Internal.FFI.LLVMCTypes+import LLVM.Internal.FFI.PtrHierarchy  data JITSymbol data LambdaResolver++data LinkingLayer+ data ObjectLinkingLayer +instance ChildOf LinkingLayer ObjectLinkingLayer+ newtype TargetAddress = TargetAddress Word64  type SymbolResolverFn = CString -> Ptr JITSymbol -> IO ()@@ -32,8 +38,8 @@ foreign import ccall safe "LLVM_Hs_createObjectLinkingLayer" createObjectLinkingLayer ::   IO (Ptr ObjectLinkingLayer) -foreign import ccall safe "LLVM_Hs_disposeObjectLinkingLayer" disposeObjectLinkingLayer ::-  Ptr ObjectLinkingLayer -> IO ()+foreign import ccall safe "LLVM_Hs_LinkingLayer_dispose" disposeLinkingLayer ::+  Ptr LinkingLayer -> IO ()  foreign import ccall safe "LLVM_Hs_JITSymbol_getAddress" getAddress ::   Ptr JITSymbol -> IO TargetAddress

@@ -0,0 +1,37 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Internal.FFI.OrcJIT.CompileLayer where++import LLVM.Prelude++import LLVM.Internal.FFI.DataLayout+import LLVM.Internal.FFI.LLVMCTypes+import LLVM.Internal.FFI.Module+import LLVM.Internal.FFI.OrcJIT++import Foreign.C+import Foreign.Ptr++data CompileLayer++-- | Abstract type representing a set of modules in a 'LLVM.OrcJIT.CompileLayer'.+newtype ModuleSetHandle = ModuleSetHandle Word++foreign import ccall safe "LLVM_Hs_CompileLayer_dispose" disposeCompileLayer ::+  Ptr CompileLayer -> IO ()++foreign import ccall safe "LLVM_Hs_CompileLayer_addModuleSet" addModuleSet ::+  Ptr CompileLayer ->+  Ptr DataLayout ->+  Ptr (Ptr Module) ->+  CUInt ->+  Ptr LambdaResolver ->+  IO ModuleSetHandle++foreign import ccall safe "LLVM_Hs_CompileLayer_removeModuleSet" removeModuleSet ::+  Ptr CompileLayer -> ModuleSetHandle -> IO ()++foreign import ccall safe "LLVM_Hs_CompileLayer_findSymbol" findSymbol ::+  Ptr CompileLayer -> CString -> LLVMBool -> IO (Ptr JITSymbol)++foreign import ccall safe "LLVM_Hs_CompileLayer_findSymbolIn" findSymbolIn ::+  Ptr CompileLayer -> ModuleSetHandle -> CString -> LLVMBool -> IO (Ptr JITSymbol)

@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-} module LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer where  import LLVM.Prelude@@ -6,18 +6,16 @@ import Foreign.C import Foreign.Ptr -import LLVM.Internal.FFI.DataLayout import LLVM.Internal.FFI.LLVMCTypes-import LLVM.Internal.FFI.Module import LLVM.Internal.FFI.OrcJIT-import LLVM.Internal.FFI.OrcJIT.IRCompileLayer (IRCompileLayer)+import LLVM.Internal.FFI.OrcJIT.CompileLayer import LLVM.Internal.FFI.PtrHierarchy  data IndirectStubsManagerBuilder data JITCompileCallbackManager-data CompileOnDemandLayer data Set a-data ModuleSetHandle+data CompileOnDemandLayer+instance ChildOf CompileLayer CompileOnDemandLayer  type PartitioningFn = Ptr Function -> Ptr (Set (Ptr Function)) -> IO () @@ -43,32 +41,9 @@   Ptr (Set (Ptr Function)) -> Ptr Function -> IO ()  foreign import ccall safe "LLVM_Hs_createCompileOnDemandLayer" createCompileOnDemandLayer ::-  Ptr IRCompileLayer ->+  Ptr CompileLayer ->   FunPtr PartitioningFn ->   Ptr JITCompileCallbackManager ->   Ptr IndirectStubsManagerBuilder ->   LLVMBool ->   IO (Ptr CompileOnDemandLayer)--foreign import ccall safe "LLVM_Hs_disposeCompileOnDemandLayer" disposeCompileOnDemandLayer ::-  Ptr CompileOnDemandLayer ->-  IO ()--foreign import ccall safe "LLVM_Hs_CompileOnDemandLayer_addModuleSet" addModuleSet ::-  Ptr CompileOnDemandLayer ->-  Ptr DataLayout ->-  Ptr (Ptr Module) ->-  CUInt ->-  Ptr LambdaResolver ->-  IO (Ptr ModuleSetHandle)--foreign import ccall safe "LLVM_Hs_CompileOnDemandLayer_removeModuleSet" removeModuleSet ::-  Ptr CompileOnDemandLayer ->-  Ptr ModuleSetHandle ->-  IO ()--foreign import ccall safe "LLVM_Hs_CompileOnDemandLayer_findSymbol" findSymbol ::-  Ptr CompileOnDemandLayer ->-  CString ->-  LLVMBool ->-  IO (Ptr JITSymbol)

@@ -1,36 +1,17 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-} module LLVM.Internal.FFI.OrcJIT.IRCompileLayer where  import LLVM.Prelude -import LLVM.Internal.FFI.DataLayout-import LLVM.Internal.FFI.LLVMCTypes-import LLVM.Internal.FFI.Module import LLVM.Internal.FFI.OrcJIT+import LLVM.Internal.FFI.OrcJIT.CompileLayer+import LLVM.Internal.FFI.PtrHierarchy import LLVM.Internal.FFI.Target  import Foreign.Ptr-import Foreign.C  data IRCompileLayer-data ModuleSetHandle+instance ChildOf CompileLayer IRCompileLayer  foreign import ccall safe "LLVM_Hs_createIRCompileLayer" createIRCompileLayer ::-  Ptr ObjectLinkingLayer -> Ptr TargetMachine -> IO (Ptr IRCompileLayer)--foreign import ccall safe "LLVM_Hs_disposeIRCompileLayer" disposeIRCompileLayer ::-  Ptr IRCompileLayer -> IO ()--foreign import ccall safe "LLVM_Hs_IRCompileLayer_addModuleSet" addModuleSet ::-  Ptr IRCompileLayer ->-  Ptr DataLayout ->-  Ptr (Ptr Module) ->-  CUInt ->-  Ptr LambdaResolver ->-  IO (Ptr ModuleSetHandle)--foreign import ccall safe "LLVM_Hs_IRCompileLayer_removeModuleSet" removeModuleSet ::-  Ptr IRCompileLayer -> Ptr ModuleSetHandle -> IO ()--foreign import ccall safe "LLVM_Hs_IRCompileLayer_findSymbol" findSymbol ::-  Ptr IRCompileLayer -> CString -> LLVMBool -> IO (Ptr JITSymbol)+  Ptr LinkingLayer -> Ptr TargetMachine -> IO (Ptr IRCompileLayer)

@@ -0,0 +1,21 @@+{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-}+module LLVM.Internal.FFI.OrcJIT.IRTransformLayer where++import LLVM.Prelude++import LLVM.Internal.FFI.OrcJIT.CompileLayer+import LLVM.Internal.FFI.PtrHierarchy+import LLVM.Internal.FFI.Module++import Foreign.Ptr++data IRTransformLayer+instance ChildOf CompileLayer IRTransformLayer++type ModuleTransform = Ptr Module -> IO (Ptr Module)++foreign import ccall "wrapper" wrapModuleTransform ::+  ModuleTransform -> IO (FunPtr ModuleTransform)++foreign import ccall safe "LLVM_Hs_createIRTransformLayer" createIRTransformLayer ::+  Ptr CompileLayer -> FunPtr ModuleTransform -> IO (Ptr IRTransformLayer)

@@ -1,35 +1,216 @@ #include "LLVM/Internal/FFI/OrcJIT.h" #include "LLVM/Internal/FFI/Target.hpp"+#include "llvm/ExecutionEngine/JITSymbol.h" #include "llvm/ExecutionEngine/Orc/CompileOnDemandLayer.h" #include "llvm/ExecutionEngine/Orc/CompileUtils.h" #include "llvm/ExecutionEngine/Orc/IRCompileLayer.h"+#include "llvm/ExecutionEngine/Orc/IRTransformLayer.h" #include "llvm/ExecutionEngine/Orc/IndirectionUtils.h"-#include "llvm/ExecutionEngine/JITSymbol.h" #include "llvm/ExecutionEngine/Orc/LambdaResolver.h" #include "llvm/ExecutionEngine/Orc/ObjectLinkingLayer.h" #include "llvm/IR/Mangler.h"  #include <type_traits>+#include <unordered_map>  using namespace llvm; using namespace orc; -typedef llvm::orc::ObjectLinkingLayer<> *LLVMObjectLinkingLayerRef;-typedef llvm::orc::IRCompileLayer<llvm::orc::ObjectLinkingLayer<>>-    LLVMIRCompileLayer;-typedef LLVMIRCompileLayer *LLVMIRCompileLayerRef;-typedef llvm::orc::CompileOnDemandLayer<LLVMIRCompileLayer>-    LLVMCompileOnDemandLayer;-typedef LLVMCompileOnDemandLayer *LLVMCompileOnDemandLayerRef;-typedef llvm::orc::JITCompileCallbackManager *LLVMJITCompileCallbackManagerRef;-typedef llvm::JITSymbol *LLVMJITSymbolRef;-typedef LLVMIRCompileLayer::ModuleSetHandleT *LLVMModuleSetHandleRef;-typedef LLVMCompileOnDemandLayer::ModuleSetHandleT *LLVMCODModuleSetHandleRef;+typedef unsigned LLVMModuleSetHandle;+typedef unsigned LLVMObjSetHandle; typedef llvm::orc::LambdaResolver<     std::function<JITSymbol(const std::string &name)>,     std::function<JITSymbol(const std::string &name)>>     LLVMLambdaResolver; typedef LLVMLambdaResolver *LLVMLambdaResolverRef;++// We want to allow users to choose themselves which layers they want to use.+// However, the LLVM API requires that this is selected statically via template+// arguments. We convert this static polymorphism to runtime polymorphism by+// creating an LinkingLayer and a CompileLayer class which use virtual dispatch+// to select the concrete layer.++template <typename T> class HandleSet {+  public:+    unsigned insert(T t) {+        unsigned handle = handles.insert({nextFree, t}).first->first;+        ++nextFree;+        return handle;+    }+    T &lookup(unsigned i) { return handles.at(i); }++    void remove(unsigned i) { handles.erase(i); }++  private:+    std::unordered_map<unsigned, T> handles;+    unsigned nextFree = 0;+};++class LinkingLayer {+  public:+    virtual ~LinkingLayer(){};+    typedef unsigned ObjSetHandleT;+    virtual ObjSetHandleT+    addObjectSet(std::vector<std::unique_ptr<object::ObjectFile>> objects,+                 SectionMemoryManager *memMgr, JITSymbolResolver *resolver) = 0;+    virtual ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        SectionMemoryManager *memMgr, JITSymbolResolver *resolver) = 0;+    virtual ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        std::unique_ptr<SectionMemoryManager> memMgr,+        JITSymbolResolver *resolver) = 0;+    virtual ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        std::unique_ptr<SectionMemoryManager> memMgr,+        std::unique_ptr<JITSymbolResolver> resolver) = 0;+    virtual ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        SectionMemoryManager *memMgr,+        std::unique_ptr<JITSymbolResolver> resolver) = 0;+    virtual void removeObjectSet(ObjSetHandleT H) = 0;+    virtual JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) = 0;+    virtual JITSymbol findSymbolIn(ObjSetHandleT h, StringRef name,+                                   bool exportedSymbolsOnly) = 0;+    virtual void emitAndFinalize(ObjSetHandleT h) = 0;+};++template <typename T> class LinkingLayerT : public LinkingLayer {+  public:+    LinkingLayerT(T data_) : data(std::move(data_)) {}+    ObjSetHandleT+    addObjectSet(std::vector<std::unique_ptr<object::ObjectFile>> objects,+                 SectionMemoryManager *memMgr,+                 JITSymbolResolver *resolver) override {+        auto handle = data.addObjectSet(std::move(objects), std::move(memMgr),+                                        std::move(resolver));+        return handles.insert(handle);+    }+    ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        SectionMemoryManager *memMgr, JITSymbolResolver *resolver) override {+        auto handle = data.addObjectSet(std::move(objects), std::move(memMgr),+                                        std::move(resolver));+        return handles.insert(handle);+    }+    ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        std::unique_ptr<SectionMemoryManager> memMgr,+        JITSymbolResolver *resolver) override {+        auto handle = data.addObjectSet(std::move(objects), std::move(memMgr),+                                        std::move(resolver));+        return handles.insert(handle);+    }+    ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        std::unique_ptr<SectionMemoryManager> memMgr,+        std::unique_ptr<JITSymbolResolver> resolver) override {+        auto handle = data.addObjectSet(std::move(objects), std::move(memMgr),+                                        std::move(resolver));+        return handles.insert(handle);+    }+    ObjSetHandleT addObjectSet(+        std::vector<std::unique_ptr<object::OwningBinary<object::ObjectFile>>>+            objects,+        SectionMemoryManager *memMgr,+        std::unique_ptr<JITSymbolResolver> resolver) override {+        auto handle = data.addObjectSet(std::move(objects), std::move(memMgr),+                                        std::move(resolver));+        return handles.insert(handle);+    }+    void removeObjectSet(ObjSetHandleT h) override {+        data.removeObjectSet(handles.lookup(h));+        handles.remove(h);+    }+    JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) override {+        return data.findSymbol(name, exportedSymbolsOnly);+    }+    JITSymbol findSymbolIn(ObjSetHandleT h, StringRef name,+                           bool exportedSymbolsOnly) override {+        return data.findSymbolIn(handles.lookup(h), name, exportedSymbolsOnly);+    }+    void emitAndFinalize(ObjSetHandleT h) override {+        data.emitAndFinalize(handles.lookup(h));+    }++  private:+    T data;+    HandleSet<typename T::ObjSetHandleT> handles;+};++class CompileLayer {+  public:+    typedef LLVMModuleSetHandle ModuleSetHandleT;+    virtual ~CompileLayer(){};+    virtual JITSymbol findSymbol(StringRef Name, bool ExportedSymbolsOnly) = 0;+    virtual JITSymbol findSymbolIn(ModuleSetHandleT H, StringRef Name,+                                   bool ExportedSymbolsOnly) = 0;+    virtual ModuleSetHandleT+    addModuleSet(std::vector<std::unique_ptr<Module>> Modules,+                 std::unique_ptr<SectionMemoryManager> MemMgr,+                 std::unique_ptr<JITSymbolResolver> Resolver) = 0;+    virtual ModuleSetHandleT+    addModuleSet(std::vector<std::unique_ptr<Module>> Modules,+                 SectionMemoryManager *MemMgr,+                 std::unique_ptr<JITSymbolResolver> Resolver) = 0;+    virtual void removeModuleSet(ModuleSetHandleT H) = 0;+};++template <typename T> class CompileLayerT : public CompileLayer {+  public:+    CompileLayerT(T data_) : data(std::move(data_)) {}+    JITSymbol findSymbol(StringRef Name, bool ExportedSymbolsOnly) override {+        return data.findSymbol(Name, ExportedSymbolsOnly);+    }+    JITSymbol findSymbolIn(ModuleSetHandleT H, StringRef Name,+                           bool ExportedSymbolsOnly) override {+        return data.findSymbolIn(handles.lookup(H), Name, ExportedSymbolsOnly);+    }+    ModuleSetHandleT+    addModuleSet(std::vector<std::unique_ptr<Module>> Modules,+                 std::unique_ptr<SectionMemoryManager> MemMgr,+                 std::unique_ptr<JITSymbolResolver> Resolver) override {+        auto handle = data.addModuleSet(std::move(Modules), std::move(MemMgr),+                                        std::move(Resolver));+        return handles.insert(handle);+    }+    ModuleSetHandleT+    addModuleSet(std::vector<std::unique_ptr<Module>> Modules,+                 SectionMemoryManager *MemMgr,+                 std::unique_ptr<JITSymbolResolver> Resolver) override {+        auto handle = data.addModuleSet(std::move(Modules), std::move(MemMgr),+                                        std::move(Resolver));+        return handles.insert(handle);+    }+    void removeModuleSet(ModuleSetHandleT H) override {+        data.removeModuleSet(handles.lookup(H));+        handles.remove(H);+    }++  private:+    T data;+    HandleSet<typename T::ModuleSetHandleT> handles;+};++typedef llvm::orc::CompileOnDemandLayer<CompileLayer> LLVMCompileOnDemandLayer;+typedef LLVMCompileOnDemandLayer *LLVMCompileOnDemandLayerRef;++typedef llvm::orc::IRTransformLayer<+    CompileLayer,+    std::function<std::unique_ptr<Module>(std::unique_ptr<Module>)>>+    LLVMIRTransformLayer;++typedef llvm::orc::JITCompileCallbackManager *LLVMJITCompileCallbackManagerRef;++typedef llvm::JITSymbol *LLVMJITSymbolRef;+ typedef llvm::orc::IndirectStubsManager *LLVMIndirectStubsManagerRef; typedef std::function<std::unique_ptr<llvm::orc::IndirectStubsManager>()>     *LLVMIndirectStubsManagerBuilderRef;@@ -44,12 +225,12 @@     return mangledName; } -static std::vector<Module *> getModules(LLVMModuleRef *modules,-                                        unsigned moduleCount,-                                        LLVMTargetDataRef dataLayout) {-    std::vector<Module *> moduleVec(moduleCount);+static std::vector<std::unique_ptr<Module>>+getModules(LLVMModuleRef *modules, unsigned moduleCount,+           LLVMTargetDataRef dataLayout) {+    std::vector<std::unique_ptr<Module>> moduleVec(moduleCount);     for (unsigned i = 0; i < moduleCount; ++i) {-        moduleVec.at(i) = unwrap(modules[i]);+        moduleVec.at(i) = std::unique_ptr<Module>(unwrap(modules[i]));         if (moduleVec.at(i)->getDataLayout().isDefault()) {             moduleVec.at(i)->setDataLayout(*unwrap(dataLayout));         }@@ -58,41 +239,107 @@ }  extern "C" {-LLVMIRCompileLayerRef-LLVM_Hs_createIRCompileLayer(LLVMObjectLinkingLayerRef objectLayer,-                                  LLVMTargetMachineRef tm) {++/* Constructor functions for the different compile layers */++CompileLayer *LLVM_Hs_createIRCompileLayer(LinkingLayer *linkingLayer,+                                           LLVMTargetMachineRef tm) {     TargetMachine *tmm = unwrap(tm);-    return new IRCompileLayer<ObjectLinkingLayer<>>(*objectLayer,-                                                    SimpleCompiler(*tmm));+    return new CompileLayerT<IRCompileLayer<LinkingLayer>>(+        IRCompileLayer<LinkingLayer>(*linkingLayer, SimpleCompiler(*tmm))); } -void LLVM_Hs_disposeIRCompileLayer(LLVMIRCompileLayerRef compileLayer) {+CompileLayer *LLVM_Hs_createCompileOnDemandLayer(+    CompileLayer *compileLayer,+    void (*partitioningFtor)(llvm::Function *, std::set<llvm::Function *> *set),+    LLVMJITCompileCallbackManagerRef callbackManager,+    LLVMIndirectStubsManagerBuilderRef stubsManager,+    LLVMBool cloneStubsIntoPartitions) {+    return new CompileLayerT<LLVMCompileOnDemandLayer>(LLVMCompileOnDemandLayer(+        *compileLayer,+        [partitioningFtor](llvm::Function &f) -> std::set<llvm::Function *> {+            std::set<llvm::Function *> result;+            partitioningFtor(&f, &result);+            return result;+        },+        *callbackManager, *stubsManager, cloneStubsIntoPartitions));+}++CompileLayer *LLVM_Hs_createIRTransformLayer(CompileLayer *compileLayer,+                                             Module *(*transform)(Module *)) {+    std::function<std::unique_ptr<Module>(std::unique_ptr<Module>)> transform_ =+        [transform](std::unique_ptr<Module> module) {+            return std::unique_ptr<Module>(transform(module.release()));+        };+    return new CompileLayerT<LLVMIRTransformLayer>(+        LLVMIRTransformLayer(*compileLayer, transform_));+}++/* Functions that work on all compile layers */++void LLVM_Hs_CompileLayer_dispose(CompileLayer *compileLayer) {     delete compileLayer; } -LLVMJITSymbolRef-LLVM_Hs_IRCompileLayer_findSymbol(LLVMIRCompileLayerRef compileLayer,-                                       const char *name,-                                       LLVMBool exportedSymbolsOnly) {+LLVMJITSymbolRef LLVM_Hs_CompileLayer_findSymbol(CompileLayer *compileLayer,+                                                 const char *name,+                                                 LLVMBool exportedSymbolsOnly) {     JITSymbol symbol = compileLayer->findSymbol(name, exportedSymbolsOnly);     return new JITSymbol(symbol); } +LLVMJITSymbolRef+LLVM_Hs_CompileLayer_findSymbolIn(CompileLayer *compileLayer,+                                  LLVMModuleSetHandle handle, const char *name,+                                  LLVMBool exportedSymbolsOnly) {+    JITSymbol symbol =+        compileLayer->findSymbolIn(handle, name, exportedSymbolsOnly);+    return new JITSymbol(symbol);+}++LLVMModuleSetHandle+LLVM_Hs_CompileLayer_addModuleSet(CompileLayer *compileLayer,+                                  LLVMTargetDataRef dataLayout,+                                  LLVMModuleRef *modules, unsigned moduleCount,+                                  LLVMLambdaResolverRef resolver) {+    auto moduleVec = getModules(modules, moduleCount, dataLayout);+    std::unique_ptr<LLVMLambdaResolver> uniqueResolver(+        new LLVMLambdaResolver(*resolver));+    return compileLayer->addModuleSet(std::move(moduleVec),+                                      make_unique<SectionMemoryManager>(),+                                      std::move(uniqueResolver));+}++void LLVM_Hs_CompileLayer_removeModuleSet(CompileLayer *compileLayer,+                                          LLVMModuleSetHandle moduleSetHandle) {+    compileLayer->removeModuleSet(moduleSetHandle);+}++/* Constructor functions for the different object layers */++LinkingLayer *LLVM_Hs_createObjectLinkingLayer() {+    return new LinkingLayerT<ObjectLinkingLayer<>>(ObjectLinkingLayer<>());+}++/* Fuctions that work on all object layers */++void LLVM_Hs_LinkingLayer_dispose(LinkingLayer *linkingLayer) {+    delete linkingLayer;+}+ void LLVM_Hs_disposeJITSymbol(LLVMJITSymbolRef symbol) { delete symbol; }  LLVMLambdaResolverRef LLVM_Hs_createLambdaResolver(     void (*dylibResolver)(const char *, LLVMJITSymbolRef),     void (*externalResolver)(const char *, LLVMJITSymbolRef)) {-    std::function<JITSymbol(const std::string &name)>-        dylibResolverFun = [dylibResolver](-            const std::string &name) -> JITSymbol {+    std::function<JITSymbol(const std::string &name)> dylibResolverFun =+        [dylibResolver](const std::string &name) -> JITSymbol {         JITSymbol symbol(nullptr);         dylibResolver(name.c_str(), &symbol);         return symbol;     };-    std::function<JITSymbol(const std::string &name)>-        externalResolverFun = [externalResolver](-            const std::string &name) -> JITSymbol {+    std::function<JITSymbol(const std::string &name)> externalResolverFun =+        [externalResolver](const std::string &name) -> JITSymbol {         JITSymbol symbol(nullptr);         externalResolver(name.c_str(), &symbol);         return symbol;@@ -102,33 +349,6 @@     return lambdaResolver.release(); } -LLVMModuleSetHandleRef LLVM_Hs_IRCompileLayer_addModuleSet(-    LLVMIRCompileLayerRef compileLayer, LLVMTargetDataRef dataLayout,-    LLVMModuleRef *modules, unsigned moduleCount,-    LLVMLambdaResolverRef resolver) {-    std::vector<Module *> moduleVec =-        getModules(modules, moduleCount, dataLayout);-    return new IRCompileLayer<ObjectLinkingLayer<>>::ModuleSetHandleT(-        compileLayer->addModuleSet(-            moduleVec, make_unique<SectionMemoryManager>(), resolver));-}--void LLVM_Hs_IRCompileLayer_removeModuleSet(-    LLVMIRCompileLayerRef compileLayer,-    LLVMModuleSetHandleRef moduleSetHandle) {-    compileLayer->removeModuleSet(*moduleSetHandle);-    delete moduleSetHandle;-}--LLVMObjectLinkingLayerRef LLVM_Hs_createObjectLinkingLayer() {-    return new ObjectLinkingLayer<>();-}--void LLVM_Hs_disposeObjectLinkingLayer(-    LLVMObjectLinkingLayerRef objectLayer) {-    delete objectLayer;-}- static JITSymbolFlags unwrap(LLVMJITSymbolFlags f) {     JITSymbolFlags flags = JITSymbolFlags::None; #define ENUM_CASE(x)                                                           \@@ -149,8 +369,7 @@     return LLVMJITSymbolFlags(r); } -JITTargetAddress-LLVM_Hs_JITSymbol_getAddress(LLVMJITSymbolRef symbol) {+JITTargetAddress LLVM_Hs_JITSymbol_getAddress(LLVMJITSymbolRef symbol) {     return symbol->getAddress(); } @@ -158,14 +377,13 @@     return wrap(symbol->getFlags()); } -void LLVM_Hs_setJITSymbol(LLVMJITSymbolRef symbol,-                               JITTargetAddress addr,-                               LLVMJITSymbolFlags flags) {+void LLVM_Hs_setJITSymbol(LLVMJITSymbolRef symbol, JITTargetAddress addr,+                          LLVMJITSymbolFlags flags) {     *symbol = JITSymbol(addr, unwrap(flags)); }  void LLVM_Hs_getMangledSymbol(char **mangledSymbol, const char *symbol,-                                   LLVMTargetDataRef dataLayout) {+                              LLVMTargetDataRef dataLayout) {     std::string mangled = mangle(symbol, dataLayout);     *mangledSymbol = new char[mangled.size() + 1];     strcpy(*mangledSymbol, mangled.c_str());@@ -175,10 +393,13 @@     delete[] mangledSymbol; } -LLVMJITCompileCallbackManagerRef LLVM_Hs_createLocalCompileCallbackManager(-    const char *triple, JITTargetAddress errorHandler) {-    return llvm::orc::createLocalCompileCallbackManager(Triple(triple),-                                                        errorHandler)+LLVMJITCompileCallbackManagerRef+LLVM_Hs_createLocalCompileCallbackManager(const char *triple,+                                          JITTargetAddress errorHandler) {+    // We copy the string so that it can be freed on the Haskell side.+    std::string tripleStr(triple);+    return llvm::orc::createLocalCompileCallbackManager(+               Triple(std::move(tripleStr)), errorHandler)         .release(); } @@ -189,8 +410,11 @@  LLVMIndirectStubsManagerBuilderRef LLVM_Hs_createLocalIndirectStubsManagerBuilder(const char *triple) {+    // We copy the string so that it can be freed on the Haskell side.+    std::string tripleStr(triple);     return new std::function<std::unique_ptr<IndirectStubsManager>()>(-        llvm::orc::createLocalIndirectStubsManagerBuilder(Triple(triple)));+        llvm::orc::createLocalIndirectStubsManagerBuilder(+            Triple(std::move(tripleStr)))); }  void LLVM_Hs_disposeIndirectStubsManagerBuilder(@@ -198,59 +422,7 @@     delete stubsManager; } -void LLVM_Hs_insertFun(std::set<llvm::Function *> *set,-                            llvm::Function *f) {+void LLVM_Hs_insertFun(std::set<llvm::Function *> *set, llvm::Function *f) {     set->insert(f);-}--LLVMCompileOnDemandLayerRef LLVM_Hs_createCompileOnDemandLayer(-    LLVMIRCompileLayerRef compileLayer,-    void (*partitioningFtor)(llvm::Function *, std::set<llvm::Function *> *set),-    LLVMJITCompileCallbackManagerRef callbackManager,-    LLVMIndirectStubsManagerBuilderRef stubsManager,-    LLVMBool cloneStubsIntoPartitions) {-    return new LLVMCompileOnDemandLayer(-        *compileLayer,-        [partitioningFtor](llvm::Function &f) -> std::set<llvm::Function *> {-            std::set<llvm::Function *> result;-            partitioningFtor(&f, &result);-            return result;-        },-        *callbackManager, *stubsManager, cloneStubsIntoPartitions);-}--void LLVM_Hs_disposeCompileOnDemandLayer(-    LLVMCompileOnDemandLayerRef codLayer) {-    delete codLayer;-}--LLVMCODModuleSetHandleRef LLVM_Hs_CompileOnDemandLayer_addModuleSet(-    LLVMCompileOnDemandLayerRef compileLayer, LLVMTargetDataRef dataLayout,-    LLVMModuleRef *modules, unsigned moduleCount,-    LLVMLambdaResolverRef resolver) {-    std::vector<Module *> moduleVec =-        getModules(modules, moduleCount, dataLayout);-    // We need to copy the resolver to make the use of unique_ptr (required by-    // the LLVM API) safe-    std::unique_ptr<LLVMLambdaResolver> uniqueResolver(-        new LLVMLambdaResolver(*resolver));-    return new LLVMCompileOnDemandLayer::ModuleSetHandleT(-        compileLayer->addModuleSet(moduleVec,-                                   make_unique<SectionMemoryManager>(),-                                   std::move(uniqueResolver)));-}--void LLVM_Hs_CompileOnDemandLayer_removeModuleSet(-    LLVMCompileOnDemandLayerRef compileLayer,-    LLVMCODModuleSetHandleRef moduleSetHandle) {-    compileLayer->removeModuleSet(*moduleSetHandle);-    delete moduleSetHandle;-}--LLVMJITSymbolRef LLVM_Hs_CompileOnDemandLayer_findSymbol(-    LLVMCompileOnDemandLayerRef compileLayer, const char *name,-    LLVMBool exportedSymbolsOnly) {-    JITSymbol symbol = compileLayer->findSymbol(name, exportedSymbolsOnly);-    return new JITSymbol(symbol); } }

@@ -13,9 +13,15 @@ import Foreign.Ptr  import LLVM.Internal.Coding+import LLVM.Internal.Target+import qualified LLVM.Internal.FFI.DataLayout as FFI import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import qualified LLVM.Internal.FFI.OrcJIT as FFI+import qualified LLVM.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.Internal.FFI.Target as FFI +-- | A mangled symbol which can be used in 'findSymbol'. This can be+-- created using 'mangleSymbol'. newtype MangledSymbol = MangledSymbol ByteString   deriving (Show, Eq, Ord) @@ -27,28 +33,45 @@  data JITSymbolFlags =   JITSymbolFlags {-    jitSymbolWeak :: !Bool,-    jitSymbolExported :: !Bool+    jitSymbolWeak :: !Bool, -- ^ Is this a weak symbol?+    jitSymbolExported :: !Bool -- ^ Is this symbol exported?   }   deriving (Show, Eq, Ord)  data JITSymbol =   JITSymbol {-    jitSymbolAddress :: !WordPtr,-    jitSymbolFlags :: !JITSymbolFlags+    jitSymbolAddress :: !WordPtr, -- ^ The address of the symbol. If+                                  -- you’ve looked up a function, you+                                  -- need to cast this to a 'FunPtr'.+    jitSymbolFlags :: !JITSymbolFlags -- ^ The flags of this symbol.   }   deriving (Show, Eq, Ord)  type SymbolResolverFn = MangledSymbol -> IO JITSymbol +-- | Specifies how external symbols in a module added to a+-- 'CompielLayer' should be resolved. data SymbolResolver =   SymbolResolver {+    -- | This is used to find symbols in the same logical dynamic+    -- library as the module referencing them.     dylibResolver :: !SymbolResolverFn,+    -- | When 'dylibResolver' fails to resolve a symbol,+    -- 'externalResolver' is used as a fallback to find external symbols.     externalResolver :: !SymbolResolverFn   } +-- | After a 'CompileLayer' has compiled the modules to object code,+-- it passes the resulting object files to a 'LinkingLayer'.+class LinkingLayer l where+  getLinkingLayer :: l -> Ptr FFI.LinkingLayer++-- | Bare bones implementation of a 'LinkingLayer'. newtype ObjectLinkingLayer = ObjectLinkingLayer (Ptr FFI.ObjectLinkingLayer) +instance LinkingLayer ObjectLinkingLayer where+  getLinkingLayer (ObjectLinkingLayer ptr) = FFI.upCast ptr+ instance Monad m => EncodeM m JITSymbolFlags FFI.JITSymbolFlags where   encodeM f = return $ foldr1 (.|.) [       if a f@@ -99,9 +122,23 @@   modifyIORef cleanups (freeHaskellFunPtr funPtr :)   pure funPtr +-- | Dispose of a 'LinkingLayer'.+disposeLinkingLayer :: LinkingLayer l => l -> IO ()+disposeLinkingLayer = FFI.disposeLinkingLayer . getLinkingLayer++-- | Create a new 'ObjectLinkingLayer'. This should be disposed using+-- 'disposeLinkingLayer' when it is no longer needed.+newObjectLinkingLayer :: IO ObjectLinkingLayer+newObjectLinkingLayer = ObjectLinkingLayer <$> FFI.createObjectLinkingLayer++-- | 'bracket'-style wrapper around 'newObjectLinkingLayer' and 'disposeLinkingLayer'. withObjectLinkingLayer :: (ObjectLinkingLayer -> IO a) -> IO a-withObjectLinkingLayer f =-  bracket-    FFI.createObjectLinkingLayer-    FFI.disposeObjectLinkingLayer $ \objectLayer ->-      f (ObjectLinkingLayer objectLayer)+withObjectLinkingLayer = bracket newObjectLinkingLayer disposeLinkingLayer++createRegisteredDataLayout :: (MonadAnyCont IO m) => TargetMachine -> IORef [IO ()] -> m (Ptr FFI.DataLayout)+createRegisteredDataLayout (TargetMachine tm) cleanups =+  let createDataLayout = do+        dl <- FFI.createTargetDataLayout tm+        modifyIORef' cleanups (FFI.disposeDataLayout dl :)+        pure dl+  in anyContToM $ bracketOnError createDataLayout FFI.disposeDataLayout

@@ -0,0 +1,107 @@+module LLVM.Internal.OrcJIT.CompileLayer+  ( module LLVM.Internal.OrcJIT.CompileLayer+  , FFI.ModuleSetHandle+  ) where++import LLVM.Prelude++import Control.Exception+import Control.Monad.AnyCont+import Control.Monad.IO.Class+import Data.IORef+import Foreign.Marshal.Array (withArrayLen)+import Foreign.Ptr++import LLVM.Internal.Coding+import qualified LLVM.Internal.FFI.DataLayout as FFI+import qualified LLVM.Internal.FFI.OrcJIT as FFI+import qualified LLVM.Internal.FFI.OrcJIT.CompileLayer as FFI+import LLVM.Internal.Module hiding (getDataLayout)+import LLVM.Internal.OrcJIT++-- | There are two main types of operations provided by instances of 'CompileLayer'.+--+-- 1. You can add \/ remove modules using 'addModuleSet' \/ 'removeModuleSet'.+--+-- 2. You can search for symbols using 'findSymbol' \/ 'findSymbolIn' in+-- the previously added modules.+class CompileLayer l where+  getCompileLayer :: l -> Ptr FFI.CompileLayer+  getDataLayout :: l -> Ptr FFI.DataLayout+  getCleanups :: l -> IORef [IO ()]++-- | Mangle a symbol according to the data layout stored in the+-- 'CompileLayer'.+mangleSymbol :: CompileLayer l => l -> ShortByteString -> IO MangledSymbol+mangleSymbol compileLayer symbol = flip runAnyContT return $ do+  mangledSymbol <- alloca+  symbol' <- encodeM symbol+  anyContToM $ bracket+    (FFI.getMangledSymbol mangledSymbol symbol' (getDataLayout compileLayer))+    (\_ -> FFI.disposeMangledSymbol =<< peek mangledSymbol)+  decodeM =<< peek mangledSymbol++-- | @'findSymbol' layer symbol exportedSymbolsOnly@ searches for+-- @symbol@ in all modules added to @layer@. If @exportedSymbolsOnly@+-- is 'True' only exported symbols are searched.+findSymbol :: CompileLayer l => l -> MangledSymbol -> Bool -> IO JITSymbol+findSymbol compileLayer symbol exportedSymbolsOnly = flip runAnyContT return $ do+  symbol' <- encodeM symbol+  exportedSymbolsOnly' <- encodeM exportedSymbolsOnly+  symbol <- anyContToM $ bracket+    (FFI.findSymbol (getCompileLayer compileLayer) symbol' exportedSymbolsOnly') FFI.disposeSymbol+  decodeM symbol++-- | @'findSymbolIn' layer handle symbol exportedSymbolsOnly@ searches for+-- @symbol@ in the context of the modules represented by @handle@. If+-- @exportedSymbolsOnly@ is 'True' only exported symbols are searched.+findSymbolIn :: CompileLayer l => l -> FFI.ModuleSetHandle -> MangledSymbol -> Bool -> IO JITSymbol+findSymbolIn compileLayer handle symbol exportedSymbolsOnly = flip runAnyContT return $ do+  symbol' <- encodeM symbol+  exportedSymbolsOnly' <- encodeM exportedSymbolsOnly+  symbol <- anyContToM $ bracket+    (FFI.findSymbolIn (getCompileLayer compileLayer) handle symbol' exportedSymbolsOnly') FFI.disposeSymbol+  decodeM symbol++-- | Add a list of modules to the 'CompileLayer'. The 'SymbolResolver' is used+-- to resolve external symbols in these modules.+--+-- /Note:/ This function consumes the modules passed be it and they+-- must not be used after calling this method.+addModuleSet :: CompileLayer l => l -> [Module] -> SymbolResolver -> IO FFI.ModuleSetHandle+addModuleSet compileLayer modules resolver = flip runAnyContT return $ do+  resolverAct <- encodeM resolver+  resolver' <- liftIO $ resolverAct (getCleanups compileLayer)+  modules' <- liftIO $ mapM readModule modules+  liftIO $ mapM_ deleteModule modules+  (moduleCount, modules'') <-+    anyContToM $ \f -> withArrayLen modules' $ \n hs -> f (fromIntegral n, hs)+  liftIO $+    FFI.addModuleSet+      (getCompileLayer compileLayer)+      (getDataLayout compileLayer)+      modules''+      moduleCount+      resolver'++-- | Remove a set of previously added modules.+removeModuleSet :: CompileLayer l => l -> FFI.ModuleSetHandle -> IO ()+removeModuleSet compileLayer handle =+  FFI.removeModuleSet (getCompileLayer compileLayer) handle++-- | 'bracket'-style wrapper around 'addModuleSet' and 'removeModuleSet'.+--+-- /Note:/ This function consumes the modules passed to it and they+-- must not be used after calling this method.+withModuleSet :: CompileLayer l => l -> [Module] -> SymbolResolver -> (FFI.ModuleSetHandle -> IO a) -> IO a+withModuleSet compileLayer modules resolver =+  bracket+    (addModuleSet compileLayer modules resolver)+    (removeModuleSet compileLayer)++-- | Dispose of a 'CompileLayer'. This should called when the+-- 'CompileLayer' is not needed anymore.+disposeCompileLayer :: CompileLayer l => l -> IO ()+disposeCompileLayer l = do+  FFI.disposeCompileLayer (getCompileLayer l)+  sequence_ =<< readIORef (getCleanups l)

@@ -7,35 +7,45 @@ import Control.Monad.AnyCont import Control.Monad.IO.Class import Data.IORef-import Foreign.Marshal.Array import Foreign.Ptr  import LLVM.Internal.Coding-import LLVM.Internal.Module import LLVM.Internal.OrcJIT-import LLVM.Internal.OrcJIT.IRCompileLayer (IRCompileLayer(..))-import qualified LLVM.Internal.OrcJIT.IRCompileLayer as IRCompileLayer+import LLVM.Internal.OrcJIT.CompileLayer+import LLVM.Internal.Target+import qualified LLVM.Internal.FFI.DataLayout as FFI import qualified LLVM.Internal.FFI.OrcJIT as FFI import qualified LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer as FFI import qualified LLVM.Internal.FFI.PtrHierarchy as FFI  type PartitioningFn = Ptr FFI.Function -> IO [Ptr FFI.Function] -newtype JITCompileCallbackManager =-  CallbackMgr (Ptr FFI.JITCompileCallbackManager)+-- | This is used by 'CompileOnDemandLayer' to create callback that+-- compile functions when they are called.+data JITCompileCallbackManager =+  CallbackMgr !(Ptr FFI.JITCompileCallbackManager)+              !(IO ()) +-- | This is used by 'CompileOnDemandLayer' to manage the stubs+-- created for function definitions that have not yet been compiled. newtype IndirectStubsManagerBuilder =   StubsMgr (Ptr FFI.IndirectStubsManagerBuilder) -data CompileOnDemandLayer =+-- | Adding a module to a 'CompileOnDemandLayer' creates stubs for its+-- functions definitions. When one of those stubs is called, the+-- corresponding function body is extracted and compiled.+data CompileOnDemandLayer baseLayer =   CompileOnDemandLayer {     compileLayer :: !(Ptr FFI.CompileOnDemandLayer),-    baseLayer :: !IRCompileLayer,+    dataLayout :: !(Ptr FFI.DataLayout),     cleanupActions :: !(IORef [IO ()])   }   deriving Eq -newtype ModuleSet = ModuleSet (Ptr FFI.ModuleSetHandle)+instance CompileLayer (CompileOnDemandLayer l) where+  getCompileLayer = FFI.upCast . compileLayer+  getDataLayout = dataLayout+  getCleanups = cleanupActions  instance MonadIO m =>   EncodeM m PartitioningFn (IORef [IO ()] -> IO (FunPtr FFI.PartitioningFn)) where@@ -49,98 +59,115 @@            return ()))  instance (MonadIO m, MonadAnyCont IO m) =>-  EncodeM m (Maybe (IO ())) FFI.TargetAddress where-  encodeM Nothing = return $ FFI.TargetAddress 0+         EncodeM m (Maybe (IO ())) (FFI.TargetAddress, IO ()) where+  encodeM Nothing = return (FFI.TargetAddress 0, return ())   encodeM (Just f) = do-    f' <- anyContToM $ bracket (FFI.wrapErrorHandler f) freeHaskellFunPtr-    return . FFI.TargetAddress . fromIntegral . ptrToWordPtr . castFunPtrToPtr $ f'+    f' <- anyContToM $ bracketOnError (FFI.wrapErrorHandler f) freeHaskellFunPtr+    return+      ( (FFI.TargetAddress . fromIntegral . ptrToWordPtr . castFunPtrToPtr) f'+      , freeHaskellFunPtr f') +-- | Create a new 'IndirectStubsManagerBuilder'.+--+-- When the stubs manager is no longer needed, it should be freed+-- using 'disposeIndirectStubsManagerBuilder'.+newIndirectStubsManagerBuilder ::+  ShortByteString {- ^ target triple -} ->+  IO IndirectStubsManagerBuilder+newIndirectStubsManagerBuilder triple =+  flip runAnyContT return $ do+    triple' <- encodeM triple+    stubsMgr <- liftIO (FFI.createLocalIndirectStubsManagerBuilder triple')+    return (StubsMgr stubsMgr)++-- | Dispose of an 'IndirectStubsManagerBuilder'.+disposeIndirectStubsManagerBuilder :: IndirectStubsManagerBuilder -> IO ()+disposeIndirectStubsManagerBuilder (StubsMgr stubsMgr) =+  FFI.disposeIndirectStubsManagerBuilder stubsMgr++-- | 'bracket'-style wrapper around 'newIndirectStubsManagerBuilder'+-- and 'disposeIndirectStubsManagerBuilder'. withIndirectStubsManagerBuilder ::-  ShortByteString {- ^ triple -} ->+  ShortByteString {- ^ target triple -} ->   (IndirectStubsManagerBuilder -> IO a) ->   IO a-withIndirectStubsManagerBuilder triple f = flip runAnyContT return $ do+withIndirectStubsManagerBuilder triple =+  bracket+    (newIndirectStubsManagerBuilder triple)+    disposeIndirectStubsManagerBuilder++-- | Create a new 'JITCompileCallbackManager'.+--+-- When the callback manager is no longer needed, it should be freed+-- using 'disposeJITCompileCallbackManager'.+newJITCompileCallbackManager ::+  ShortByteString {- ^ target triple -} ->+  Maybe (IO ()) {- ^ called on compilation errors -} ->+  IO JITCompileCallbackManager+newJITCompileCallbackManager triple errorHandler = flip runAnyContT return $ do   triple' <- encodeM triple-  stubsMgr <- anyContToM $ bracket-    (FFI.createLocalIndirectStubsManagerBuilder triple')-    FFI.disposeIndirectStubsManagerBuilder-  liftIO $ f (StubsMgr stubsMgr)+  (errorHandler', cleanup) <- encodeM errorHandler+  callbackMgr <- liftIO (FFI.createLocalCompileCallbackManager triple' errorHandler')+  return (CallbackMgr callbackMgr cleanup) +-- | Dispose of a 'JITCompileCallbackManager'.+disposeJITCompileCallbackManager :: JITCompileCallbackManager -> IO ()+disposeJITCompileCallbackManager (CallbackMgr mgr cleanup) =+  FFI.disposeCallbackManager mgr >> cleanup++-- | Execute a computation using a new 'JITCompileCallbackManager'. withJITCompileCallbackManager ::-  ShortByteString {- ^ triple -} ->-  Maybe (IO ()) ->+  ShortByteString {- ^ target triple -} ->+  Maybe (IO ()) {- ^ called on compilation errors -} ->   (JITCompileCallbackManager -> IO a) ->   IO a-withJITCompileCallbackManager triple errorHandler f = flip runAnyContT return $ do-  triple' <- encodeM triple-  errorHandler' <- encodeM errorHandler-  callbackMgr <- anyContToM $ bracket-    (FFI.createLocalCompileCallbackManager triple' errorHandler')-    FFI.disposeCallbackManager-  liftIO $ f (CallbackMgr callbackMgr)+withJITCompileCallbackManager triple errorHandler =+  bracket+    (newJITCompileCallbackManager triple errorHandler)+    disposeJITCompileCallbackManager +-- | Create a new 'CompileOnDemandLayer'. The partitioning function+-- specifies which functions should be compiled when a function is+-- called.+--+-- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer'.+newCompileOnDemandLayer :: CompileLayer l =>+  l ->+  TargetMachine ->+  (Ptr FFI.Function -> IO [Ptr FFI.Function]) {- ^ partitioning function -} ->+  JITCompileCallbackManager ->+  IndirectStubsManagerBuilder ->+  Bool {- ^ clone stubs into partitions -} ->+  IO (CompileOnDemandLayer l)+newCompileOnDemandLayer baseLayer tm partition (CallbackMgr callbackMgr _) (StubsMgr stubsMgr) cloneStubs =+  flip runAnyContT return $ do+    cleanups <- liftIO (newIORef [])+    dl <- createRegisteredDataLayout tm cleanups+    partitionAct <- encodeM partition+    partition' <- liftIO $ partitionAct cleanups+    cloneStubs' <- encodeM cloneStubs+    cl <-+      liftIO+        (FFI.createCompileOnDemandLayer+           (getCompileLayer baseLayer)+           partition'+           callbackMgr+           stubsMgr+           cloneStubs')+    return (CompileOnDemandLayer cl dl cleanups)++-- | 'bracket'-style wrapper around 'newCompileOnDemandLayer' and 'disposeCompileLayer'. withCompileOnDemandLayer ::-  IRCompileLayer ->-  PartitioningFn ->+  CompileLayer l =>+  l ->+  TargetMachine ->+  (Ptr FFI.Function -> IO [Ptr FFI.Function]) {- ^ partitioning function -} ->   JITCompileCallbackManager ->   IndirectStubsManagerBuilder ->-  Bool ->-  (CompileOnDemandLayer -> IO a) ->+  Bool {- ^ clone stubs into partitions -} ->+  (CompileOnDemandLayer l -> IO a) ->   IO a-withCompileOnDemandLayer- baseLayer@(IRCompileLayer base _ _)- partition- (CallbackMgr callbackMgr)- (StubsMgr stubsMgr)- cloneStubsIntoPartitions- f- = flip runAnyContT return $ do- cleanup <- anyContToM $ bracket (newIORef []) (sequence <=< readIORef)- partitionAct <- encodeM partition- partition' <- liftIO $ partitionAct cleanup- cloneStubsIntoPartitions' <- encodeM cloneStubsIntoPartitions- cl <- anyContToM $ bracket-         (FFI.createCompileOnDemandLayer-            base-            partition'-            callbackMgr-            stubsMgr-            cloneStubsIntoPartitions')-         FFI.disposeCompileOnDemandLayer- liftIO $ f (CompileOnDemandLayer cl baseLayer cleanup)--mangleSymbol :: CompileOnDemandLayer -> ShortByteString -> IO MangledSymbol-mangleSymbol (CompileOnDemandLayer _ bl _) symbol =-  IRCompileLayer.mangleSymbol bl symbol--findSymbol :: CompileOnDemandLayer -> MangledSymbol -> Bool -> IO JITSymbol-findSymbol (CompileOnDemandLayer cl _ _) symbol exportedSymbolsOnly = flip runAnyContT return $ do-  symbol' <- encodeM symbol-  exportedSymbolsOnly' <- encodeM exportedSymbolsOnly-  symbol <- anyContToM $ bracket-    (FFI.findSymbol cl symbol' exportedSymbolsOnly') FFI.disposeSymbol-  decodeM symbol--addModuleSet :: CompileOnDemandLayer -> [Module] -> SymbolResolver -> IO ModuleSet-addModuleSet-  (CompileOnDemandLayer cl (IRCompileLayer _ dl _) cleanups)-  modules-  resolver-  = flip runAnyContT return $ do-  resolverAct <- encodeM resolver-  resolver' <- liftIO $ resolverAct cleanups-  modules' <- liftIO $ mapM readModule modules-  (moduleCount, modules'') <--    anyContToM $ \f -> withArrayLen modules' $ \n hs -> f (fromIntegral n, hs)-  moduleSet <- liftIO $ FFI.addModuleSet cl dl modules'' moduleCount resolver'-  pure (ModuleSet moduleSet)--removeModuleSet :: CompileOnDemandLayer -> ModuleSet -> IO ()-removeModuleSet (CompileOnDemandLayer cl _ _) (ModuleSet handle) =-  FFI.removeModuleSet cl handle--withModuleSet :: CompileOnDemandLayer -> [Module] -> SymbolResolver -> (ModuleSet -> IO a) -> IO a-withModuleSet compileLayer modules resolver =+withCompileOnDemandLayer l tm partition callbackMgr stubsMgr cloneStubs =   bracket-    (addModuleSet compileLayer modules resolver)-    (removeModuleSet compileLayer)+    (newCompileOnDemandLayer l tm partition callbackMgr stubsMgr cloneStubs)+    disposeCompileLayer

@@ -1,4 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-} module LLVM.Internal.OrcJIT.IRCompileLayer where  import LLVM.Prelude@@ -7,19 +6,20 @@ import Control.Monad.AnyCont import Control.Monad.IO.Class import Data.IORef-import Foreign.Marshal.Array (withArrayLen) import Foreign.Ptr -import LLVM.Internal.Coding import qualified LLVM.Internal.FFI.DataLayout as FFI-import qualified LLVM.Internal.FFI.OrcJIT as FFI+import qualified LLVM.Internal.FFI.OrcJIT.CompileLayer as FFI import qualified LLVM.Internal.FFI.OrcJIT.IRCompileLayer as FFI-import qualified LLVM.Internal.FFI.Target as FFI-import LLVM.Internal.Module+import qualified LLVM.Internal.FFI.PtrHierarchy as FFI import LLVM.Internal.OrcJIT+import LLVM.Internal.OrcJIT.CompileLayer import LLVM.Internal.Target -data IRCompileLayer =+-- | 'IRCompileLayer' compiles modules immediately when they are+-- added. It parametrized by a 'LinkingLayer' which handles linking of+-- the generated object files.+data IRCompileLayer linkingLayer =   IRCompileLayer {     compileLayer :: !(Ptr FFI.IRCompileLayer),     dataLayout :: !(Ptr FFI.DataLayout),@@ -27,48 +27,25 @@   }   deriving Eq -newtype ModuleSet = ModuleSet (Ptr FFI.ModuleSetHandle)--withIRCompileLayer :: ObjectLinkingLayer -> TargetMachine -> (IRCompileLayer -> IO a) -> IO a-withIRCompileLayer (ObjectLinkingLayer oll) (TargetMachine tm) f = flip runAnyContT return $ do-  dl <- anyContToM $ bracket (FFI.createTargetDataLayout tm) FFI.disposeDataLayout-  cl <- anyContToM $ bracket (FFI.createIRCompileLayer oll tm) FFI.disposeIRCompileLayer-  cleanup <- anyContToM $ bracket (newIORef []) (sequence <=< readIORef)-  liftIO $ f (IRCompileLayer cl dl cleanup)--mangleSymbol :: IRCompileLayer -> ShortByteString -> IO MangledSymbol-mangleSymbol (IRCompileLayer _ dl _) symbol = flip runAnyContT return $ do-  mangledSymbol <- alloca-  symbol' <- encodeM symbol-  anyContToM $ bracket-    (FFI.getMangledSymbol mangledSymbol symbol' dl)-    (\_ -> FFI.disposeMangledSymbol =<< peek mangledSymbol)-  decodeM =<< peek mangledSymbol--findSymbol :: IRCompileLayer -> MangledSymbol -> Bool -> IO JITSymbol-findSymbol (IRCompileLayer cl _ _) symbol exportedSymbolsOnly = flip runAnyContT return $ do-  symbol' <- encodeM symbol-  exportedSymbolsOnly' <- encodeM exportedSymbolsOnly-  symbol <- anyContToM $ bracket-    (FFI.findSymbol cl symbol' exportedSymbolsOnly') FFI.disposeSymbol-  decodeM symbol--addModuleSet :: IRCompileLayer -> [Module] -> SymbolResolver -> IO ModuleSet-addModuleSet (IRCompileLayer cl dl cleanups) modules resolver = flip runAnyContT return $ do-  resolverAct <- encodeM resolver-  resolver' <- liftIO $ resolverAct cleanups-  modules' <- liftIO $ mapM readModule modules-  (moduleCount, modules'') <--    anyContToM $ \f -> withArrayLen modules' $ \n hs -> f (fromIntegral n, hs)-  moduleSet <- liftIO $ FFI.addModuleSet cl dl modules'' moduleCount resolver'-  pure (ModuleSet moduleSet)+instance CompileLayer (IRCompileLayer l) where+  getCompileLayer = FFI.upCast . compileLayer+  getDataLayout = dataLayout+  getCleanups = cleanupActions -removeModuleSet :: IRCompileLayer -> ModuleSet -> IO ()-removeModuleSet (IRCompileLayer cl _ _) (ModuleSet handle) =-  FFI.removeModuleSet cl handle+-- | Create a new 'IRCompileLayer'.+--+-- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer.+newIRCompileLayer :: LinkingLayer l => l -> TargetMachine -> IO (IRCompileLayer l)+newIRCompileLayer linkingLayer (TargetMachine tm) = flip runAnyContT return $ do+  cleanups <- liftIO (newIORef [])+  dl <- createRegisteredDataLayout (TargetMachine tm) cleanups+  cl <- anyContToM $+    bracketOnError+      (FFI.createIRCompileLayer (getLinkingLayer linkingLayer) tm)+      (FFI.disposeCompileLayer . FFI.upCast)+  return (IRCompileLayer cl dl cleanups) -withModuleSet :: IRCompileLayer -> [Module] -> SymbolResolver -> (ModuleSet -> IO a) -> IO a-withModuleSet compileLayer modules resolver =-  bracket-    (addModuleSet compileLayer modules resolver)-    (removeModuleSet compileLayer)+-- | 'bracket'-style wrapper around 'newIRCompileLayer' and 'disposeCompileLayer'.+withIRCompileLayer :: LinkingLayer l => l -> TargetMachine -> (IRCompileLayer l -> IO a) -> IO a+withIRCompileLayer linkingLayer tm =+  bracket (newIRCompileLayer linkingLayer tm) disposeCompileLayer

@@ -0,0 +1,69 @@+module LLVM.Internal.OrcJIT.IRTransformLayer where++import LLVM.Prelude++import Control.Exception+import Control.Monad.AnyCont+import Control.Monad.IO.Class+import Data.IORef+import Foreign.Ptr++import qualified LLVM.Internal.FFI.DataLayout as FFI+import qualified LLVM.Internal.FFI.Module as FFI+import qualified LLVM.Internal.FFI.OrcJIT.IRTransformLayer as FFI+import qualified LLVM.Internal.FFI.PtrHierarchy as FFI+import LLVM.Internal.OrcJIT+import LLVM.Internal.OrcJIT.CompileLayer+import LLVM.Internal.Target++-- | 'IRTransformLayer' allows transforming modules before handing off+-- compilation to the underlying 'CompileLayer'.+data IRTransformLayer baseLayer =+  IRTransformLayer {+    compileLayer :: !(Ptr FFI.IRTransformLayer),+    dataLayout :: !(Ptr FFI.DataLayout),+    cleanupActions :: !(IORef [IO ()])+  }+  deriving Eq++instance CompileLayer (IRTransformLayer l) where+  getCompileLayer = FFI.upCast . compileLayer+  getDataLayout = dataLayout+  getCleanups = cleanupActions++-- | Create a new 'IRTransformLayer'.+--+-- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer'.+newIRTransformLayer+  :: CompileLayer l+  => l+  -> TargetMachine+  -> (Ptr FFI.Module -> IO (Ptr FFI.Module)) {- ^ module transformation -}+  -> IO (IRTransformLayer l)+newIRTransformLayer compileLayer tm moduleTransform =+  flip runAnyContT return $ do+    cleanups <- liftIO (newIORef [])+    dl <- createRegisteredDataLayout tm cleanups+    let encodedModuleTransform =+          allocFunPtr cleanups (FFI.wrapModuleTransform moduleTransform)+    moduleTransform' <-+      anyContToM $ bracketOnError encodedModuleTransform freeHaskellFunPtr+    cl <-+      liftIO+        (FFI.createIRTransformLayer+           (getCompileLayer compileLayer)+           moduleTransform')+    return (IRTransformLayer cl dl cleanups)++-- | 'bracket'-style wrapper around 'newIRTransformLayer' and 'disposeCompileLayer'.+withIRTransformLayer ::+     CompileLayer l+  => l+  -> TargetMachine+  -> (Ptr FFI.Module -> IO (Ptr FFI.Module)) {- ^ module transformation -}+  -> (IRTransformLayer l -> IO a)+  -> IO a+withIRTransformLayer compileLayer tm moduleTransform =+  bracket+    (newIRTransformLayer compileLayer tm moduleTransform)+    disposeCompileLayer

@@ -93,9 +93,9 @@           s <- ByteString.pack <$> many1 (notWord8 (fromIntegral (ord ',')))           return (CPUFeature s, en)         features = liftM Map.fromList (flag `sepBy` (char8 ','))-    case parseOnly (do f <- features; endOfInput; return f) s of+    case parseOnly (features <* endOfInput) s of       Right features -> return features-      Left _ -> fail "failure to parse CPUFeature string"+      Left err -> fail ("failure to parse CPUFeature string: " <> err)                         -- | Find a 'Target' given an architecture and/or a \"triple\". -- | <http://llvm.org/doxygen/structllvm_1_1TargetRegistry.html#a3105b45e546c9cc3cf78d0f2ec18ad89>

@@ -1,11 +1,56 @@ module LLVM.OrcJIT (+    -- * CompileLayer+    CompileLayer,+    -- ** Add/remove modules+    ModuleSetHandle,+    addModuleSet,+    removeModuleSet,+    withModuleSet,+    -- ** Search for symbols+    findSymbol,+    findSymbolIn,     JITSymbol(..),     JITSymbolFlags(..),+    SymbolResolver(..),+    -- ** Symbol mangling     MangledSymbol,+    mangleSymbol,+    -- ** IRCompileLayer+    IRCompileLayer,+    newIRCompileLayer,+    withIRCompileLayer,+    -- ** CompileOnDemandLayer+    CompileOnDemandLayer,+    newCompileOnDemandLayer,+    withCompileOnDemandLayer,+    -- ** IRTRansformLayer+    IRTransformLayer,+    newIRTransformLayer,+    withIRTransformLayer,+    -- ** Dispose of compile layers+    disposeCompileLayer,+    -- * LinkingLayer+    LinkingLayer,+    -- ** Create linking layers     ObjectLinkingLayer,-    SymbolResolver(..),-    SymbolResolverFn,-    withObjectLinkingLayer+    newObjectLinkingLayer,+    withObjectLinkingLayer,+    -- ** Dispose of linking layers+    disposeLinkingLayer,+    -- * JITCompileCallbackManager+    JITCompileCallbackManager,+    newJITCompileCallbackManager,+    disposeJITCompileCallbackManager,+    withJITCompileCallbackManager,+    -- * IndirectStubsManagerBuilder+    IndirectStubsManagerBuilder,+    newIndirectStubsManagerBuilder,+    disposeIndirectStubsManagerBuilder,+    withIndirectStubsManagerBuilder,   ) where  import LLVM.Internal.OrcJIT+import LLVM.Internal.OrcJIT.CompileLayer+import LLVM.Internal.OrcJIT.CompileOnDemandLayer+import LLVM.Internal.OrcJIT.IRCompileLayer+import LLVM.Internal.OrcJIT.IRTransformLayer

@@ -1,14 +0,0 @@-module LLVM.OrcJIT.CompileOnDemandLayer (-    PartitioningFn,-    JITCompileCallbackManager,-    IndirectStubsManagerBuilder,-    CompileOnDemandLayer,-    withIndirectStubsManagerBuilder,-    withJITCompileCallbackManager,-    withCompileOnDemandLayer,-    mangleSymbol,-    findSymbol,-    withModuleSet-  ) where--import LLVM.Internal.OrcJIT.CompileOnDemandLayer

@@ -1,10 +0,0 @@-module LLVM.OrcJIT.IRCompileLayer (-    IRCompileLayer,-    ModuleSet,-    findSymbol,-    mangleSymbol,-    withIRCompileLayer,-    withModuleSet-  ) where--import           LLVM.Internal.OrcJIT.IRCompileLayer

@@ -6,19 +6,20 @@  import LLVM.Test.Support +import Control.Applicative import Data.ByteString (ByteString) import Data.Foldable import Data.IORef import Data.Word import Foreign.Ptr +import LLVM.Internal.PassManager+import qualified LLVM.Internal.FFI.PassManager as FFI import LLVM.Context import LLVM.Module+import qualified LLVM.Internal.FFI.Module as FFI import LLVM.OrcJIT-import LLVM.OrcJIT.IRCompileLayer (IRCompileLayer, withIRCompileLayer)-import qualified LLVM.OrcJIT.IRCompileLayer as IRCompileLayer-import LLVM.OrcJIT.CompileOnDemandLayer (CompileOnDemandLayer, withIndirectStubsManagerBuilder, withJITCompileCallbackManager, withCompileOnDemandLayer)-import qualified LLVM.OrcJIT.CompileOnDemandLayer as CODLayer+import LLVM.Internal.OrcJIT.CompileLayer import LLVM.Target  testModule :: ByteString@@ -47,21 +48,20 @@ nullResolver :: MangledSymbol -> IO JITSymbol nullResolver s = putStrLn "nullresolver" >> return (JITSymbol 0 (JITSymbolFlags False False)) -resolver :: MangledSymbol -> IRCompileLayer -> MangledSymbol -> IO JITSymbol+resolver :: CompileLayer l => MangledSymbol -> l -> MangledSymbol -> IO JITSymbol resolver testFunc compileLayer symbol   | symbol == testFunc = do       funPtr <- wrapTestFunc myTestFuncImpl       let addr = ptrToWordPtr (castFunPtrToPtr funPtr)       return (JITSymbol addr (JITSymbolFlags False True))-  | otherwise = IRCompileLayer.findSymbol compileLayer symbol True+  | otherwise = findSymbol compileLayer symbol True -codResolver :: MangledSymbol -> CompileOnDemandLayer -> MangledSymbol -> IO JITSymbol-codResolver testFunc compileLayer symbol-  | symbol == testFunc = do-      funPtr <- wrapTestFunc myTestFuncImpl-      let addr = ptrToWordPtr (castFunPtrToPtr funPtr)-      return (JITSymbol addr (JITSymbolFlags False True))-  | otherwise = CODLayer.findSymbol compileLayer symbol True+moduleTransform :: IORef Bool -> Ptr FFI.Module -> IO (Ptr FFI.Module)+moduleTransform passmanagerSuccessful modulePtr = do+  withPassManager defaultCuratedPassSetSpec { optLevel = Just 2 } $ \(PassManager pm) -> do+    success <- toEnum . fromIntegral <$> FFI.runPassManager pm modulePtr+    writeIORef passmanagerSuccessful success+    pure modulePtr  tests :: TestTree tests =@@ -69,36 +69,58 @@     testCase "eager compilation" $ do       withTestModule $ \mod ->         withHostTargetMachine $ \tm ->-          withObjectLinkingLayer $ \objectLayer ->-            withIRCompileLayer objectLayer tm $ \compileLayer -> do-              testFunc <- IRCompileLayer.mangleSymbol compileLayer "testFunc"-              IRCompileLayer.withModuleSet+          withObjectLinkingLayer $ \linkingLayer ->+            withIRCompileLayer linkingLayer tm $ \compileLayer -> do+              testFunc <- mangleSymbol compileLayer "testFunc"+              withModuleSet                 compileLayer                 [mod]                 (SymbolResolver (resolver testFunc compileLayer) nullResolver) $                 \moduleSet -> do-                  mainSymbol <- IRCompileLayer.mangleSymbol compileLayer "main"-                  JITSymbol mainFn _ <- IRCompileLayer.findSymbol compileLayer mainSymbol True+                  mainSymbol <- mangleSymbol compileLayer "main"+                  JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True                   result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))+                  result @?= 42+                  JITSymbol mainFn _ <- findSymbolIn compileLayer moduleSet mainSymbol True+                  result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))                   result @?= 42, +    testCase "IRTransformLayer" $ do+      passmanagerSuccessful <- newIORef False+      withTestModule $ \mod ->+        withHostTargetMachine $ \tm ->+          withObjectLinkingLayer $ \linkingLayer ->+            withIRCompileLayer linkingLayer tm $ \compileLayer -> do+              withIRTransformLayer compileLayer tm (moduleTransform passmanagerSuccessful) $ \compileLayer -> do+                testFunc <- mangleSymbol compileLayer "testFunc"+                withModuleSet+                  compileLayer+                  [mod]+                  (SymbolResolver (resolver testFunc compileLayer) nullResolver) $+                  \moduleSet -> do+                    mainSymbol <- mangleSymbol compileLayer "main"+                    JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True+                    result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))+                    result @?= 42+                    assert (readIORef passmanagerSuccessful),+     testCase "lazy compilation" $ do       withTestModule $ \mod ->         withHostTargetMachine $ \tm -> do           triple <- getTargetMachineTriple tm-          withObjectLinkingLayer $ \objectLayer ->-            withIRCompileLayer objectLayer tm $ \baseLayer ->+          withObjectLinkingLayer $ \linkingLayer ->+            withIRCompileLayer linkingLayer tm $ \baseLayer ->               withIndirectStubsManagerBuilder triple $ \stubsMgr ->                 withJITCompileCallbackManager triple Nothing $ \callbackMgr ->-                  withCompileOnDemandLayer baseLayer (\x -> return [x]) callbackMgr stubsMgr False $ \compileLayer -> do-                    testFunc <- CODLayer.mangleSymbol compileLayer "testFunc"-                    CODLayer.withModuleSet+                  withCompileOnDemandLayer baseLayer tm (\x -> return [x]) callbackMgr stubsMgr False $ \compileLayer -> do+                    testFunc <- mangleSymbol compileLayer "testFunc"+                    withModuleSet                       compileLayer                       [mod]-                      (SymbolResolver (codResolver testFunc compileLayer) nullResolver) $+                      (SymbolResolver (resolver testFunc compileLayer) nullResolver) $                       \moduleSet -> do-                        mainSymbol <- CODLayer.mangleSymbol compileLayer "main"-                        JITSymbol mainFn _ <- CODLayer.findSymbol compileLayer mainSymbol True+                        mainSymbol <- mangleSymbol compileLayer "main"+                        JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True                         result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))                         result @?= 42   ]

@@ -1,4 +1,5 @@ {-# LANGUAGE+  CPP,   OverloadedStrings,   RecordWildCards,   ScopedTypeVariables@@ -9,7 +10,6 @@ import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Test.QuickCheck-import Test.QuickCheck.Property  import Control.Applicative import Control.Monad@@ -53,11 +53,16 @@     allowFloatingPointOperationFusion <- arbitrary     return Options { .. } +arbitraryASCIIString :: Gen String+#if MIN_VERSION_QuickCheck(2,10,0)+arbitraryASCIIString = getASCIIString <$> arbitrary+#else+arbitraryASCIIString = arbitrary+#endif+ instance Arbitrary CPUFeature where   arbitrary = CPUFeature . ByteString.pack <$>-    liftA2 (:)-      (suchThat arbitrary isAlphaNum)-      (suchThat arbitrary (all isAlphaNum))+    suchThat arbitraryASCIIString (\s -> not (null s) && all isAlphaNum s)  tests = testGroup "Target" [   testGroup "Options" [