packages feed

llvm-tf 3.0.3.2 → 3.0.3.3

raw patch · 12 files changed

+97/−122 lines, 12 filesdep +enumsetdep ~llvm-ffi

Dependencies added: enumset

Dependency ranges changed: llvm-ffi

Files

example/Convert.hs view
@@ -19,7 +19,7 @@  foreign import ccall safe "dynamic" c_Float_Float :: Importer (Float -> Float) instance Convert (Float -> Float) where convert = c_Float_Float- + foreign import ccall safe "dynamic" c_IODouble :: Importer (IO Double) instance Convert (IO Double) where convert = c_IODouble @@ -28,7 +28,7 @@  foreign import ccall safe "dynamic" c_Double_Double :: Importer (Double -> Double) instance Convert (Double -> Double) where convert = c_Double_Double- + foreign import ccall safe "dynamic" c_Word32_IOWord32 :: Importer (Word32 -> IO Word32) instance Convert (Word32 -> IO Word32) where convert = c_Word32_IOWord32
example/Intrinsic.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ForeignFunctionInterface #-} module Main where  import qualified LLVM.Core as LLVM@@ -6,7 +7,7 @@ import qualified Foreign.Marshal.Utils as MU import Foreign.Marshal.Alloc (alloca, ) import Foreign.Storable (Storable, peek, )-import Foreign.Ptr (Ptr, )+import Foreign.Ptr (Ptr, FunPtr, )  import qualified Type.Data.Num.Decimal as TypeNum import qualified Data.Word as W@@ -47,17 +48,23 @@       flip LLVM.store ptr1 =<< flip roundps (LLVM.valueOf 1) =<< LLVM.load ptr0       LLVM.ret () +type Importer func = FunPtr func -> func++foreign import ccall safe "dynamic" derefFloorPtr ::+   Importer (Ptr Vector -> Ptr Vector -> IO ())+ run :: IO () run = do    m <- LLVM.newModule-   _f <- LLVM.defineModule m $ LLVM.setTarget LLVM.hostTriple >> modul+   floorFunc <- do+      func <- LLVM.defineModule m $ LLVM.setTarget LLVM.hostTriple >> modul+      EE.runEngineAccessWithModule m $ EE.getPointerToFunction func    LLVM.writeBitcodeToFile "floor.bc" m     print vector-   floorFunc <- EE.simpleFunction modul    MU.with vector $ \ptr0 ->       alloca $ \ptr1 -> do-         floorFunc ptr0 ptr1+         derefFloorPtr floorFunc ptr0 ptr1          print =<< peek ptr1
llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name:          llvm-tf-Version:       3.0.3.2+Version:       3.0.3.3 License:       BSD3 License-File:  LICENSE Synopsis:      Bindings to the LLVM compiler toolkit using type families.@@ -37,7 +37,7 @@   Location: http://code.haskell.org/~thielema/llvm-tf/  Source-Repository this-  Tag:      3.0.3.2+  Tag:      3.0.3.3   Type:     darcs   Location: http://code.haskell.org/~thielema/llvm-tf/ @@ -53,11 +53,12 @@ Library   Default-Language: Haskell98   Build-Depends:-    llvm-ffi >= 3.5.1 && <3.6,+    llvm-ffi >= 3.6 && <3.7,     tfp >=1.0 && <1.1,     transformers >=0.3 && <0.6,     process >=1.1 && <1.5,     storable-record >=0.0.2 && <0.1,+    enumset >=0.0.4 && <0.1,     fixed-length >=0.2 && <0.3,     non-empty >=0.2 && <0.4,     utility-ht >=0.0.10 && <0.1,
src/LLVM/Core.hs view
@@ -59,7 +59,7 @@     TFunction, liftCodeGenModule, getParams,     -- * Global variable creation     Global, newGlobal, newNamedGlobal, defineGlobal, createGlobal, createNamedGlobal,-    externFunction, staticFunction,+    externFunction, staticFunction, staticNamedFunction,     externGlobal, staticGlobal,     GlobalMappings, getGlobalMappings,     TGlobal,@@ -67,7 +67,7 @@     Linkage(..),     -- * Basic blocks     BasicBlock, newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, getCurrentBasicBlock,-    getBasicBlocks,              +    getBasicBlocks,     fromLabel, toLabel,     getInstructions, getOperands, hasUsers, getUsers, getUses, getUser, isChildOf, getDep,     -- * Misc
src/LLVM/Core/CodeGen.hs view
@@ -15,7 +15,7 @@     Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, setFuncCallConv,     addAttributes,     FFI.Attribute(..),-    externFunction, staticFunction,+    externFunction, staticFunction, staticNamedFunction,     FunctionArgs, FunctionCodeGen, FunctionResult,     TFunction,     -- * Global variable creation@@ -195,14 +195,13 @@  constEnum :: (Enum a) => IO FFI.TypeRef -> a -> ConstValue a constEnum mt i =-    unsafeConstValue $ mt >>= \t -> FFI.constInt t (fromIntegral $ fromEnum i) 0+    unsafeConstValue $ mt >>= \t ->+        FFI.constInt t (fromIntegral $ fromEnum i) FFI.false  constI :: (IsInteger a, Integral a) => a -> ConstValue a constI i =     unsafeWithConstValue $ \typ ->-    FFI.constInt-        typ (fromIntegral i)-        (fromIntegral $ fromEnum $ isSigned $ LP.fromValue i)+    FFI.constInt typ (fromIntegral i) (FFI.consBool $ isSigned $ LP.fromValue i)  constF :: (IsFloating a, Real a) => a -> ConstValue a constF i =@@ -433,8 +432,15 @@ <http://old.nabble.com/jit-with-external-functions-td7769793.html>. -} staticFunction :: forall f r. (IsFunction f) => FunPtr f -> CodeGenFunction r (Function f)-staticFunction func = liftCodeGenModule $ do-    val <- newNamedFunction ExternalLinkage ""+staticFunction = staticNamedFunction ""++{- |+Due to <https://llvm.org/bugs/show_bug.cgi?id=20656>+this will fail with MCJIT of LLVM-3.6.+-}+staticNamedFunction :: forall f r. (IsFunction f) => String -> FunPtr f -> CodeGenFunction r (Function f)+staticNamedFunction name func = liftCodeGenModule $ do+    val <- newNamedFunction ExternalLinkage name     addFunctionMapping (unValue (val :: Function f)) func     return val @@ -472,7 +478,7 @@     typ <- liftIO $ typeRef (LP.Proxy :: LP.Proxy a)     liftIO $ liftM Value $ do         g <- U.addGlobal modul linkage name typ-        when isConst $ FFI.setGlobalConstant g 1+        when isConst $ FFI.setGlobalConstant g FFI.true         return g  -- | Create a new global variable.@@ -542,7 +548,7 @@     elemTyp <- liftIO $ typeRef (LP.Proxy :: LP.Proxy Word8)     typ <- liftIO $ FFI.arrayType elemTyp (fromIntegral n)     liftIO $ liftM Value $ do g <- U.addGlobal modul InternalLinkage name typ-    	     	   	      FFI.setGlobalConstant g 1+    	     	   	      FFI.setGlobalConstant g FFI.true 			      FFI.setInitializer g s 			      return g
src/LLVM/Core/CodeGenMonad.hs view
@@ -57,7 +57,7 @@  -------------------------------------- -data CGFState r = CGFState { +data CGFState r = CGFState {     cgf_module :: CGMState,     cgf_builder :: Builder,     cgf_function :: Function,
src/LLVM/Core/Instructions.hs view
@@ -1146,7 +1146,7 @@ arrayMalloc :: forall a r s . (IsSized a, AllocArg s) =>                s -> CodeGenFunction r (Value (Ptr a)) -- XXX arrayMalloc s = do-    func <- staticFunction alignedMalloc+    func <- staticNamedFunction "alignedMalloc" alignedMalloc --    func <- externFunction "malloc"      size <- sizeOfArray (LP.Proxy :: LP.Proxy a) (getAllocArg s)@@ -1182,7 +1182,7 @@ -- | Free heap memory. free :: (IsType a) => Value (Ptr a) -> CodeGenFunction r () free ptr = do-    func <- staticFunction alignedFree+    func <- staticNamedFunction "alignedFree" alignedFree --    func <- externFunction "free"     _ <- call (func :: Function (Ptr Word8 -> IO ())) =<< bitcast ptr     return ()
src/LLVM/Core/Util.hs view
@@ -53,7 +53,6 @@ import Foreign.Marshal.Array (withArrayLen, withArray, allocaArray, peekArray) import Foreign.Marshal.Alloc (alloca) import Foreign.Storable (Storable(..))-import Foreign.Marshal.Utils (fromBool, toBool) import System.IO.Unsafe (unsafePerformIO)  import Data.Typeable (Typeable)@@ -66,12 +65,12 @@ functionType :: Bool -> Type -> [Type] -> IO Type functionType varargs retType paramTypes =     withArrayLen paramTypes $ \ len ptr ->-        FFI.functionType retType ptr (fromIntegral len) (fromBool varargs)+        FFI.functionType retType ptr (fromIntegral len) (FFI.consBool varargs)  structType :: [Type] -> Bool -> IO Type structType types packed =     withArrayLen types $ \ len ptr ->-        FFI.structType ptr (fromIntegral len) (fromBool packed)+        FFI.structType ptr (fromIntegral len) (FFI.consBool packed)  -------------------------------------- -- Handle modules@@ -120,13 +119,13 @@       alloca $ \ modPtr ->       alloca $ \ errStr -> do         rrc <- FFI.createMemoryBufferWithContentsOfFile namePtr bufPtr errStr-        if rrc /= 0 then do+        if FFI.deconsBool rrc then do             msg <- peek errStr >>= peekCString             ioError $ userError $ "readBitcodeFromFile: read return code " ++ show rrc ++ ", " ++ msg          else do             buf <- peek bufPtr             prc <- FFI.parseBitcode buf modPtr errStr-	    if prc /= 0 then do+	    if FFI.deconsBool prc then do                 msg <- peek errStr >>= peekCString                 ioError $ userError $ "readBitcodeFromFile: parse return code " ++ show prc ++ ", " ++ msg              else do@@ -284,7 +283,7 @@ constStringInternal :: Bool -> String -> Value constStringInternal nulTerm s = unsafePerformIO $     withCStringLen s $ \(sPtr, sLen) ->-      FFI.constString sPtr (fromIntegral sLen) (fromBool (not nulTerm))+      FFI.constString sPtr (fromIntegral sLen) (FFI.consBool (not nulTerm))  constString :: String -> Value constString = constStringInternal False@@ -413,14 +412,14 @@ addTargetData :: FFI.TargetDataRef -> PassManager -> IO () addTargetData td pm = withPassManager pm $ FFI.addTargetData td -runFunctionPassManager :: PassManager -> Function -> IO Int-runFunctionPassManager pm fcn = liftM fromIntegral $ withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn+runFunctionPassManager :: PassManager -> Function -> IO FFI.Bool+runFunctionPassManager pm fcn = withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn -initializeFunctionPassManager :: PassManager -> IO Int-initializeFunctionPassManager pm = liftM fromIntegral $ withPassManager pm FFI.initializeFunctionPassManager+initializeFunctionPassManager :: PassManager -> IO FFI.Bool+initializeFunctionPassManager pm = withPassManager pm FFI.initializeFunctionPassManager -finalizeFunctionPassManager :: PassManager -> IO Int-finalizeFunctionPassManager pm = liftM fromIntegral $ withPassManager pm FFI.finalizeFunctionPassManager+finalizeFunctionPassManager :: PassManager -> IO FFI.Bool+finalizeFunctionPassManager pm = withPassManager pm FFI.finalizeFunctionPassManager  -------------------------------------- @@ -437,7 +436,7 @@ constStruct :: [Value] -> Bool -> IO Value constStruct xs packed = do     withArrayLen xs $ \ len ptr ->-        FFI.constStruct ptr (fromIntegral len) (fromBool packed)+        FFI.constStruct ptr (fromIntegral len) (FFI.consBool packed)  -------------------------------------- @@ -465,17 +464,17 @@   return $ zip names vs  isConstant :: Value -> IO Bool-isConstant v = fmap toBool $ FFI.isConstant v+isConstant v = fmap FFI.deconsBool $ FFI.isConstant v  isIntrinsic :: Value -> IO Bool-isIntrinsic v = fmap toBool $ FFI.getIntrinsicID v+isIntrinsic v = fmap (/=0) $ FFI.getIntrinsicID v  --------------------------------------  type Use = FFI.UseRef  hasUsers :: Value -> IO Bool-hasUsers v = fmap toBool $ FFI.getNumUses v+hasUsers v = fmap (>0) $ FFI.getNumUses v  getUses :: Value -> IO [Use] getUses = getObjList withValue FFI.getFirstUse FFI.getNextUse
src/LLVM/ExecutionEngine.hs view
@@ -28,8 +28,8 @@ import LLVM.ExecutionEngine.Target import LLVM.Core.CodeGen (Value(..)) import LLVM.Core-         (CodeGenModule, Function, newModule, defineModule, getGlobalMappings)---import LLVM.Core.Util(runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager)+         (CodeGenModule, Function, newModule, defineModule, getGlobalMappings,+          setTarget, hostTriple)  import LLVM.FFI.Core (ValueRef) @@ -79,34 +79,12 @@ simpleFunction :: (Translatable f) => CodeGenModule (Function f) -> IO f simpleFunction bld = do     m <- newModule-    (func, mappings) <- defineModule m (liftM2 (,) bld getGlobalMappings)-    runEngineAccessWithModule m $ do+    (func, mappings) <-+        defineModule m $+            setTarget hostTriple >> liftM2 (,) bld getGlobalMappings+    runEngineAccessInterpreterWithModule m $ do         addGlobalMappings mappings         generateFunction func--{--    m <- newModule-    func <- defineModule m bld---    dumpValue func-    prov <- createModuleProviderForExistingModule m-    ee <- createExecutionEngine prov-    pm <- createFunctionPassManager prov-    td <- getExecutionEngineTargetData ee-    addTargetData td pm-    addInstructionCombiningPass pm-    addReassociatePass pm-    addGVNPass pm-    addCFGSimplificationPass pm-    addPromoteMemoryToRegisterPass pm-    initializeFunctionPassManager pm---    print ("rc1", rc1)-    runFunctionPassManager pm (unValue func)---    print ("rc2", rc2)-    finalizeFunctionPassManager pm---    print ("rc3", rc3)---    dumpValue func-    return $ generateFunction ee func--}  -- | Combine 'simpleFunction' and 'unsafeRemoveIO'. unsafeGenerateFunction :: (Unsafe t, Translatable t) =>
src/LLVM/ExecutionEngine/Engine.hs view
@@ -7,8 +7,8 @@ module LLVM.ExecutionEngine.Engine(        EngineAccess,        runEngineAccess, runEngineAccessWithModule,-       createExecutionEngine, addModuleProvider,-       createExecutionEngineForModule, addModule,+       addModuleProvider, addModule,+       runEngineAccessInterpreterWithModule,        getExecutionEngineTargetData,        getPointerToFunction,        addFunctionValue, addGlobalMappings,@@ -30,14 +30,15 @@  import qualified LLVM.FFI.ExecutionEngine as FFI import qualified LLVM.FFI.Target as FFI-import qualified LLVM.FFI.Core as FFI(ModuleProviderRef, ValueRef)+import qualified LLVM.FFI.Core as FFI+         (ModuleProviderRef, ValueRef, consBool, deconsBool, )  import qualified Control.Monad.Trans.State as MS import Control.Monad.IO.Class (MonadIO, liftIO, ) import Control.Monad (liftM, )-import Control.Applicative (Applicative, )-import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar, )+import Control.Applicative (Applicative, pure, (<*>), ) +import qualified Data.EnumSet as EnumSet import Data.Typeable (Typeable) import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word8, Word16, Word32, Word64)@@ -45,7 +46,6 @@ import Foreign.Marshal.Alloc (alloca, free) import Foreign.Marshal.Array (withArrayLen) import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)-import Foreign.Marshal.Utils (fromBool) import Foreign.C.String (peekCString) import Foreign.Ptr (Ptr, FunPtr, ) import Foreign.Storable (peek)@@ -53,21 +53,22 @@ import System.IO.Unsafe (unsafePerformIO)  --- This global variable holds the one and only execution engine.--- It may be missing, but it never dies.--- XXX We could provide a destructor, what about functions obtained by runFunction?-{-# NOINLINE theEngine #-}-theEngine :: MVar (Maybe FFI.ExecutionEngineRef)-theEngine = unsafePerformIO $ newMVar Nothing--createExecutionEngineGen ::-    (Ptr FFI.ExecutionEngineRef -> ptr -> Ptr U.CString -> IO Bool) ->-    ptr -> IO FFI.ExecutionEngineRef-createExecutionEngineGen create mPtr =+createExecutionEngineForModule ::+    Bool -> FFI.EngineKindSet -> Module -> IO FFI.ExecutionEngineRef+createExecutionEngineForModule hostCPU kind m =     alloca $ \eePtr ->         alloca $ \errPtr -> do-          success <- create eePtr mPtr errPtr-          if success+          success <-+            withModule m $ \mPtr ->+              if hostCPU+                then+                  FFI.createExecutionEngineKindForModuleCPU+                    eePtr kind mPtr errPtr+                else+                  if EnumSet.get FFI.JIT kind+                    then FFI.createExecutionEngineForModule eePtr mPtr errPtr+                    else FFI.createInterpreterForModule eePtr mPtr errPtr+          if FFI.deconsBool success             then do                 err <- peek errPtr                 errStr <- peekCString err@@ -76,28 +77,8 @@             else                 peek eePtr -createExecutionEngine :: ModuleProvider -> IO FFI.ExecutionEngineRef-createExecutionEngine prov =-    withModuleProvider prov $-        createExecutionEngineGen-            (\eePtr provPtr errPtr ->-                fmap (0/=) $ FFI.createExecutionEngine eePtr provPtr errPtr)--createExecutionEngineForModule :: Module -> IO FFI.ExecutionEngineRef-createExecutionEngineForModule m =-    withModule m $-        createExecutionEngineGen FFI.createExecutionEngineForModuleCPU--getTheEngine :: IO Module -> IO FFI.ExecutionEngineRef-getTheEngine getModule = do-    mee <- takeMVar theEngine-    case mee of-        Just ee -> do putMVar theEngine mee; return ee-        Nothing -> do-            m <- getModule-            ee <- createExecutionEngineForModule m-            putMVar theEngine (Just ee)-            return ee+getTheEngine :: FFI.EngineKindSet -> Module -> IO FFI.ExecutionEngineRef+getTheEngine = createExecutionEngineForModule True  data EAState = EAState {     ea_engine :: FFI.ExecutionEngineRef,@@ -113,15 +94,20 @@ -- so access to it is wrapped in a monad. runEngineAccess :: EngineAccess a -> IO a runEngineAccess (EA body) = do-    eePtr <- getTheEngine $ createModule "__empty__"+    eePtr <- getTheEngine FFI.kindEither =<< createModule "__empty__"     MS.evalStateT body $ EAState { ea_engine = eePtr, ea_providers = [] }     -- XXX should remove module providers again  runEngineAccessWithModule :: Module -> EngineAccess a -> IO a runEngineAccessWithModule m (EA body) = do-    eePtr <- getTheEngine $ return m+    eePtr <- getTheEngine FFI.kindEither m     MS.evalStateT body $ EAState { ea_engine = eePtr, ea_providers = [] } +runEngineAccessInterpreterWithModule :: Module -> EngineAccess a -> IO a+runEngineAccessInterpreterWithModule m (EA body) = do+    eePtr <- getTheEngine FFI.kindInterpreter m+    MS.evalStateT body $ EAState { ea_engine = eePtr, ea_providers = [] }+ addModuleProvider :: ModuleProvider -> EngineAccess () addModuleProvider prov = do     ea <- EA MS.get@@ -208,17 +194,15 @@ withAll ps a = go [] ps     where go ptrs (x:xs) = withGenericValue x $ \ptr -> go (ptr:ptrs) xs           go ptrs _ = withArrayLen (reverse ptrs) a-                   + runFunction :: U.Function -> [GenericValue] -> EngineAccess GenericValue-runFunction func args = do-    eePtr <- getEngine-    liftIO $ withAll args $ \argLen argPtr ->-                 createGenericValueWith $ FFI.runFunction eePtr func-                                              (fromIntegral argLen) argPtr+runFunction func args =+    liftIO =<< getRunFunction <*> pure func <*> pure args+ getRunFunction :: EngineAccess (U.Function -> [GenericValue] -> IO GenericValue) getRunFunction = do     eePtr <- getEngine-    return $ \ func args -> +    return $ \ func args ->              withAll args $ \argLen argPtr ->                  createGenericValueWith $ FFI.runFunction eePtr func                                               (fromIntegral argLen) argPtr@@ -235,15 +219,15 @@ toGenericInt signed val = unsafePerformIO $ createGenericValueWith $ do     typ <- typeRef $ Proxy.fromValue val     FFI.createGenericValueOfInt-        typ (fromIntegral val) (fromBool signed)+        typ (fromIntegral val) (FFI.consBool signed)  fromGenericInt :: (Integral a, IsFirstClass a) => Bool -> GenericValue -> a fromGenericInt signed val = unsafePerformIO $     withGenericValue val $ \ref ->-        fmap fromIntegral $ FFI.genericValueToInt ref (fromBool signed)+        fmap fromIntegral $ FFI.genericValueToInt ref (FFI.consBool signed)  --instance Generic Bool where---    toGeneric = toGenericInt False . fromBool+--    toGeneric = toGenericInt False . FFI.consBool --    fromGeneric = toBool . fromGenericInt False  instance Generic Int8 where
src/LLVM/ExecutionEngine/Target.hs view
@@ -54,7 +54,7 @@ makeTargetData r = TargetData {     aBIAlignmentOfType       = fromIntegral . unsafePerformIO . FFI.aBIAlignmentOfType r,     aBISizeOfType            = fromIntegral . unsafePerformIO . FFI.aBISizeOfType r,-    littleEndian             = unsafePerformIO (FFI.byteOrder r) /= 0,+    littleEndian             = unsafePerformIO (FFI.byteOrder r) /= FFI.bigEndian,     callFrameAlignmentOfType = fromIntegral . unsafePerformIO . FFI.callFrameAlignmentOfType r,     intPtrType               = unsafePerformIO $ FFI.intPtrType r,     pointerSize              = fromIntegral $ unsafePerformIO $ FFI.pointerSize r,
src/LLVM/Util/Optimize.hs view
@@ -47,7 +47,7 @@                  getObjList withModule                     FFI.getFirstFunction FFI.getNextFunction mdl)         mchanged <- FFI.runPassManager mpasses m-        return $ any (>0) $ mchanged : fchanged+        return $ any FFI.deconsBool $ mchanged : fchanged  {- ToDo: