llvm 3.0.1.0 → 3.2.0.0
raw patch · 9 files changed
+96/−93 lines, 9 filesdep ~llvm-basenew-uploader
Dependency ranges changed: llvm-base
Files
- LLVM/Core.hs +13/−2
- LLVM/Core/CodeGen.hs +11/−5
- LLVM/Core/Instructions.hs +36/−56
- LLVM/Core/Type.hs +2/−2
- LLVM/Core/Util.hs +23/−20
- LLVM/ExecutionEngine.hs +5/−2
- LLVM/Util/Optimize.hs +1/−3
- examples/List.hs +1/−1
- llvm.cabal +4/−2
LLVM/Core.hs view
@@ -46,6 +46,7 @@ zero, allOnes, undef, createString, createStringNul, withString, withStringNul,+ withModule, Module(..), --constString, constStringNul, constVector, constArray, constStruct, constPackedStruct,@@ -64,7 +65,7 @@ -- * Globals Linkage(..), -- * Basic blocks- BasicBlock, newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, getCurrentBasicBlock,+ BasicBlock, newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, createNamedBasicBlock, getCurrentBasicBlock, getBasicBlocks, fromLabel, toLabel, getInstructions, getOperands, hasUsers, getUsers, getUses, getUser, isChildOf, getDep,@@ -72,8 +73,10 @@ addAttributes, Attribute(..), castVarArgs, -- * Debugging- dumpValue, dumpType, getValueName, annotateValueList+ dumpValue, dumpType, annotateValueList,+ getValueName, setValueName, setValueName_ ) where+ import qualified LLVM.FFI.Core as FFI import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, constStruct, getModuleValues, valueHasType) import LLVM.Core.CodeGen@@ -95,6 +98,14 @@ -- |Get the name of a 'Value'. getValueName :: Value a -> IO String getValueName (Value a) = getValueNameU a++-- |Set the name of a 'Value'.+setValueName :: String -> Value a -> IO (Value a)+setValueName str v@(Value a) = setValueNameU str a >> return v++-- |Set the name of a 'Value'.+setValueName_ :: String -> Value a -> IO ()+setValueName_ str (Value a) = setValueNameU str a -- |Convert a varargs function to a regular function. castVarArgs :: (CastVarArgs a b) => Function a -> Function b
LLVM/Core/CodeGen.hs view
@@ -24,7 +24,7 @@ withString, withStringNul, constVector, constArray, constStruct, constPackedStruct, -- * Basic blocks- BasicBlock(..), newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, getCurrentBasicBlock,+ BasicBlock(..), newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, createNamedBasicBlock, getCurrentBasicBlock, fromLabel, toLabel, -- * Misc withCurrentBuilder@@ -143,10 +143,10 @@ constFieldsOf _ = [] constEnum :: (Enum a) => FFI.TypeRef -> a -> ConstValue a-constEnum t i = ConstValue $ FFI.constInt t (fromIntegral $ fromEnum i) 0+constEnum t i = ConstValue $ FFI.constInt t (fromIntegral $ fromEnum i) False constI :: (IsInteger a, Integral a) => a -> ConstValue a-constI i = ConstValue $ FFI.constInt (typeRef i) (fromIntegral i) (fromIntegral $ fromEnum $ isSigned i)+constI i = ConstValue $ FFI.constInt (typeRef i) (fromIntegral i) (isSigned i) constF :: (IsFloating a, Real a) => a -> ConstValue a constF i = ConstValue $ FFI.constReal (typeRef i) (realToFrac i)@@ -303,6 +303,12 @@ defineBasicBlock b return b +createNamedBasicBlock :: String -> CodeGenFunction r BasicBlock+createNamedBasicBlock name = do+ b <- newNamedBasicBlock name+ defineBasicBlock b+ return b+ newBasicBlock :: CodeGenFunction r BasicBlock newBasicBlock = genFSym >>= newNamedBasicBlock @@ -409,7 +415,7 @@ modul <- getModule let typ = typeRef (undefined :: a) liftIO $ liftM Value $ do g <- U.addGlobal modul linkage name typ- when isConst $ FFI.setGlobalConstant g 1+ when isConst $ FFI.setGlobalConstant g True return g -- | Create a new global variable.@@ -490,7 +496,7 @@ name <- genMSym "str" let typ = FFI.arrayType (typeRef (undefined :: Word8)) (fromIntegral n) liftIO $ liftM Value $ do g <- U.addGlobal modul InternalLinkage name typ- FFI.setGlobalConstant g 1+ FFI.setGlobalConstant g True FFI.setInitializer g s return g
LLVM/Core/Instructions.hs view
@@ -35,7 +35,7 @@ free, load, store,- getElementPtr, getElementPtr0,+ getElementPtr, getElementPtr0, unsafeGetElementPtr, -- * Conversions trunc, zext, sext, fptrunc, fpext,@@ -45,12 +45,13 @@ bitcast, bitcastUnify, -- * Comparison CmpPredicate(..), IntPredicate(..), FPPredicate(..),- CmpRet,+ CmpRet(..), cmp, pcmp, icmp, fcmp, select, -- * Other phi, addPhiInputs, call, callWithConv,+ sizeOf, alignOf, -- * Classes and types Terminate,@@ -65,10 +66,18 @@ import Data.Word import Data.Map(fromList, (!)) import Foreign.Ptr (FunPtr, )-import Foreign.C(CInt, CUInt)+import Foreign.C(CUInt) import Data.TypeLevel((:<:), (:>:), (:==:), (:*), D0, D1, D2, D3, D4, D5, D6, D7, D8, D9, d1, toNum, Succ) import qualified LLVM.FFI.Core as FFI+import LLVM.FFI.Core+ ( IntPredicate(..)+ , toIntPredicate+ , fromIntPredicate+ , FPPredicate(..)+ , toFPPredicate+ , fromFPPredicate+ ) import LLVM.Core.Data import LLVM.Core.Type import LLVM.Core.CodeGenMonad@@ -688,51 +697,6 @@ CmpLT -> FPOLT CmpLE -> FPOLE --data IntPredicate =- IntEQ -- ^ equal- | IntNE -- ^ not equal- | IntUGT -- ^ unsigned greater than- | IntUGE -- ^ unsigned greater or equal- | IntULT -- ^ unsigned less than- | IntULE -- ^ unsigned less or equal- | IntSGT -- ^ signed greater than- | IntSGE -- ^ signed greater or equal- | IntSLT -- ^ signed less than- | IntSLE -- ^ signed less or equal- deriving (Eq, Ord, Enum, Show, Typeable)--fromIntPredicate :: IntPredicate -> CInt-fromIntPredicate p = fromIntegral (fromEnum p + 32)--toIntPredicate :: Int -> IntPredicate-toIntPredicate p = toEnum $ fromIntegral p - 32--data FPPredicate =- FPFalse -- ^ Always false (always folded)- | FPOEQ -- ^ True if ordered and equal- | FPOGT -- ^ True if ordered and greater than- | FPOGE -- ^ True if ordered and greater than or equal- | FPOLT -- ^ True if ordered and less than- | FPOLE -- ^ True if ordered and less than or equal- | FPONE -- ^ True if ordered and operands are unequal- | FPORD -- ^ True if ordered (no nans)- | FPUNO -- ^ True if unordered: isnan(X) | isnan(Y)- | FPUEQ -- ^ True if unordered or equal- | FPUGT -- ^ True if unordered or greater than- | FPUGE -- ^ True if unordered, greater than, or equal- | FPULT -- ^ True if unordered or less than- | FPULE -- ^ True if unordered, less than, or equal- | FPUNE -- ^ True if unordered or not equal- | FPT -- ^ Always true (always folded)- deriving (Eq, Ord, Enum, Show, Typeable)--fromFPPredicate :: FPPredicate -> CInt-fromFPPredicate p = fromIntegral (fromEnum p)--toFPPredicate :: Int -> FPPredicate-toFPPredicate p = toEnum $ fromIntegral p- -- |Acceptable operands to comparison instructions. class CmpOp a b c d | a b -> c where cmpop :: FFIBinOp -> a -> b -> CodeGenFunction r (Value d)@@ -1014,8 +978,8 @@ -- | If we want to export that, then we should have a Size type -- This is the official implementation, -- but it suffers from the ptrtoint(gep) bug.-_sizeOf :: forall a r s . (IsSized a s) => a -> CodeGenFunction r (Value Word64)-_sizeOf a =+sizeOf :: forall a r s . (IsSized a s) => a -> CodeGenFunction r (Value Word64)+sizeOf a = liftIO $ liftM Value $ FFI.sizeOf (typeRef a) @@ -1145,13 +1109,9 @@ -- (This is without a doubt the most confusing LLVM instruction, but the types help.) getElementPtr :: forall a o i n r . (GetElementPtr o i n, IsIndexArg a) => Value (Ptr o) -> (a, i) -> CodeGenFunction r (Value (Ptr n))-getElementPtr (Value ptr) (a, ixs) =+getElementPtr val (a, ixs) = let ixl = getArg a : getIxList (undefined :: o) ixs in- liftM Value $- withCurrentBuilder $ \ bldPtr ->- U.withArrayLen ixl $ \ idxLen idxPtr ->- U.withEmptyCString $- FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen)+ getElementPtrFromValues val ixl -- | Like getElementPtr, but with an initial index that is 0. -- This is useful since any pointer first need to be indexed off the pointer, and then into@@ -1159,6 +1119,26 @@ getElementPtr0 :: (GetElementPtr o i n) => Value (Ptr o) -> i -> CodeGenFunction r (Value (Ptr n)) getElementPtr0 p i = getElementPtr p (0::Word32, i)++-- | Call getelementptr directly with a list of indexes.+-- This is should be used only if the runtime type is not yet known.+-- If the indexes and return type are incorrect this function may segfault+-- in LLVMBuildGEP, or assert if debug assertions are enabled.+unsafeGetElementPtr :: forall o i n r . IsIndexArg i =>+ Value (Ptr o) -> [i] -> CodeGenFunction r (Value (Ptr n))+unsafeGetElementPtr val i =+ let ixl = map getArg i in+ getElementPtrFromValues val ixl++-- | Internal function for emitting a GEP+getElementPtrFromValues :: forall o n r .+ Value (Ptr o) -> [FFI.ValueRef] -> CodeGenFunction r (Value n)+getElementPtrFromValues (Value ptr) ixl =+ liftM Value $+ withCurrentBuilder $ \ bldPtr ->+ U.withArrayLen ixl $ \ idxLen idxPtr ->+ U.withEmptyCString $+ FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen) -------------------------------------- {-
LLVM/Core/Type.hs view
@@ -38,7 +38,7 @@ typeDesc2, VarArgs, CastVarArgs, ) where-import Data.Typeable+import Data.Data import Data.List(intercalate) import Data.Int import Data.Word@@ -133,7 +133,7 @@ | TDArray Integer TypeDesc | TDVector Integer TypeDesc | TDPtr TypeDesc | TDFunction Bool [TypeDesc] TypeDesc | TDLabel | TDStruct [TypeDesc] Bool | TDInvalidType- deriving (Eq, Ord, Show, Typeable)+ deriving (Eq, Ord, Show, Typeable, Data) -- XXX isFloating and typeName could be extracted from typeRef -- Usage:
LLVM/Core/Util.hs view
@@ -31,7 +31,7 @@ CString, withArrayLen, withEmptyCString, functionType, buildEmptyPhi, addPhiIns,- showTypeOf, getValueNameU, getObjList, annotateValueList, isConstant,+ showTypeOf, getValueNameU, setValueNameU, getObjList, annotateValueList, isConstant, -- * Transformation passes addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass, addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,@@ -46,7 +46,6 @@ import Foreign.Marshal.Array (withArrayLen, withArray, allocaArray, peekArray) import Foreign.Marshal.Alloc (alloca) import Foreign.Storable (Storable(..))-import Foreign.Marshal.Utils (fromBool) import System.IO.Unsafe (unsafePerformIO) import qualified LLVM.FFI.Core as FFI@@ -61,14 +60,13 @@ functionType :: Bool -> Type -> [Type] -> Type functionType varargs retType paramTypes = unsafePerformIO $ withArrayLen paramTypes $ \ len ptr ->- return $ FFI.functionType retType ptr (fromIntegral len)- (fromBool varargs)+ return $ FFI.functionType retType ptr (fromIntegral len) varargs -- unsafePerformIO just to wrap the non-effecting withArrayLen call structType :: [Type] -> Bool -> Type structType types packed = unsafePerformIO $ withArrayLen types $ \ len ptr ->- return $ FFI.structType ptr (fromIntegral len) (if packed then 1 else 0)+ return $ FFI.structType ptr (fromIntegral len) packed -------------------------------------- -- Handle modules@@ -106,7 +104,7 @@ withCString name $ \ namePtr -> withModule mdl $ \ mdlPtr -> do rc <- FFI.writeBitcodeToFile mdlPtr namePtr- when (rc /= 0) $+ when (rc /= False) $ ioError $ userError $ "writeBitcodeToFile: return code " ++ show rc return () @@ -118,13 +116,13 @@ alloca $ \ modPtr -> alloca $ \ errStr -> do rrc <- FFI.createMemoryBufferWithContentsOfFile namePtr bufPtr errStr- if rrc /= 0 then do+ if rrc /= False 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 prc /= False then do msg <- peek errStr >>= peekCString ioError $ userError $ "readBitcodeFromFile: parse return code " ++ show prc ++ ", " ++ msg else do@@ -160,11 +158,14 @@ pk <- FFI.getTypeKind p case pk of FFI.VoidTypeKind -> return "()"+ FFI.HalfTypeKind -> return "Half" FFI.FloatTypeKind -> return "Float" FFI.DoubleTypeKind -> return "Double" FFI.X86_FP80TypeKind -> return "X86_FP80" FFI.FP128TypeKind -> return "FP128" FFI.PPC_FP128TypeKind -> return "PPC_FP128"+ FFI.X86_MMXTypeKind -> return "X86_MMX"+ FFI.MetadataTypeKind -> return "Metadata" FFI.LabelTypeKind -> return "Label" FFI.IntegerTypeKind -> do w <- FFI.getIntTypeWidth p; return $ "(IntN " ++ show w ++ ")" FFI.FunctionTypeKind -> do@@ -179,7 +180,6 @@ FFI.StructTypeKind -> return "(Struct ...)" FFI.ArrayTypeKind -> do n <- FFI.getArrayLength p; t <- FFI.getElementType p >>= showType'; return $ "(Array " ++ show n ++ " " ++ t ++ ")" FFI.PointerTypeKind -> do t <- FFI.getElementType p >>= showType'; return $ "(Ptr " ++ t ++ ")"- FFI.OpaqueTypeKind -> return "Opaque" FFI.VectorTypeKind -> do n <- FFI.getVectorSize p; t <- FFI.getElementType p >>= showType'; return $ "(Vector " ++ show n ++ " " ++ t ++ ")" --------------------------------------@@ -274,7 +274,7 @@ constStringInternal :: Bool -> String -> (Value, Int) constStringInternal nulTerm s = unsafePerformIO $ withCStringLen s $ \(sPtr, sLen) ->- return (FFI.constString sPtr (fromIntegral sLen) (fromBool (not nulTerm)), sLen)+ return (FFI.constString sPtr (fromIntegral sLen) (not nulTerm), sLen) constString :: String -> (Value, Int) constString = constStringInternal False@@ -403,14 +403,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 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 Bool+initializeFunctionPassManager pm = withPassManager pm FFI.initializeFunctionPassManager -finalizeFunctionPassManager :: PassManager -> IO Int-finalizeFunctionPassManager pm = liftM fromIntegral $ withPassManager pm FFI.finalizeFunctionPassManager+finalizeFunctionPassManager :: PassManager -> IO Bool+finalizeFunctionPassManager pm = withPassManager pm FFI.finalizeFunctionPassManager -------------------------------------- @@ -432,7 +432,7 @@ constStruct :: [Value] -> Bool -> Value constStruct xs packed = unsafePerformIO $ do withArrayLen xs $ \ len ptr ->- return $ FFI.constStruct ptr (fromIntegral len) (if packed then 1 else 0)+ return $ FFI.constStruct ptr (fromIntegral len) packed -------------------------------------- @@ -443,6 +443,11 @@ str <- peekCString cs if str == "" then return (show a) else return str +setValueNameU :: String -> Value -> IO ()+setValueNameU str a = do+ withCString str $ \ strPtr ->+ FFI.setValueName a strPtr+ getObjList :: (t1 -> (t2 -> IO [Ptr a]) -> t) -> (t2 -> IO (Ptr a)) -> (Ptr a -> IO (Ptr a)) -> t1 -> t getObjList withF firstF nextF obj = do@@ -460,9 +465,7 @@ return $ zip names vs isConstant :: Value -> IO Bool-isConstant v = do- isC <- FFI.isConstant v- if isC == 0 then return False else return True+isConstant = FFI.isConstant isIntrinsic :: Value -> IO Bool isIntrinsic v = do
LLVM/ExecutionEngine.hs view
@@ -16,7 +16,7 @@ getFreePointers, FreePointers, -- * Translation Translatable, Generic,- generateFunction,+ generateFunction, generateFunctionFromRef, -- * Unsafe type conversion Unsafe, unsafePurify,@@ -54,7 +54,10 @@ -- then you should better use 'getPointerToFunction'. generateFunction :: (Translatable f) => Value (Ptr f) -> EngineAccess f-generateFunction (Value f) = do+generateFunction (Value f) = generateFunctionFromRef f++generateFunctionFromRef :: (Translatable f) => ValueRef -> EngineAccess f+generateFunctionFromRef f = do run <- getRunFunction return $ translate run [] f
LLVM/Util/Optimize.hs view
@@ -75,9 +75,7 @@ moduleModified <- FFI.runPassManager passes m - return $- toEnum (fromIntegral moduleModified) ||- toEnum (fromIntegral functionsModified)+ return $ moduleModified || functionsModified -- tools/opt/opt.cpp: AddOptimizationPasses addOptimizationPasses :: FFI.PassManagerRef -> FFI.PassManagerRef -> Int -> IO ()
examples/List.hs view
@@ -4,7 +4,7 @@ import LLVM.Util.Loop (Phi, phis, addPhis, ) import LLVM.ExecutionEngine (simpleFunction, )-import LLVM.Core+import LLVM.Core hiding ( sizeOf ) import qualified System.IO as IO import Data.Word (Word32, )
llvm.cabal view
@@ -1,11 +1,13 @@ name: llvm-version: 3.0.1.0+version: 3.2.0.0 license: BSD3 license-file: LICENSE synopsis: Bindings to the LLVM compiler toolkit. description: High-level bindings to the LLVM compiler toolkit. .+ * New in 3.2.0.0: Builds against LLVM 3.2+ . * New in 3.0.0.0: The low-level bindings have been split into the llvm-base package. .@@ -42,7 +44,7 @@ base >= 3 && < 5, bytestring >= 0.9, directory,- llvm-base >= 3.0.0.1 && < 4,+ llvm-base >= 3.2.0.0 && < 4, mtl, process, type-level,