llvm-tf 16.0 → 17.0
raw patch · 6 files changed
+68/−86 lines, 6 filesdep ~llvm-ffi
Dependency ranges changed: llvm-ffi
Files
- llvm-tf.cabal +3/−3
- private/LLVM/Core/Instructions.hs +1/−2
- private/LLVM/Core/Instructions/Guided.hs +4/−5
- private/LLVM/Core/Instructions/Private.hs +9/−4
- private/LLVM/Core/Util.hs +0/−34
- src/LLVM/Util/Optimize.hs +51/−38
llvm-tf.cabal view
@@ -1,5 +1,5 @@ Name: llvm-tf-Version: 16.0+Version: 17.0 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: 16.0+ Tag: 17.0 Type: darcs Location: http://code.haskell.org/~thielema/llvm-tf/ @@ -53,7 +53,7 @@ Library private Default-Language: Haskell98 Build-Depends:- llvm-ffi >=15.0 && <17.0,+ llvm-ffi >=17.0 && <18.0, tfp >=1.0 && <1.1, transformers >=0.3 && <0.7, storable-record >=0.0.2 && <0.1,
private/LLVM/Core/Instructions.hs view
@@ -1191,8 +1191,7 @@ -> Value (Ptr a) -- ^ Address to store to. -> CodeGenFunction r () store (Value v) (Value p) = do- withCurrentBuilder_ $ \ bldPtr ->- FFI.buildStore bldPtr v p+ withCurrentBuilder_ $ \ bldPtr -> FFI.buildStore bldPtr v p return () -- | Address arithmetic. See LLVM description.
private/LLVM/Core/Instructions/Guided.hs view
@@ -52,7 +52,7 @@ import qualified LLVM.Core.Proxy as LP import LLVM.Core.Instructions.Private (ValueCons, proxyFromValuePtr) import LLVM.Core.CodeGenMonad (CodeGenFunction)-import LLVM.Core.CodeGen (ConstValue, zero)+import LLVM.Core.CodeGen (ConstValue, Value, zero) import LLVM.Core.Data (Ptr) import LLVM.Core.Type (IsArithmetic, IsInteger, IsIntegerOrPointer, IsFloating,@@ -276,11 +276,10 @@ select ::- (ValueCons value, IsPrimitive a,- Type shape a ~ av, Type shape Bool ~ bv) =>+ (IsPrimitive a, Type shape a ~ av, Type shape Bool ~ bv) => Guide shape a ->- value bv -> value av -> value av -> CodeGenFunction r (value av)-select Guide = Priv.trinop FFI.constSelect FFI.buildSelect+ Value bv -> Value av -> Value av -> CodeGenFunction r (Value av)+select Guide = Priv.trinopValue FFI.buildSelect cmp ::
private/LLVM/Core/Instructions/Private.hs view
@@ -154,10 +154,15 @@ switchValueCons (TrinOp $ \(ConstValue a) (ConstValue b) (ConstValue c) -> liftIO $ fmap ConstValue $ cop a b c)- (TrinOp $ \(Value a) (Value b) (Value c) ->- liftM Value $- withCurrentBuilder $ \ bld ->- U.withEmptyCString $ op bld a b c)+ (TrinOp $ trinopValue op)++trinopValue ::+ FFITrinOp ->+ Value a -> Value b -> Value c -> CodeGenFunction r (Value d)+trinopValue op (Value a) (Value b) (Value c) =+ liftM Value $+ withCurrentBuilder $ \ bld ->+ U.withEmptyCString $ op bld a b c
private/LLVM/Core/Util.hs view
@@ -7,7 +7,6 @@ getModuleValues, getFunctions, getGlobalVariables, valueHasType, -- * Pass manager handling PassManager(..), withPassManager, createPassManager, createFunctionPassManager,- runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager, -- * Instruction builder Builder(..), withBuilder, createBuilder, positionAtEnd, getInsertBlock, -- * Basic blocks@@ -34,15 +33,11 @@ functionType, buildEmptyPhi, addPhiIns, showTypeOf, getValueNameU, getObjList, annotateValueList, isConstant, isIntrinsic,- -- * Transformation passes- addCFGSimplificationPass, addDemoteMemoryToRegisterPass,- addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass, ) where import qualified LLVM.FFI.Core as FFI import qualified LLVM.FFI.BitWriter as FFI import qualified LLVM.FFI.BitReader as FFI-import qualified LLVM.FFI.Transforms.Scalar as FFI import Foreign.C.String (withCString, withCStringLen, CString, peekCString) import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)@@ -367,35 +362,6 @@ withModule modul $ \modulPtr -> do ptr <- FFI.createFunctionPassManagerForModule modulPtr liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr---- | Add a control flow graph simplification pass to the manager.-addCFGSimplificationPass :: PassManager -> IO ()-addCFGSimplificationPass pm = withPassManager pm FFI.addCFGSimplificationPass--addDemoteMemoryToRegisterPass :: PassManager -> IO ()-addDemoteMemoryToRegisterPass pm = withPassManager pm FFI.addDemoteMemoryToRegisterPass---- | Add a global value numbering pass to the manager.-addGVNPass :: PassManager -> IO ()-addGVNPass pm = withPassManager pm FFI.addGVNPass--addInstructionCombiningPass :: PassManager -> IO ()-addInstructionCombiningPass pm = withPassManager pm FFI.addInstructionCombiningPass--addPromoteMemoryToRegisterPass :: PassManager -> IO ()-addPromoteMemoryToRegisterPass pm = withPassManager pm FFI.addPromoteMemoryToRegisterPass--addReassociatePass :: PassManager -> IO ()-addReassociatePass pm = withPassManager pm FFI.addReassociatePass--runFunctionPassManager :: PassManager -> Function -> IO FFI.Bool-runFunctionPassManager pm fcn = withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn--initializeFunctionPassManager :: PassManager -> IO FFI.Bool-initializeFunctionPassManager pm = withPassManager pm FFI.initializeFunctionPassManager--finalizeFunctionPassManager :: PassManager -> IO FFI.Bool-finalizeFunctionPassManager pm = withPassManager pm FFI.finalizeFunctionPassManager --------------------------------------
src/LLVM/Util/Optimize.hs view
@@ -1,17 +1,39 @@ module LLVM.Util.Optimize(optimizeModule) where -import LLVM.Core.Util (Module, withModule, getObjList)+import LLVM.Core.Util (Module, withModule) -import qualified LLVM.FFI.Transforms.PassManagerBuilder as PMB+import qualified LLVM.FFI.Transforms.PassBuilder as PB+import qualified LLVM.FFI.TargetMachine as TM+import qualified LLVM.FFI.Error as Error import qualified LLVM.FFI.Core as FFI-import LLVM.FFI.Transforms.Scalar (addVerifierPass) -import Control.Exception (bracket, bracket_)+import qualified Foreign.Marshal.Alloc as Alloc+import qualified Foreign.C.String as CStr+import Foreign.C.String (withCString)+import Foreign.Storable (peek)+import Foreign.Ptr (Ptr, nullPtr) +import Control.Exception (bracket)+import Control.Monad (when) -{- |-Result tells whether the module was modified by any of the passes.+import Text.Printf (printf) ++failFromError :: Ptr CStr.CString -> IO a+failFromError errorRef =+ bracket (peek errorRef) Alloc.free $ \errorMsg ->+ CStr.peekCString errorMsg >>= fail++getTargetFromTriple :: TM.Triple -> IO TM.TargetRef+getTargetFromTriple triple =+ Alloc.alloca $ \targetRef ->+ Alloc.alloca $ \errorRef -> do+ failure <- TM.getTargetFromTriple triple targetRef errorRef+ if FFI.deconsBool failure+ then failFromError errorRef+ else peek targetRef++{- | It is very important that you set target triple and target data layout before optimizing. Otherwise the optimizer will make wrong assumptions@@ -21,42 +43,33 @@ In the future I might enforce via types that you set target parameters before optimization. -}-optimizeModule :: Int -> Module -> IO Bool+optimizeModule :: Int -> Module -> IO () optimizeModule optLevel mdl =- withModule mdl $ \ m ->- {-- Core.Util.createPassManager would provide a finalizer for us,- but I think it is better here to immediately dispose the manager- when we need it no longer.- -}- bracket FFI.createPassManager FFI.disposePassManager $ \mpasses ->- bracket (FFI.createFunctionPassManagerForModule m)- FFI.disposePassManager $ \fpasses -> do- addVerifierPass mpasses+ withModule mdl $ \ modul -> - 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- -}+ (FFI.getTarget modul >>=) $ \triple ->+ (getTargetFromTriple triple >>=) $ \target ->+ (TM.getHostCPUName >>=) $ \cpu ->+ withCString "" $ \features -> - PMB.populateFunctionPassManager passBuilder fpasses- PMB.populateModulePassManager passBuilder mpasses+ bracket+ (TM.createTargetMachine target triple cpu features+ TM.codeGenLevelDefault TM.relocDefault TM.codeModelDefault)+ TM.disposeTargetMachine $+ \tm -> - 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 FFI.deconsBool $ mchanged : fchanged+ bracket PB.createPassBuilderOptions PB.disposePassBuilderOptions $+ \pbOpt ->++ withCString (printf "default<O%d>" optLevel) $ \passName -> do+ PB.passBuilderOptionsSetVerifyEach pbOpt FFI.true+ errorRef <- PB.runPasses modul passName tm pbOpt+ when (errorRef /= nullPtr) $+ bracket+ (Error.getErrorMessage errorRef)+ Error.disposeErrorMessage+ $ \errorMsg ->+ CStr.peekCString errorMsg >>= fail {- ToDo: