packages feed

llvm-tf 3.0.3.1.9 → 3.0.3.2

raw patch · 12 files changed

+149/−106 lines, 12 filesdep ~basedep ~llvm-ffidep ~non-emptynew-component:exe:llvm-intrinsic

Dependency ranges changed: base, llvm-ffi, non-empty, tfp

Files

example/Array.hs view
@@ -58,7 +58,7 @@     -- Initialize jitter     initializeNativeTarget     m <- newModule-    _f <- defineModule m cg+    _f <- defineModule m $ setTarget hostTriple >> cg     writeBitcodeToFile "Arr.bc" m     _ <- optimizeModule 3 m     writeBitcodeToFile "Arr-opt.bc" m
example/CallConv.hs view
@@ -15,7 +15,7 @@ main :: IO () main = do     m <- newModule-    _fns <- defineModule m buildMod+    _fns <- defineModule m $ setTarget hostTriple >> buildMod     --_ <- optimizeModule 3 m     writeBitcodeToFile "CallConv.bc" m     return ()
example/Fibonacci.hs view
@@ -41,8 +41,7 @@      -- Generate code for mfib, and then throw away the IO in the type.     -- The result is an ordinary Haskell function.-    iofib <- EE.runEngineAccess $ do-                 EE.addModule m+    iofib <- EE.runEngineAccessWithModule m $                  EE.generateFunction $ mfib fns     let fib = EE.unsafeRemoveIO iofib
+ example/Intrinsic.hs view
@@ -0,0 +1,67 @@+module Main where++import qualified LLVM.Core as LLVM+import qualified LLVM.ExecutionEngine as EE++import qualified Foreign.Marshal.Utils as MU+import Foreign.Marshal.Alloc (alloca, )+import Foreign.Storable (Storable, peek, )+import Foreign.Ptr (Ptr, )++import qualified Type.Data.Num.Decimal as TypeNum+import qualified Data.Word as W++import qualified Data.NonEmpty.Class as NonEmptyC+++type Vector4 = LLVM.Vector TypeNum.D4 Float+type Vector8 = LLVM.Vector TypeNum.D8 Float+type Vector = Vector4++vector :: Vector+vector = LLVM.vector $ NonEmptyC.iterate (1.2+) (-1.7 :: Float)++roundpsExtern4 ::+   LLVM.CodeGenFunction r+      (LLVM.Function (Vector4 -> W.Word32 -> IO Vector4))+roundpsExtern4 =+   LLVM.externFunction "llvm.x86.sse41.round.ps"++roundpsExtern8 ::+   LLVM.CodeGenFunction r+      (LLVM.Function (Vector8 -> W.Word32 -> IO Vector8))+roundpsExtern8 =+   LLVM.externFunction "llvm.x86.avx.round.ps.256"++roundps ::+   LLVM.Value Vector -> LLVM.Value W.Word32 ->+   LLVM.CodeGenFunction s (LLVM.Value Vector)+roundps xs mode = do+   f <- roundpsExtern4+   LLVM.call f xs mode++modul ::+   LLVM.CodeGenModule (LLVM.Function (Ptr Vector -> Ptr Vector -> IO ()))+modul =+   LLVM.createFunction LLVM.ExternalLinkage $ \ptr0 ptr1 -> do+      flip LLVM.store ptr1 =<< flip roundps (LLVM.valueOf 1) =<< LLVM.load ptr0+      LLVM.ret ()++run :: IO ()+run = do+   m <- LLVM.newModule+   _f <- LLVM.defineModule m $ LLVM.setTarget LLVM.hostTriple >> modul+   LLVM.writeBitcodeToFile "floor.bc" m++   print vector+   floorFunc <- EE.simpleFunction modul+   MU.with vector $ \ptr0 ->+      alloca $ \ptr1 -> do+         floorFunc ptr0 ptr1+         print =<< peek ptr1+++main :: IO ()+main = do+   LLVM.initializeNativeTarget+   run
example/List.hs view
@@ -74,7 +74,7 @@ renderList :: IO () renderList = do    m <- newModule-   _f <- defineModule m mList+   _f <- defineModule m $ setTarget hostTriple >> mList    writeBitcodeToFile "List.bc" m     fill <- simpleFunction mList
example/Vector.hs view
@@ -4,7 +4,7 @@ import Convert  import LLVM.ExecutionEngine-          (runEngineAccess, addModule, generateFunction, getPointerToFunction)+          (runEngineAccessWithModule, generateFunction, getPointerToFunction) import LLVM.Util.Optimize (optimizeModule, ) import LLVM.Util.Loop (forLoop, ) import LLVM.Core@@ -73,14 +73,14 @@     initializeNativeTarget     -- First run standard code.     m <- newModule-    iovec <- defineModule m cgvec+    iovec <- defineModule m $ setTarget hostTriple >> cgvec -    fptr <- runEngineAccess $ do addModule m; getPointerToFunction iovec+    fptr <- runEngineAccessWithModule m $ getPointerToFunction iovec     let fvec = convert fptr      fvec 10 >>= print -    vec <- runEngineAccess $ do addModule m; generateFunction iovec+    vec <- runEngineAccessWithModule m $ generateFunction iovec      vec 10 >>= print @@ -95,8 +95,8 @@ 	ioretacc' :: Function (IO T)         Just ioretacc' = castModuleValue =<< lookup retAccName funcs -    (vec', retacc') <- runEngineAccess $ do-        addModule m+    (vec', retacc') <-+        runEngineAccessWithModule m $         liftM2 (,) (generateFunction iovec') (generateFunction ioretacc')      dumpValue iovec'
llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name:          llvm-tf-Version:       3.0.3.1.9+Version:       3.0.3.2 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.1.9+  Tag:      3.0.3.2   Type:     darcs   Location: http://code.haskell.org/~thielema/llvm-tf/ @@ -53,7 +53,7 @@ Library   Default-Language: Haskell98   Build-Depends:-    llvm-ffi >= 3.0 && <3.6,+    llvm-ffi >= 3.5.1 && <3.6,     tfp >=1.0 && <1.1,     transformers >=0.3 && <0.6,     process >=1.1 && <1.5,@@ -204,6 +204,20 @@     Buildable: False    Main-Is: example/HelloJIT.hs+  Default-Language: Haskell98+  GHC-Options: -Wall++Executable llvm-intrinsic+  If flag(buildExamples)+    Build-Depends:+      llvm-tf,+      tfp,+      non-empty,+      base+  Else+    Buildable: False++  Main-Is: example/Intrinsic.hs   Default-Language: Haskell98   GHC-Options: -Wall
src/LLVM/Core.hs view
@@ -28,9 +28,10 @@ -- @newNamedX@ function; the @newX@ function just generates a fresh name. module LLVM.Core(     -- * Initialize-    initializeNativeTarget,+    Target.initializeNativeTarget,     -- * Modules     Module, newModule, newNamedModule, defineModule, destroyModule, createModule,+    setTarget, FFI.hostTriple,     ModuleProvider, createModuleProviderForExistingModule,     PassManager, createPassManager, createFunctionPassManager,     writeBitcodeToFile, readBitcodeFromFile,@@ -76,6 +77,7 @@     dumpValue, dumpType, getValueName, annotateValueList     ) where +import qualified LLVM.Target.Native as Target import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, constStruct, getModuleValues, valueHasType) import LLVM.Core.CodeGen import LLVM.Core.CodeGenMonad@@ -85,7 +87,6 @@ import LLVM.Core.Instructions import LLVM.Core.Type import LLVM.Core.Vector-import LLVM.Target.Native  import qualified LLVM.FFI.Core as FFI
src/LLVM/Core/CodeGen.hs view
@@ -7,7 +7,7 @@ module LLVM.Core.CodeGen(     -- * Module creation     newModule, newNamedModule, defineModule, createModule,-    getModuleValues, ModuleValue, castModuleValue,+    getModuleValues, ModuleValue, castModuleValue, setTarget,     -- * Globals     Linkage(..),     Visibility(..),@@ -51,6 +51,7 @@ import Type.Base.Proxy (Proxy)  import qualified Foreign.Storable as St+import Foreign.C.String (withCString) import Foreign.StablePtr (StablePtr, castStablePtrToPtr) import Foreign.Ptr (Ptr, minusPtr, nullPtr, FunPtr, castFunPtrToPtr) import System.IO.Unsafe (unsafePerformIO)@@ -86,6 +87,12 @@ createModule :: CodeGenModule a       -- ^ module body              -> IO a createModule cgm = newModule >>= \ m -> defineModule m cgm++setTarget :: String -> CodeGenModule ()+setTarget triple = do+    modul <- getModule+    liftIO $ U.withModule modul $ \m -> withCString triple $ FFI.setTarget m+  --------------------------------------
src/LLVM/ExecutionEngine.hs view
@@ -4,6 +4,7 @@     -- * Execution engine     EngineAccess,     runEngineAccess,+    runEngineAccessWithModule,     addModuleProvider,     addModule,     getPointerToFunction,@@ -22,16 +23,18 @@     -- * Target information     module LLVM.ExecutionEngine.Target     ) where-import System.IO.Unsafe (unsafePerformIO)  import LLVM.ExecutionEngine.Engine import LLVM.ExecutionEngine.Target import LLVM.Core.CodeGen (Value(..)) import LLVM.Core+         (CodeGenModule, Function, newModule, defineModule, getGlobalMappings) --import LLVM.Core.Util(runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager)  import LLVM.FFI.Core (ValueRef) +import System.IO.Unsafe (unsafePerformIO)+ import Control.Monad (liftM2, )  @@ -77,8 +80,7 @@ simpleFunction bld = do     m <- newModule     (func, mappings) <- defineModule m (liftM2 (,) bld getGlobalMappings)-    runEngineAccess $ do-        addModule m+    runEngineAccessWithModule m $ do         addGlobalMappings mappings         generateFunction func
src/LLVM/ExecutionEngine/Engine.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE DeriveDataTypeable #-} module LLVM.ExecutionEngine.Engine(        EngineAccess,-       runEngineAccess,+       runEngineAccess, runEngineAccessWithModule,        createExecutionEngine, addModuleProvider,        createExecutionEngineForModule, addModule,        getExecutionEngineTargetData,@@ -86,15 +86,15 @@ createExecutionEngineForModule :: Module -> IO FFI.ExecutionEngineRef createExecutionEngineForModule m =     withModule m $-        createExecutionEngineGen FFI.createExecutionEngineForModule+        createExecutionEngineGen FFI.createExecutionEngineForModuleCPU -getTheEngine :: IO FFI.ExecutionEngineRef-getTheEngine = do+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 <- createModule "__empty__"+            m <- getModule             ee <- createExecutionEngineForModule m             putMVar theEngine (Just ee)             return ee@@ -113,9 +113,14 @@ -- so access to it is wrapped in a monad. runEngineAccess :: EngineAccess a -> IO a runEngineAccess (EA body) = do-    eePtr <- getTheEngine+    eePtr <- getTheEngine $ 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+    MS.evalStateT body $ EAState { ea_engine = eePtr, ea_providers = [] }  addModuleProvider :: ModuleProvider -> EngineAccess () addModuleProvider prov = do
src/LLVM/Util/Optimize.hs view
@@ -1,22 +1,12 @@-{--LLVM does not export its functions-@createStandardFunctionPasses@ and-@createStandardModulePasses@ via its C interface-and interfacing to C-C++ wrappers is not very portable.-Thus we reimplement these functions-from @opt.cpp@ and @StandardPasses.h@ in Haskell.-However this way we risk inconsistencies-between 'optimizeModule' and the @opt@ shell command.--} module LLVM.Util.Optimize(optimizeModule) where -import LLVM.Core.Util (Module, withModule)+import LLVM.Core.Util (Module, withModule, getObjList) +import qualified LLVM.FFI.Transforms.PassManagerBuilder as PMB import qualified LLVM.FFI.Core as FFI-import qualified LLVM.FFI.Support as FFI import LLVM.FFI.Transforms.Scalar (addVerifierPass) -import Control.Exception (bracket)+import Control.Exception (bracket, bracket_)   {- |@@ -30,76 +20,34 @@     but I think it is better here to immediately dispose the manager     when we need it no longer.     -}-    bracket FFI.createPassManager FFI.disposePassManager $ \ passes ->--{--Note on LLVM-2.6 to 2.8 (at least):-As far as I understand, if we do not set target data,-then the optimizer will only perform machine independent optimizations.-If we set target data-(e.g. an empty layout string obtained from a module without 'target data' specification.)-we risk that the optimizer switches to a wrong layout-(e.g. to 64 bit pointers on a 32 bit machine for empty layout string)-and thus generates corrupt code.--Currently it seems to be safer to disable-machine dependent optimization completely.--http://llvm.org/bugs/show_bug.cgi?id=6394--    -- Pass the module target data to the pass manager.-    target <- FFI.getDataLayout m >>= createTargetData-    addTargetData target passes--}--    {--    opt.cpp does not use a FunctionPassManager for function optimization,-    but a module PassManager.-    Thus we do it the same way.-    I assume that we would need a FunctionPassManager-    only if we wanted to apply individual optimizations to functions.--    fPasses <- FFI.createFunctionPassManager mp-    -}-    bracket FFI.createPassManager FFI.disposePassManager $ \ fPasses -> do-    -- add module target data?--    -- tools/opt/opt.cpp: AddStandardCompilePasses-    addVerifierPass passes-    addOptimizationPasses passes fPasses optLevel--    {- if we wanted to do so, we could loop through all functions and optimize them.-    initializeFunctionPassManager fPasses-    runFunctionPassManager fPasses fcn-    -}--    functionsModified <- FFI.runPassManager fPasses m--    moduleModified <- FFI.runPassManager passes m--    return $-       toEnum (fromIntegral moduleModified) ||-       toEnum (fromIntegral functionsModified)---- tools/opt/opt.cpp: AddOptimizationPasses-addOptimizationPasses :: FFI.PassManagerRef -> FFI.PassManagerRef -> Int -> IO ()-addOptimizationPasses passes fPasses optLevel = do-  createStandardFunctionPasses fPasses optLevel-  createStandardModulePasses passes optLevel True True (optLevel > 1) True True True+    bracket FFI.createPassManager FFI.disposePassManager $ \mpasses ->+    bracket (FFI.createFunctionPassManagerForModule m)+            FFI.disposePassManager $ \fpasses -> do+        addVerifierPass mpasses -createStandardFunctionPasses :: FFI.PassManagerRef -> Int -> IO ()-createStandardFunctionPasses fPasses optLevel =-    FFI.createStandardFunctionPasses fPasses (fromIntegral optLevel)+        bracket PMB.create PMB.dispose $ \passBuilder -> do+            PMB.setOptLevel passBuilder $ fromIntegral optLevel+            {-+            PMB.setSizeLevel passBuilder 1+            PMB.setDisableUnitAtATime passBuilder false+            PMB.setDisableUnrollLoops passBuilder (optLevel <= 1)+            PMB.setDisableSimplifyLibCalls passBuilder false+            PMB.setHaveExceptions passBuilder true+            PMB.setInliningPass passBuilder true+            -} --- llvm/Support/StandardPasses.h: createStandardModulePasses-createStandardModulePasses :: FFI.PassManagerRef -> Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> IO ()-createStandardModulePasses passes optLevel optSize unitAtATime unrollLoops simplifyLibCalls haveExceptions inliningPass =-  FFI.createStandardModulePasses passes (fromIntegral optLevel) (f optSize)-     (f unitAtATime) (f unrollLoops) (f simplifyLibCalls) (f haveExceptions)-     (f (not inliningPass))-  where f True = 1-        f _    = 0+            PMB.populateFunctionPassManager passBuilder fpasses+            PMB.populateModulePassManager passBuilder mpasses +        fchanged <-+            bracket_+                (FFI.initializeFunctionPassManager fpasses)+                (FFI.finalizeFunctionPassManager fpasses)+                (mapM (FFI.runFunctionPassManager fpasses) =<<+                 getObjList withModule+                    FFI.getFirstFunction FFI.getNextFunction mdl)+        mchanged <- FFI.runPassManager mpasses m+        return $ any (>0) $ mchanged : fchanged  {- ToDo: