llvm-tf 3.0.0.0.2 → 3.0.0.1
raw patch · 3 files changed
+42/−34 lines, 3 filesdep +transformersdep −mtldep ~tfp
Dependencies added: transformers
Dependencies removed: mtl
Dependency ranges changed: tfp
Files
- LLVM/Core/CodeGenMonad.hs +21/−20
- LLVM/ExecutionEngine/Engine.hs +17/−10
- llvm-tf.cabal +4/−4
LLVM/Core/CodeGenMonad.hs view
@@ -10,7 +10,8 @@ liftIO ) where import Data.Typeable-import Control.Monad.State+import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, gets, put, modify, )+import Control.Monad.IO.Class (MonadIO, liftIO, ) import Control.Applicative (Applicative, ) import Foreign.Ptr (Ptr, )@@ -27,17 +28,17 @@ } deriving (Show, Typeable) newtype CodeGenModule a = CGM (StateT CGMState IO a)- deriving (Functor, Applicative, Monad, MonadState CGMState, MonadIO, Typeable)+ deriving (Functor, Applicative, Monad, MonadIO, Typeable) genMSym :: String -> CodeGenModule String genMSym prefix = do- s <- get+ s <- CGM get let n = cgm_next s- put (s { cgm_next = n + 1 })+ CGM $ put (s { cgm_next = n + 1 }) return $ "_" ++ prefix ++ show n getModule :: CodeGenModule Module-getModule = gets cgm_module+getModule = CGM $ gets cgm_module runCodeGenModule :: Module -> CodeGenModule a -> IO a runCodeGenModule m (CGM body) = do@@ -54,36 +55,36 @@ } deriving (Show, Typeable) newtype CodeGenFunction r a = CGF (StateT (CGFState r) IO a)- deriving (Functor, Applicative, Monad, MonadState (CGFState r), MonadIO, Typeable)+ deriving (Functor, Applicative, Monad, MonadIO, Typeable) genFSym :: CodeGenFunction a String genFSym = do- s <- get+ s <- CGF get let n = cgf_next s- put (s { cgf_next = n + 1 })+ CGF $ put (s { cgf_next = n + 1 }) return $ "_L" ++ show n getFunction :: CodeGenFunction a Function-getFunction = gets cgf_function+getFunction = CGF $ gets cgf_function getBuilder :: CodeGenFunction a Builder-getBuilder = gets cgf_builder+getBuilder = CGF $ gets cgf_builder getFunctionModule :: CodeGenFunction a Module-getFunctionModule = gets (cgm_module . cgf_module)+getFunctionModule = CGF $ gets (cgm_module . cgf_module) getExterns :: CodeGenFunction a [(String, Function)]-getExterns = gets (cgm_externs . cgf_module)+getExterns = CGF $ gets (cgm_externs . cgf_module) putExterns :: [(String, Function)] -> CodeGenFunction a () putExterns es = do- cgf <- get+ cgf <- CGF get let cgm' = (cgf_module cgf) { cgm_externs = es }- put (cgf { cgf_module = cgm' })+ CGF $ put (cgf { cgf_module = cgm' }) addGlobalMapping :: Function -> Ptr () -> CodeGenModule ()-addGlobalMapping value func = modify $ \cgm ->+addGlobalMapping value func = CGM $ modify $ \cgm -> cgm { cgm_global_mappings = (value,func) : cgm_global_mappings cgm } @@ -98,17 +99,17 @@ getGlobalMappings :: CodeGenModule GlobalMappings getGlobalMappings =- gets (GlobalMappings . cgm_global_mappings)+ CGM $ gets (GlobalMappings . cgm_global_mappings) runCodeGenFunction :: Builder -> Function -> CodeGenFunction r a -> CodeGenModule a runCodeGenFunction bld fn (CGF body) = do- cgm <- get+ cgm <- CGM get let cgf = CGFState { cgf_module = cgm, cgf_builder = bld, cgf_function = fn, cgf_next = 1 } (a, cgf') <- liftIO $ runStateT body cgf- put (cgf_module cgf')+ CGM $ put (cgf_module cgf') return a --------------------------------------@@ -116,7 +117,7 @@ -- | Allows you to define part of a module while in the middle of defining a function. liftCodeGenModule :: CodeGenModule a -> CodeGenFunction r a liftCodeGenModule (CGM act) = do- cgf <- get+ cgf <- CGF get (a, cgm') <- liftIO $ runStateT act (cgf_module cgf)- put (cgf { cgf_module = cgm' })+ CGF $ put (cgf { cgf_module = cgm' }) return a
LLVM/ExecutionEngine/Engine.hs view
@@ -20,7 +20,10 @@ runFunction, getRunFunction, GenericValue, Generic(..) ) where-import Control.Monad.State+import qualified Control.Monad.Trans.State as MS+import Control.Monad.Trans.State (StateT, runStateT, )+import Control.Monad.IO.Class (MonadIO, liftIO, )+import Control.Monad (liftM, ) import Control.Applicative (Applicative, ) import Control.Concurrent.MVar import Data.Typeable@@ -133,7 +136,7 @@ deriving (Show, Typeable) newtype EngineAccess a = EA (StateT EAState IO a)- deriving (Functor, Applicative, Monad, MonadState EAState, MonadIO)+ deriving (Functor, Applicative, Monad, MonadIO) -- |The LLVM execution engine is encapsulated so it cannot be accessed directly. -- The reason is that (currently) there must only ever be one engine,@@ -148,14 +151,18 @@ addModuleProvider :: ModuleProvider -> EngineAccess () addModuleProvider prov = do- ea <- get- put ea{ ea_providers = prov : ea_providers ea }+ ea <- EA MS.get+ EA $ MS.put ea{ ea_providers = prov : ea_providers ea } liftIO $ withModuleProvider prov $ \ provPtr -> FFI.addModuleProvider (ea_engine ea) provPtr ++getEngine :: EngineAccess (Ptr FFI.ExecutionEngine)+getEngine = EA $ MS.gets ea_engine+ getExecutionEngineTargetData :: EngineAccess FFI.TargetDataRef getExecutionEngineTargetData = do- eePtr <- gets ea_engine+ eePtr <- getEngine liftIO $ FFI.getExecutionEngineTargetData eePtr {- |@@ -169,7 +176,7 @@ -} getPointerToFunction :: Function f -> EngineAccess (FunPtr f) getPointerToFunction (Value f) = do- eePtr <- gets ea_engine+ eePtr <- getEngine liftIO $ FFI.getPointerToGlobal eePtr f {- |@@ -192,7 +199,7 @@ addFunctionValueCore :: U.Function -> Ptr () -> EngineAccess () addFunctionValueCore g f = do- eePtr <- gets ea_engine+ eePtr <- getEngine liftIO $ FFI.addGlobalMapping eePtr g f addModule :: Module -> EngineAccess ()@@ -206,7 +213,7 @@ type FreePointers = (Ptr FFI.ExecutionEngine, FFI.ModuleProviderRef, FFI.ValueRef) getFreePointers :: Function f -> EngineAccess FreePointers getFreePointers (Value f) = do- ea <- get+ ea <- EA MS.get liftIO $ withModuleProvider (head $ ea_providers ea) $ \ mpp -> return (ea_engine ea, mpp, f) @@ -231,13 +238,13 @@ runFunction :: U.Function -> [GenericValue] -> EngineAccess GenericValue runFunction func args = do- eePtr <- gets ea_engine+ eePtr <- getEngine liftIO $ withAll args $ \argLen argPtr -> createGenericValueWith $ FFI.runFunction eePtr func (fromIntegral argLen) argPtr getRunFunction :: EngineAccess (U.Function -> [GenericValue] -> IO GenericValue) getRunFunction = do- eePtr <- gets ea_engine+ eePtr <- getEngine return $ \ func args -> withAll args $ \argLen argPtr -> createGenericValueWith $ FFI.runFunction eePtr func
llvm-tf.cabal view
@@ -1,5 +1,5 @@ name: llvm-tf-version: 3.0.0.0.2+version: 3.0.0.1 license: BSD3 license-file: LICENSE synopsis: Bindings to the LLVM compiler toolkit using type families.@@ -49,9 +49,9 @@ bytestring >= 0.9, directory, llvm-base == 3.0.*,- mtl,+ transformers >= 0.3 && < 0.4, process,- tfp >= 0.7 && < 0.8,+ tfp >= 0.7 && < 0.9, containers ghc-options: -Wall@@ -90,6 +90,6 @@ location: http://code.haskell.org/~thielema/llvm-tf/ source-repository this- tag: 3.0.0.0.2+ tag: 3.0.0.1 type: darcs location: http://code.haskell.org/~thielema/llvm-tf/