diff --git a/LLVM/Core.hs b/LLVM/Core.hs index 9e58106..de569b7 100644 --- a/LLVM/Core.hs +++ b/LLVM/Core.hs @@ -34,7 +34,7 @@ module LLVM.Core( ModuleProvider, createModuleProviderForExistingModule, PassManager, createPassManager, createFunctionPassManager, writeBitcodeToFile, readBitcodeFromFile, - getModuleValues, getFunctions, getGlobalVariables, ModuleValue, castModuleValue, + getModuleValues, getFunctions, getGlobalVariables, getGlobalDesc, GlobalDesc(..), Field(..), ModuleValue, castModuleValue, -- * Instructions module LLVM.Core.Instructions, -- * Types classification @@ -70,9 +70,9 @@ module LLVM.Core( getInstructions, getOperands, hasUsers, getUsers, getUses, getUser, isChildOf, getDep, -- * Misc addAttributes, Attribute(..), - castVarArgs, + castVarArgs, isCast, -- * Debugging - dumpValue, dumpType, getValueName, annotateValueList + dumpValue, dumpType, getValueName, getValueNameU, annotateValueList, showTypeOf ) where import qualified LLVM.FFI.Core as FFI import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, constStruct, getModuleValues, valueHasType) diff --git a/LLVM/Core/Instructions.hs b/LLVM/Core/Instructions.hs index fcb98e7..1554119 100644 --- a/LLVM/Core/Instructions.hs +++ b/LLVM/Core/Instructions.hs @@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, TypeSynonymInstances, ScopedTypeVariables, OverlappingInstances, FlexibleContexts, TypeOperators, DeriveDataTypeable, ForeignFunctionInterface #-} module LLVM.Core.Instructions( -- * ADT representation of IR - BinOpDesc(..), InstrDesc(..), ArgDesc(..), getInstrDesc, + BinOpDesc(..), InstrDesc(..), ArgDesc(..), getInstrDesc, isValConvOp, getValConvArg, -- * Terminator instructions ret, condBr, @@ -67,7 +67,7 @@ import Data.Map(fromList, (!)) import Foreign.Ptr (FunPtr, ) import Foreign.C(CInt, CUInt) import Data.TypeLevel((:<:), (:>:), (:==:), (:*), - D0, D1, D2, D3, D4, D5, D6, D7, D8, D9, d1, toNum, Succ) + D0, D1, D2, D3, D4, D5, D6, D7, D8, D9, d1, toNum, Succ) import qualified LLVM.FFI.Core as FFI import LLVM.Core.Data import LLVM.Core.Type @@ -81,40 +81,42 @@ import qualified LLVM.Core.Util as U -- Use Terminate to ensure bb termination (how?) -- more intrinsics are needed to, e.g., create an empty vector -data ArgDesc = AV String | AI Int | AL String | AE +data ArgDesc = AV String | AI Int | AL String | ALO String Int | AF String | AE deriving Eq instance Show ArgDesc where - -- show (AV s) = "V_" ++ s - -- show (AI i) = "I_" ++ show i - -- show (AL l) = "L_" ++ l - show (AV s) = s - show (AI i) = show i - show (AL l) = l - show AE = "voidarg?" + -- show (AV s) = "V_" ++ s + -- show (AI i) = "I_" ++ show i + -- show (AL l) = "L_" ++ l + show (AV s) = s + show (AI i) = show i + show (AL l) = "$L" ++ l + show (ALO l o) = l ++ "+" ++ show o + show (AF f) = f + show AE = "voidarg?" data BinOpDesc = BOAdd | BOAddNuw | BOAddNsw | BOAddNuwNsw | BOFAdd - | BOSub | BOSubNuw | BOSubNsw | BOSubNuwNsw | BOFSub - | BOMul | BOMulNuw | BOMulNsw | BOMulNuwNsw | BOFMul - | BOUDiv | BOSDiv | BOSDivExact | BOFDiv | BOURem | BOSRem | BOFRem - | BOShL | BOLShR | BOAShR | BOAnd | BOOr | BOXor - deriving Show + | BOSub | BOSubNuw | BOSubNsw | BOSubNuwNsw | BOFSub + | BOMul | BOMulNuw | BOMulNsw | BOMulNuwNsw | BOFMul + | BOUDiv | BOSDiv | BOSDivExact | BOFDiv | BOURem | BOSRem | BOFRem + | BOShL | BOLShR | BOAShR | BOAnd | BOOr | BOXor + deriving Show -- FIXME: complete definitions for unimplemented instructions data InstrDesc = - -- terminators - IDRet TypeDesc ArgDesc | IDRetVoid + -- terminators + IDRet TypeDesc ArgDesc | IDRetVoid | IDBrCond ArgDesc ArgDesc ArgDesc | IDBrUncond ArgDesc | IDSwitch [(ArgDesc, ArgDesc)] | IDIndirectBr | IDInvoke - | IDUnwind + | IDResume | IDUnreachable - -- binary operators (including bitwise) + -- binary operators (including bitwise) | IDBinOp BinOpDesc TypeDesc ArgDesc ArgDesc - -- memory access and addressing + -- memory access and addressing | IDAlloca TypeDesc Int Int | IDLoad TypeDesc ArgDesc | IDStore TypeDesc ArgDesc ArgDesc | IDGetElementPtr TypeDesc [ArgDesc] - -- conversion + -- conversion | IDTrunc TypeDesc TypeDesc ArgDesc | IDZExt TypeDesc TypeDesc ArgDesc | IDSExt TypeDesc TypeDesc ArgDesc | IDFPtoUI TypeDesc TypeDesc ArgDesc | IDFPtoSI TypeDesc TypeDesc ArgDesc | IDUItoFP TypeDesc TypeDesc ArgDesc @@ -122,92 +124,152 @@ data InstrDesc = | IDFPTrunc TypeDesc TypeDesc ArgDesc | IDFPExt TypeDesc TypeDesc ArgDesc | IDPtrToInt TypeDesc TypeDesc ArgDesc | IDIntToPtr TypeDesc TypeDesc ArgDesc | IDBitcast TypeDesc TypeDesc ArgDesc - -- other + -- other | IDICmp IntPredicate ArgDesc ArgDesc | IDFCmp FPPredicate ArgDesc ArgDesc | IDPhi TypeDesc [(ArgDesc, ArgDesc)] | IDCall TypeDesc ArgDesc [ArgDesc] | IDSelect TypeDesc ArgDesc ArgDesc | IDUserOp1 | IDUserOp2 | IDVAArg - -- vector operators + -- vector operators | IDExtractElement | IDInsertElement | IDShuffleVector - -- aggregate operators + -- aggregate operators | IDExtractValue | IDInsertValue - -- invalid + -- invalid | IDInvalidOp - deriving Show + deriving Show -- TODO: overflow support for binary operations (add/sub/mul) -getInstrDesc :: FFI.ValueRef -> IO (String, InstrDesc) +getInstrDesc :: FFI.ValueRef -> IO InstrDesc getInstrDesc v = do - valueName <- U.getValueNameU v - opcode <- FFI.instGetOpcode v - t <- FFI.typeOf v >>= typeDesc2 - -- FIXME: sizeof() does not work for types! - --tsize <- FFI.typeOf v -- >>= FFI.sizeOf -- >>= FFI.constIntGetZExtValue >>= return . fromIntegral - tsize <- return 1 - os <- U.getOperands v >>= mapM getArgDesc - os0 <- if length os > 0 then return $ os !! 0 else return AE - os1 <- if length os > 1 then return $ os !! 1 else return AE - t2 <- (if not (null os) && (opcode >= 30 || opcode <= 41) - then U.getOperands v >>= return . snd . head >>= FFI.typeOf >>= typeDesc2 - else return TDVoid) - p <- if opcode `elem` [42, 43] then FFI.cmpInstGetPredicate v else return 0 - let instr = - (if opcode >= 8 && opcode <= 25 -- binary arithmetic - then IDBinOp (getBinOp opcode) t os0 os1 - else if opcode >= 30 && opcode <= 41 -- conversion - then (getConvOp opcode) t2 t os0 - else case opcode of - { 1 -> if null os then IDRetVoid else IDRet t os0; - 2 -> if length os == 1 then IDBrUncond os0 else IDBrCond os0 (os !! 2) os1; - 3 -> IDSwitch $ toPairs os; - -- TODO (can skip for now) - -- 4 -> IndirectBr ; 5 -> Invoke ; - 6 -> IDUnwind; 7 -> IDUnreachable; - 26 -> IDAlloca (getPtrType t) tsize (getImmInt os0); - 27 -> IDLoad t os0; 28 -> IDStore t os0 os1; - 29 -> IDGetElementPtr t os; - 42 -> IDICmp (toIntPredicate p) os0 os1; - 43 -> IDFCmp (toFPPredicate p) os0 os1; - 44 -> IDPhi t $ toPairs os; - -- FIXME: getelementptr arguments are not handled - 45 -> IDCall t (last os) (init os); - 46 -> IDSelect t os0 os1; - -- TODO (can skip for now) - -- 47 -> UserOp1 ; 48 -> UserOp2 ; 49 -> VAArg ; - -- 50 -> ExtractElement ; 51 -> InsertElement ; 52 -> ShuffleVector ; - -- 53 -> ExtractValue ; 54 -> InsertValue ; - _ -> IDInvalidOp }) - return (valueName, instr) - --if instr /= InvalidOp then return instr else fail $ "Invalid opcode: " ++ show opcode - where getBinOp o = fromList [(8, BOAdd), (9, BOFAdd), (10, BOSub), (11, BOFSub), - (12, BOMul), (13, BOFMul), (14, BOUDiv), (15, BOSDiv), - (16, BOFDiv), (17, BOURem), (18, BOSRem), (19, BOFRem), - (20, BOShL), (21, BOLShR), (22, BOAShR), (23, BOAnd), - (24, BOOr), (25, BOXor)] ! o - getConvOp o = fromList [(30, IDTrunc), (31, IDZExt), (32, IDSExt), (33, IDFPtoUI), - (34, IDFPtoSI), (35, IDUItoFP), (36, IDSItoFP), (37, IDFPTrunc), - (38, IDFPExt), (39, IDPtrToInt), (40, IDIntToPtr), (41, IDBitcast)] ! o - toPairs xs = zip (stride 2 xs) (stride 2 (drop 1 xs)) - stride _ [] = [] - stride n (x:xs) = x : stride n (drop (n-1) xs) - getPtrType (TDPtr t) = t - getPtrType _ = TDVoid - getImmInt (AI i) = i - getImmInt _ = 0 + opcode <- FFI.instGetOpcode v + t <- FFI.typeOf v >>= typeDesc2 + -- FIXME: sizeof() does not work for types! + --tsize <- FFI.typeOf v -- >>= FFI.sizeOf -- >>= FFI.constIntGetZExtValue >>= 2return . fromIntegral + tsize <- return 1 + os <- U.getOperands v >>= mapM getArgDesc + os0 <- if length os > 0 then return $ os !! 0 else return AE + os1 <- if length os > 1 then return $ os !! 1 else return AE + t2 <- (if not (null os) && (opcode >= 30 || opcode <= 41) + then U.getOperands v >>= return . snd . head >>= FFI.typeOf >>= typeDesc2 + else return TDVoid) + p <- if opcode `elem` [42, 43] then FFI.cmpInstGetPredicate v else return 0 + let instr = + (if opcode >= 8 && opcode <= 25 -- binary arithmetic + then IDBinOp (getBinOp opcode) t os0 os1 + else if opcode >= 30 && opcode <= 41 -- conversion + then (getConvOp opcode) t2 t os0 + else case opcode of + { 1 -> if null os then IDRetVoid else IDRet t os0; + 2 -> if length os == 1 then IDBrUncond os0 else IDBrCond os0 (os !! 2) os1; + 3 -> IDSwitch $ toPairs os; + -- TODO (can skip for now) + -- 4 -> IndirectBr ; 5 -> Invoke ; + 6 -> IDResume; 7 -> IDUnreachable; + 26 -> IDAlloca (getPtrType t) tsize (getImmInt os0); + 27 -> IDLoad t os0; 28 -> IDStore t os0 os1; + 29 -> IDGetElementPtr t os; + 42 -> IDICmp (toIntPredicate p) os0 os1; + 43 -> IDFCmp (toFPPredicate p) os0 os1; + 44 -> IDPhi t $ toPairs os; + -- FIXME: getelementptr arguments are not handled + 45 -> IDCall t (AF $ fromAV . last $ os) (init os); + 46 -> IDSelect t os0 os1; + -- TODO (can skip for now) + -- 47 -> UserOp1 ; 48 -> UserOp2 ; 49 -> VAArg ; + -- 50 -> ExtractElement ; 51 -> InsertElement ; 52 -> ShuffleVector ; + -- 53 -> ExtractValue ; 54 -> InsertValue ; + _ -> IDInvalidOp }) + return instr + --if instr /= InvalidOp then return instr else fail $ "Invalid opcode: " ++ show opcode + where getBinOp o = fromList [(8, BOAdd), (9, BOFAdd), (10, BOSub), (11, BOFSub), + (12, BOMul), (13, BOFMul), (14, BOUDiv), (15, BOSDiv), + (16, BOFDiv), (17, BOURem), (18, BOSRem), (19, BOFRem), + (20, BOShL), (21, BOLShR), (22, BOAShR), (23, BOAnd), + (24, BOOr), (25, BOXor)] ! o + getConvOp o = fromList [(30, IDTrunc), (31, IDZExt), (32, IDSExt), (33, IDFPtoUI), + (34, IDFPtoSI), (35, IDUItoFP), (36, IDSItoFP), (37, IDFPTrunc), + (38, IDFPExt), (39, IDPtrToInt), (40, IDIntToPtr), (41, IDBitcast)] ! o + toPairs xs = zip (stride 2 xs) (stride 2 (drop 1 xs)) + stride _ [] = [] + stride n (x:xs) = x : stride n (drop (n-1) xs) + getPtrType (TDPtr t) = t + getPtrType _ = TDVoid + getImmInt (AI i) = i + getImmInt _ = 0 + fromAV (AV x) = x + fromAV _ = "" + +isValConvOp :: InstrDesc -> Bool +isValConvOp (IDTrunc _ _ (AV _)) = True +isValConvOp (IDZExt _ _ (AV _)) = True +isValConvOp (IDSExt _ _ (AV _)) = True +isValConvOp (IDFPtoUI _ _ (AV _)) = True +isValConvOp (IDFPtoSI _ _ (AV _)) = True +isValConvOp (IDUItoFP _ _ (AV _)) = True +isValConvOp (IDSItoFP _ _ (AV _)) = True +isValConvOp (IDFPTrunc _ _ (AV _)) = True +isValConvOp (IDFPExt _ _ (AV _)) = True +isValConvOp (IDPtrToInt _ _ (AV _)) = True +isValConvOp (IDIntToPtr _ _ (AV _)) = True +isValConvOp (IDBitcast _ _ (AV _)) = True +isValConvOp _ = False + +getValConvArg :: InstrDesc -> String +getValConvArg (IDTrunc _ _ (AV a)) = a +getValConvArg (IDZExt _ _ (AV a)) = a +getValConvArg (IDSExt _ _ (AV a)) = a +getValConvArg (IDFPtoUI _ _ (AV a)) = a +getValConvArg (IDFPtoSI _ _ (AV a)) = a +getValConvArg (IDUItoFP _ _ (AV a)) = a +getValConvArg (IDSItoFP _ _ (AV a)) = a +getValConvArg (IDFPTrunc _ _ (AV a)) = a +getValConvArg (IDFPExt _ _ (AV a)) = a +getValConvArg (IDPtrToInt _ _ (AV a)) = a +getValConvArg (IDIntToPtr _ _ (AV a)) = a +getValConvArg (IDBitcast _ _ (AV a)) = a +getValConvArg _ = "" -- TODO: fix for non-int constants getArgDesc :: (String, FFI.ValueRef) -> IO ArgDesc getArgDesc (vname, v) = do - isC <- U.isConstant v - t <- FFI.typeOf v >>= typeDesc2 - if isC - then case t of - TDInt _ _ -> do - cV <- FFI.constIntGetSExtValue v - return $ AI $ fromIntegral cV - _ -> return AE - else case t of - TDLabel -> return $ AL vname - _ -> return $ AV vname + isC <- U.isConstant v + isCE <- U.isConstantExpr v + t <- FFI.typeOf v >>= typeDesc2 + if isC + then + if isCE + then do + c <- U.isCast v + g <- U.isStaticGEP v + os <- U.getOperands v + if c + then getArgDesc . head $ os + else if g + then do + offset <- evalStaticGEPOffset 0 $ tail os + return $ ALO vname offset + else return AE -- $ AV vname + else case t of + TDInt _ _ -> do + cV <- FFI.constIntGetSExtValue v + return $ AI $ fromIntegral cV + TDPtr (TDFunction _ _ _) -> return $ AL vname + TDPtr _ -> do + isN <- U.isNull v + if isN then return $ AI 0 else return $ AV vname + _ -> return AE + else case t of + TDLabel -> return $ AL vname + _ -> return $ AV vname + +evalStaticGEPOffset :: Int -> [(String, FFI.ValueRef)] -> IO Int +evalStaticGEPOffset i ((_, o):os) = do + t <- FFI.typeOf o >>= typeDesc2 + case t of + TDInt _ _ -> + do + offset <- FFI.constIntGetSExtValue o >>= return . fromIntegral + evalStaticGEPOffset (i+offset) os + _ -> evalStaticGEPOffset i os +evalStaticGEPOffset i [] = return i -------------------------------------- @@ -219,24 +281,24 @@ terminate = () -- |Acceptable arguments to the 'ret' instruction. class Ret a r where - ret' :: a -> CodeGenFunction r Terminate + ret' :: a -> CodeGenFunction r Terminate -- | Return from the current function with the given value. Use () as the return value for what would be a void function is C. ret :: (Ret a r) => a -> CodeGenFunction r Terminate ret = ret' instance (IsFirstClass a, IsConst a) => Ret a a where - ret' = ret . valueOf + ret' = ret . valueOf instance Ret (Value a) a where - ret' (Value a) = do - withCurrentBuilder_ $ \ bldPtr -> FFI.buildRet bldPtr a - return terminate + ret' (Value a) = do + withCurrentBuilder_ $ \ bldPtr -> FFI.buildRet bldPtr a + return terminate instance Ret () () where - ret' _ = do - withCurrentBuilder_ $ FFI.buildRetVoid - return terminate + ret' _ = do + withCurrentBuilder_ $ FFI.buildRetVoid + return terminate withCurrentBuilder_ :: (FFI.BuilderRef -> IO a) -> CodeGenFunction r () withCurrentBuilder_ p = withCurrentBuilder p >> return () @@ -245,12 +307,12 @@ withCurrentBuilder_ p = withCurrentBuilder p >> return () -- | Branch to the first basic block if the boolean is true, otherwise to the second basic block. condBr :: Value Bool -- ^ Boolean to branch upon. - -> BasicBlock -- ^ Target for true. - -> BasicBlock -- ^ Target for false. - -> CodeGenFunction r Terminate + -> BasicBlock -- ^ Target for true. + -> BasicBlock -- ^ Target for false. + -> CodeGenFunction r Terminate condBr (Value b) (BasicBlock t1) (BasicBlock t2) = do - withCurrentBuilder_ $ \ bldPtr -> FFI.buildCondBr bldPtr b t1 t2 - return terminate + withCurrentBuilder_ $ \ bldPtr -> FFI.buildCondBr bldPtr b t1 t2 + return terminate -------------------------------------- @@ -258,22 +320,22 @@ condBr (Value b) (BasicBlock t1) (BasicBlock t2) = do br :: BasicBlock -- ^ Branch target. -> CodeGenFunction r Terminate br (BasicBlock t) = do - withCurrentBuilder_ $ \ bldPtr -> FFI.buildBr bldPtr t - return terminate + withCurrentBuilder_ $ \ bldPtr -> FFI.buildBr bldPtr t + return terminate -------------------------------------- -- | Branch table instruction. switch :: (IsInteger a) - => Value a -- ^ Value to branch upon. - -> BasicBlock -- ^ Default branch target. - -> [(ConstValue a, BasicBlock)] -- ^ Labels and corresponding branch targets. - -> CodeGenFunction r Terminate + => Value a -- ^ Value to branch upon. + -> BasicBlock -- ^ Default branch target. + -> [(ConstValue a, BasicBlock)] -- ^ Labels and corresponding branch targets. + -> CodeGenFunction r Terminate switch (Value val) (BasicBlock dflt) arms = do - withCurrentBuilder_ $ \ bldPtr -> do - inst <- FFI.buildSwitch bldPtr val dflt (fromIntegral $ length arms) - sequence_ [ FFI.addCase inst c b | (ConstValue c, BasicBlock b) <- arms ] - return terminate + withCurrentBuilder_ $ \ bldPtr -> do + inst <- FFI.buildSwitch bldPtr val dflt (fromIntegral $ length arms) + sequence_ [ FFI.addCase inst c b | (ConstValue c, BasicBlock b) <- arms ] + return terminate -------------------------------------- @@ -288,8 +350,8 @@ switch (Value val) (BasicBlock dflt) arms = do -- |Inform the code generator that this code can never be reached. unreachable :: CodeGenFunction r Terminate unreachable = do - withCurrentBuilder_ FFI.buildUnreachable - return terminate + withCurrentBuilder_ FFI.buildUnreachable + return terminate -------------------------------------- @@ -298,32 +360,32 @@ type FFIConstBinOp = FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef withArithmeticType :: - (IsArithmetic c) => - (ArithmeticType c -> a -> CodeGenFunction r (v c)) -> - (a -> CodeGenFunction r (v c)) + (IsArithmetic c) => + (ArithmeticType c -> a -> CodeGenFunction r (v c)) -> + (a -> CodeGenFunction r (v c)) withArithmeticType f = f arithmeticType -- |Acceptable arguments to arithmetic binary instructions. class ABinOp a b c | a b -> c where - abinop :: FFIConstBinOp -> FFIBinOp -> a -> b -> CodeGenFunction r c + abinop :: FFIConstBinOp -> FFIBinOp -> a -> b -> CodeGenFunction r c add :: (IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) add = - curry $ withArithmeticType $ \typ -> uncurry $ case typ of - IntegerType -> abinop FFI.constAdd FFI.buildAdd - FloatingType -> abinop FFI.constFAdd FFI.buildFAdd + curry $ withArithmeticType $ \typ -> uncurry $ case typ of + IntegerType -> abinop FFI.constAdd FFI.buildAdd + FloatingType -> abinop FFI.constFAdd FFI.buildFAdd sub :: (IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) sub = - curry $ withArithmeticType $ \typ -> uncurry $ case typ of - IntegerType -> abinop FFI.constSub FFI.buildSub - FloatingType -> abinop FFI.constFSub FFI.buildFSub + curry $ withArithmeticType $ \typ -> uncurry $ case typ of + IntegerType -> abinop FFI.constSub FFI.buildSub + FloatingType -> abinop FFI.constFSub FFI.buildFSub mul :: (IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) mul = - curry $ withArithmeticType $ \typ -> uncurry $ case typ of - IntegerType -> abinop FFI.constMul FFI.buildMul - FloatingType -> abinop FFI.constFMul FFI.buildFMul + curry $ withArithmeticType $ \typ -> uncurry $ case typ of + IntegerType -> abinop FFI.constMul FFI.buildMul + FloatingType -> abinop FFI.constFMul FFI.buildFMul iadd :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) iadd = abinop FFI.constAdd FFI.buildAdd @@ -338,16 +400,16 @@ idiv :: a -> b -> CodeGenFunction r (v c) idiv = if isSigned (undefined :: c) - then abinop FFI.constSDiv FFI.buildSDiv - else abinop FFI.constUDiv FFI.buildUDiv + then abinop FFI.constSDiv FFI.buildSDiv + else abinop FFI.constUDiv FFI.buildUDiv -- | signed or unsigned remainder depending on the type irem :: forall a b c r v. (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) irem = if isSigned (undefined :: c) - then abinop FFI.constSRem FFI.buildSRem - else abinop FFI.constURem FFI.buildURem + then abinop FFI.constSRem FFI.buildSRem + else abinop FFI.constURem FFI.buildURem {-# DEPRECATED udiv "use idiv instead" #-} {-# DEPRECATED sdiv "use idiv instead" #-} @@ -390,46 +452,46 @@ xor :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) xor = abinop FFI.constXor FFI.buildXor instance ABinOp (Value a) (Value a) (Value a) where - abinop _ op (Value a1) (Value a2) = buildBinOp op a1 a2 + abinop _ op (Value a1) (Value a2) = buildBinOp op a1 a2 instance ABinOp (ConstValue a) (Value a) (Value a) where - abinop _ op (ConstValue a1) (Value a2) = buildBinOp op a1 a2 + abinop _ op (ConstValue a1) (Value a2) = buildBinOp op a1 a2 instance ABinOp (Value a) (ConstValue a) (Value a) where - abinop _ op (Value a1) (ConstValue a2) = buildBinOp op a1 a2 + abinop _ op (Value a1) (ConstValue a2) = buildBinOp op a1 a2 instance ABinOp (ConstValue a) (ConstValue a) (ConstValue a) where - abinop cop _ (ConstValue a1) (ConstValue a2) = - return $ ConstValue $ cop a1 a2 + abinop cop _ (ConstValue a1) (ConstValue a2) = + return $ ConstValue $ cop a1 a2 instance (IsConst a) => ABinOp (Value a) a (Value a) where - abinop cop op a1 a2 = abinop cop op a1 (constOf a2) + abinop cop op a1 a2 = abinop cop op a1 (constOf a2) instance (IsConst a) => ABinOp a (Value a) (Value a) where - abinop cop op a1 a2 = abinop cop op (constOf a1) a2 + abinop cop op a1 a2 = abinop cop op (constOf a1) a2 --instance (IsConst a) => ABinOp a a (ConstValue a) where -- abinop cop op a1 a2 = abinop cop op (constOf a1) (constOf a2) buildBinOp :: FFIBinOp -> FFI.ValueRef -> FFI.ValueRef -> CodeGenFunction r (Value a) buildBinOp op a1 a2 = - liftM Value $ - withCurrentBuilder $ \ bld -> - U.withEmptyCString $ op bld a1 a2 + liftM Value $ + withCurrentBuilder $ \ bld -> + U.withEmptyCString $ op bld a1 a2 type FFIUnOp = FFI.BuilderRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef buildUnOp :: FFIUnOp -> FFI.ValueRef -> CodeGenFunction r (Value a) buildUnOp op a = - liftM Value $ - withCurrentBuilder $ \ bld -> - U.withEmptyCString $ op bld a + liftM Value $ + withCurrentBuilder $ \ bld -> + U.withEmptyCString $ op bld a neg :: forall r a. (IsArithmetic a) => Value a -> CodeGenFunction r (Value a) neg = - withArithmeticType $ \typ -> case typ of - IntegerType -> \(Value x) -> buildUnOp FFI.buildNeg x - FloatingType -> abinop FFI.constFSub FFI.buildFSub (value zero :: Value a) + withArithmeticType $ \typ -> case typ of + IntegerType -> \(Value x) -> buildUnOp FFI.buildNeg x + FloatingType -> abinop FFI.constFSub FFI.buildFSub (value zero :: Value a) ineg :: (IsInteger a) => Value a -> CodeGenFunction r (Value a) ineg (Value x) = buildUnOp FFI.buildNeg x @@ -447,109 +509,109 @@ inv (Value x) = buildUnOp FFI.buildNot x -- | Get a value from a vector. extractelement :: (Pos n) - => Value (Vector n a) -- ^ Vector - -> Value Word32 -- ^ Index into the vector - -> CodeGenFunction r (Value a) + => Value (Vector n a) -- ^ Vector + -> Value Word32 -- ^ Index into the vector + -> CodeGenFunction r (Value a) extractelement (Value vec) (Value i) = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ FFI.buildExtractElement bldPtr vec i + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildExtractElement bldPtr vec i -- | Insert a value into a vector, nondestructive. insertelement :: (Pos n) - => Value (Vector n a) -- ^ Vector - -> Value a -- ^ Value to insert - -> Value Word32 -- ^ Index into the vector - -> CodeGenFunction r (Value (Vector n a)) + => Value (Vector n a) -- ^ Vector + -> Value a -- ^ Value to insert + -> Value Word32 -- ^ Index into the vector + -> CodeGenFunction r (Value (Vector n a)) insertelement (Value vec) (Value e) (Value i) = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ FFI.buildInsertElement bldPtr vec e i + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildInsertElement bldPtr vec e i -- | Permute vector. shufflevector :: (Pos n, Pos m) - => Value (Vector n a) - -> Value (Vector n a) - -> ConstValue (Vector m Word32) - -> CodeGenFunction r (Value (Vector m a)) + => Value (Vector n a) + -> Value (Vector n a) + -> ConstValue (Vector m Word32) + -> CodeGenFunction r (Value (Vector m a)) shufflevector (Value a) (Value b) (ConstValue mask) = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ FFI.buildShuffleVector bldPtr a b mask + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildShuffleVector bldPtr a b mask -- |Acceptable arguments to 'extractvalue' and 'insertvalue'. class GetValue agg ix el | agg ix -> el where - getIx :: agg -> ix -> CUInt + getIx :: agg -> ix -> CUInt instance (GetField as i a, Nat i) => GetValue (Struct as) i a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n) => GetValue (Array n a) Word32 a where - getIx _ n = fromIntegral n + getIx _ n = fromIntegral n instance (IsFirstClass a, Nat n) => GetValue (Array n a) Word64 a where - getIx _ n = fromIntegral n + getIx _ n = fromIntegral n instance (IsFirstClass a, Nat n, Nat (i1:*i0), (i1:*i0) :<: n) => GetValue (Array n a) (i1:*i0) a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D0 :<: n) => GetValue (Array n a) D0 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D1 :<: n) => GetValue (Array n a) D1 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D2 :<: n) => GetValue (Array n a) D2 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D3 :<: n) => GetValue (Array n a) D3 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D4 :<: n) => GetValue (Array n a) D4 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D5 :<: n) => GetValue (Array n a) D5 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D6 :<: n) => GetValue (Array n a) D6 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D7 :<: n) => GetValue (Array n a) D7 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D8 :<: n) => GetValue (Array n a) D8 a where - getIx _ n = toNum n + getIx _ n = toNum n instance (IsFirstClass a, Nat n, D9 :<: n) => GetValue (Array n a) D9 a where - getIx _ n = toNum n + getIx _ n = toNum n -- | Get a value from an aggregate. extractvalue :: forall r agg i a. - GetValue agg i a - => Value agg -- ^ Aggregate - -> i -- ^ Index into the aggregate - -> CodeGenFunction r (Value a) + GetValue agg i a + => Value agg -- ^ Aggregate + -> i -- ^ Index into the aggregate + -> CodeGenFunction r (Value a) extractvalue (Value agg) i = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ - FFI.buildExtractValue bldPtr agg (getIx (undefined::agg) i) + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildExtractValue bldPtr agg (getIx (undefined::agg) i) -- | Insert a value into an aggregate, nondestructive. insertvalue :: forall r agg i a. - GetValue agg i a - => Value agg -- ^ Aggregate - -> Value a -- ^ Value to insert - -> i -- ^ Index into the aggregate - -> CodeGenFunction r (Value agg) + GetValue agg i a + => Value agg -- ^ Aggregate + -> Value a -- ^ Value to insert + -> i -- ^ Index into the aggregate + -> CodeGenFunction r (Value agg) insertvalue (Value agg) (Value e) i = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ - FFI.buildInsertValue bldPtr agg e (getIx (undefined::agg) i) + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildInsertValue bldPtr agg e (getIx (undefined::agg) i) -------------------------------------- @@ -558,27 +620,27 @@ insertvalue (Value agg) (Value e) i = -- | Truncate a value to a shorter bit width. trunc :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :>: sb) - => Value a -> CodeGenFunction r (Value b) + => Value a -> CodeGenFunction r (Value b) trunc = convert FFI.buildTrunc -- | Zero extend a value to a wider width. zext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb) - => Value a -> CodeGenFunction r (Value b) + => Value a -> CodeGenFunction r (Value b) zext = convert FFI.buildZExt -- | Sign extend a value to wider width. sext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb) - => Value a -> CodeGenFunction r (Value b) + => Value a -> CodeGenFunction r (Value b) sext = convert FFI.buildSExt -- | Truncate a floating point value. fptrunc :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :>: sb) - => Value a -> CodeGenFunction r (Value b) + => Value a -> CodeGenFunction r (Value b) fptrunc = convert FFI.buildFPTrunc -- | Extend a floating point value. fpext :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb) - => Value a -> CodeGenFunction r (Value b) + => Value a -> CodeGenFunction r (Value b) fpext = convert FFI.buildFPExt {-# DEPRECATED fptoui "use fptoint since it is type-safe with respect to signs" #-} @@ -596,8 +658,8 @@ fptosi = convert FFI.buildFPToSI fptoint :: forall r n a b. (IsFloating a, IsInteger b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b) fptoint = if isSigned (undefined :: b) - then convert FFI.buildFPToSI - else convert FFI.buildFPToUI + then convert FFI.buildFPToSI + else convert FFI.buildFPToUI {-# DEPRECATED uitofp "use inttofp since it is type-safe with respect to signs" #-} @@ -615,8 +677,8 @@ sitofp = convert FFI.buildSIToFP inttofp :: forall r n a b. (IsInteger a, IsFloating b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b) inttofp = if isSigned (undefined :: a) - then convert FFI.buildSIToFP - else convert FFI.buildUIToFP + then convert FFI.buildSIToFP + else convert FFI.buildUIToFP -- | Convert a pointer to an integer. @@ -629,68 +691,68 @@ inttoptr = convert FFI.buildIntToPtr -- | Convert between to values of the same size by just copying the bit pattern. bitcast :: (IsFirstClass a, IsFirstClass b, IsSized a sa, IsSized b sb, sa :==: sb) - => Value a -> CodeGenFunction r (Value b) + => Value a -> CodeGenFunction r (Value b) bitcast = convert FFI.buildBitCast -- | Same as bitcast but instead of the '(:==:)' type class it uses type unification. -- This way, properties like reflexivity, symmetry and transitivity -- are obvious to the Haskell compiler. bitcastUnify :: (IsFirstClass a, IsFirstClass b, IsSized a s, IsSized b s) - => Value a -> CodeGenFunction r (Value b) + => Value a -> CodeGenFunction r (Value b) bitcastUnify = convert FFI.buildBitCast type FFIConvert = FFI.BuilderRef -> FFI.ValueRef -> FFI.TypeRef -> U.CString -> IO FFI.ValueRef convert :: forall a b r . (IsType b) => FFIConvert -> Value a -> CodeGenFunction r (Value b) convert conv (Value a) = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ conv bldPtr a (typeRef (undefined :: b)) + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ conv bldPtr a (typeRef (undefined :: b)) -------------------------------------- data CmpPredicate = - CmpEQ -- ^ equal + CmpEQ -- ^ equal | CmpNE -- ^ not equal | CmpGT -- ^ greater than | CmpGE -- ^ greater or equal | CmpLT -- ^ less than | CmpLE -- ^ less or equal - deriving (Eq, Ord, Enum, Show, Typeable) + deriving (Eq, Ord, Enum, Show, Typeable) uintFromCmpPredicate :: CmpPredicate -> IntPredicate uintFromCmpPredicate p = case p of - CmpEQ -> IntEQ - CmpNE -> IntNE - CmpGT -> IntUGT - CmpGE -> IntUGE - CmpLT -> IntULT - CmpLE -> IntULE + CmpEQ -> IntEQ + CmpNE -> IntNE + CmpGT -> IntUGT + CmpGE -> IntUGE + CmpLT -> IntULT + CmpLE -> IntULE sintFromCmpPredicate :: CmpPredicate -> IntPredicate sintFromCmpPredicate p = case p of - CmpEQ -> IntEQ - CmpNE -> IntNE - CmpGT -> IntSGT - CmpGE -> IntSGE - CmpLT -> IntSLT - CmpLE -> IntSLE + CmpEQ -> IntEQ + CmpNE -> IntNE + CmpGT -> IntSGT + CmpGE -> IntSGE + CmpLT -> IntSLT + CmpLE -> IntSLE fpFromCmpPredicate :: CmpPredicate -> FPPredicate fpFromCmpPredicate p = case p of - CmpEQ -> FPOEQ - CmpNE -> FPONE - CmpGT -> FPOGT - CmpGE -> FPOGE - CmpLT -> FPOLT - CmpLE -> FPOLE + CmpEQ -> FPOEQ + CmpNE -> FPONE + CmpGT -> FPOGT + CmpGE -> FPOGE + CmpLT -> FPOLT + CmpLE -> FPOLE data IntPredicate = - IntEQ -- ^ equal + IntEQ -- ^ equal | IntNE -- ^ not equal | IntUGT -- ^ unsigned greater than | IntUGE -- ^ unsigned greater or equal @@ -700,7 +762,7 @@ data IntPredicate = | IntSGE -- ^ signed greater or equal | IntSLT -- ^ signed less than | IntSLE -- ^ signed less or equal - deriving (Eq, Ord, Enum, Show, Typeable) + deriving (Eq, Ord, Enum, Show, Typeable) fromIntPredicate :: IntPredicate -> CInt fromIntPredicate p = fromIntegral (fromEnum p + 32) @@ -709,7 +771,7 @@ toIntPredicate :: Int -> IntPredicate toIntPredicate p = toEnum $ fromIntegral p - 32 data FPPredicate = - FPFalse -- ^ Always false (always folded) + 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 @@ -725,7 +787,7 @@ data FPPredicate = | 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) + deriving (Eq, Ord, Enum, Show, Typeable) fromFPPredicate :: FPPredicate -> CInt fromFPPredicate p = fromIntegral (fromEnum p) @@ -735,19 +797,19 @@ 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) + cmpop :: FFIBinOp -> a -> b -> CodeGenFunction r (Value d) instance CmpOp (Value a) (Value a) a d where - cmpop op (Value a1) (Value a2) = buildBinOp op a1 a2 + cmpop op (Value a1) (Value a2) = buildBinOp op a1 a2 instance (IsConst a) => CmpOp a (Value a) a d where - cmpop op a1 a2 = cmpop op (valueOf a1) a2 + cmpop op a1 a2 = cmpop op (valueOf a1) a2 instance (IsConst a) => CmpOp (Value a) a a d where - cmpop op a1 a2 = cmpop op a1 (valueOf a2) + cmpop op a1 a2 = cmpop op a1 (valueOf a2) class CmpRet c d | c -> d where - cmpBld :: c -> CmpPredicate -> FFIBinOp + cmpBld :: c -> CmpPredicate -> FFIBinOp instance CmpRet Float Bool where cmpBld _ = fcmpBld instance CmpRet Double Bool where cmpBld _ = fcmpBld instance CmpRet FP128 Bool where cmpBld _ = fcmpBld @@ -762,8 +824,8 @@ instance CmpRet Int32 Bool where cmpBld _ = scmpBld instance CmpRet Int64 Bool where cmpBld _ = scmpBld instance CmpRet (Ptr a) Bool where cmpBld _ = ucmpBld instance (CmpRet a b, IsPrimitive a, Pos n) => - CmpRet (Vector n a) (Vector n b) - where cmpBld _ = cmpBld (undefined :: a) + CmpRet (Vector n a) (Vector n b) + where cmpBld _ = cmpBld (undefined :: a) {- | @@ -790,27 +852,27 @@ fcmpBld p = flip FFI.buildFCmp (fromFPPredicate (fpFromCmpPredicate p)) _ucmp :: (IsInteger c, CmpOp a b c d, CmpRet c d) => - CmpPredicate -> a -> b -> CodeGenFunction r (Value d) + CmpPredicate -> a -> b -> CodeGenFunction r (Value d) _ucmp p = cmpop (flip FFI.buildICmp (fromIntPredicate (uintFromCmpPredicate p))) _scmp :: (IsInteger c, CmpOp a b c d, CmpRet c d) => - CmpPredicate -> a -> b -> CodeGenFunction r (Value d) + CmpPredicate -> a -> b -> CodeGenFunction r (Value d) _scmp p = cmpop (flip FFI.buildICmp (fromIntPredicate (sintFromCmpPredicate p))) pcmp :: (CmpOp a b (Ptr c) d, CmpRet (Ptr c) d) => - IntPredicate -> a -> b -> CodeGenFunction r (Value d) + IntPredicate -> a -> b -> CodeGenFunction r (Value d) pcmp p = cmpop (flip FFI.buildICmp (fromIntPredicate p)) {-# DEPRECATED icmp "use cmp or pcmp instead" #-} -- | Compare integers. icmp :: (IsIntegerOrPointer c, CmpOp a b c d, CmpRet c d) => - IntPredicate -> a -> b -> CodeGenFunction r (Value d) + IntPredicate -> a -> b -> CodeGenFunction r (Value d) icmp p = cmpop (flip FFI.buildICmp (fromIntPredicate p)) -- | Compare floating point values. fcmp :: (IsFloating c, CmpOp a b c d, CmpRet c d) => - FPPredicate -> a -> b -> CodeGenFunction r (Value d) + FPPredicate -> a -> b -> CodeGenFunction r (Value d) fcmp p = cmpop (flip FFI.buildFCmp (fromFPPredicate p)) -------------------------------------- @@ -819,10 +881,10 @@ fcmp p = cmpop (flip FFI.buildFCmp (fromFPPredicate p)) -- | Select between two values depending on a boolean. select :: (IsFirstClass a, CmpRet a b) => Value b -> Value a -> Value a -> CodeGenFunction r (Value a) select (Value cnd) (Value thn) (Value els) = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ - FFI.buildSelect bldPtr cnd thn els + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildSelect bldPtr cnd thn els -------------------------------------- @@ -830,21 +892,21 @@ type Caller = FFI.BuilderRef -> [FFI.ValueRef] -> IO FFI.ValueRef -- |Acceptable arguments to 'call'. class CallArgs f g r | g -> r f, f r -> g where - doCall :: Caller -> [FFI.ValueRef] -> f -> g + doCall :: Caller -> [FFI.ValueRef] -> f -> g instance (CallArgs b b' r) => CallArgs (a -> b) (Value a -> b') r where - doCall mkCall args f (Value arg) = doCall mkCall (arg : args) (f (undefined :: a)) + doCall mkCall args f (Value arg) = doCall mkCall (arg : args) (f (undefined :: a)) --instance (CallArgs b b') => CallArgs (a -> b) (ConstValue a -> b') where -- doCall mkCall args f (ConstValue arg) = doCall mkCall (arg : args) (f (undefined :: a)) instance CallArgs (IO a) (CodeGenFunction r (Value a)) r where - doCall = doCallDef + doCall = doCallDef doCallDef :: Caller -> [FFI.ValueRef] -> b -> CodeGenFunction r (Value a) doCallDef mkCall args _ = - withCurrentBuilder $ \ bld -> - liftM Value $ mkCall bld (reverse args) + withCurrentBuilder $ \ bld -> + liftM Value $ mkCall bld (reverse args) -- | Call a function with the given arguments. The 'call' instruction is variadic, i.e., the number of arguments -- it takes depends on the type of /f/. @@ -853,12 +915,12 @@ call (Value f) = doCall (U.makeCall f) [] (undefined :: f) -- | Call a function with exception handling. invoke :: (CallArgs f g r) - => BasicBlock -- ^Normal return point. - -> BasicBlock -- ^Exception return point. - -> Function f -- ^Function to call. - -> g + => BasicBlock -- ^Normal return point. + -> BasicBlock -- ^Exception return point. + -> Function f -- ^Function to call. + -> g invoke (BasicBlock norm) (BasicBlock expt) (Value f) = - doCall (U.makeInvoke norm expt f) [] (undefined :: f) + doCall (U.makeInvoke norm expt f) [] (undefined :: f) -- | Call a function with the given arguments. The 'call' instruction -- is variadic, i.e., the number of arguments it takes depends on the @@ -876,13 +938,13 @@ callWithConv cc (Value f) = doCall (U.makeCallWithCc cc f) [] (undefined :: f) -- /instruction/ and the function being /called/ are different, undefined -- behavior results. invokeWithConv :: (CallArgs f g r) - => FFI.CallingConvention -- ^Calling convention - -> BasicBlock -- ^Normal return point. - -> BasicBlock -- ^Exception return point. - -> Function f -- ^Function to call. - -> g + => FFI.CallingConvention -- ^Calling convention + -> BasicBlock -- ^Normal return point. + -> BasicBlock -- ^Exception return point. + -> Function f -- ^Function to call. + -> g invokeWithConv cc (BasicBlock norm) (BasicBlock expt) (Value f) = - doCall (U.makeInvokeWithCc cc norm expt f) [] (undefined :: f) + doCall (U.makeInvokeWithCc cc norm expt f) [] (undefined :: f) -------------------------------------- @@ -891,34 +953,34 @@ invokeWithConv cc (BasicBlock norm) (BasicBlock expt) (Value f) = -- All of the variables in the list are joined. See also 'addPhiInputs'. phi :: forall a r . (IsFirstClass a) => [(Value a, BasicBlock)] -> CodeGenFunction r (Value a) phi incoming = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> do - inst <- U.buildEmptyPhi bldPtr (typeRef (undefined :: a)) - U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ] - return inst + liftM Value $ + withCurrentBuilder $ \ bldPtr -> do + inst <- U.buildEmptyPhi bldPtr (typeRef (undefined :: a)) + U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ] + return inst -- |Add additional inputs to an existing phi node. -- The reason for this instruction is that sometimes the structure of the code -- makes it impossible to have all variables in scope at the point where you need the phi node. addPhiInputs :: forall a r . (IsFirstClass a) - => Value a -- ^Must be a variable from a call to 'phi'. - -> [(Value a, BasicBlock)] -- ^Variables to add. - -> CodeGenFunction r () + => Value a -- ^Must be a variable from a call to 'phi'. + -> [(Value a, BasicBlock)] -- ^Variables to add. + -> CodeGenFunction r () addPhiInputs (Value inst) incoming = - liftIO $ U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ] + liftIO $ U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ] -------------------------------------- -- | Acceptable argument to array memory allocation. class AllocArg a where - getAllocArg :: a -> Value Word32 + getAllocArg :: a -> Value Word32 instance AllocArg (Value Word32) where - getAllocArg = id + getAllocArg = id instance AllocArg (ConstValue Word32) where - getAllocArg = value + getAllocArg = value instance AllocArg Word32 where - getAllocArg = valueOf + getAllocArg = valueOf -- could be moved to Util.Memory -- FFI.buildMalloc deprecated since LLVM-2.7 @@ -955,11 +1017,11 @@ One possible way is to write a getelementptr expression containing a nullptr in a way that hides the constant nature of nullptr. - ptr <- alloca - store (value zero) ptr - z <- load ptr - size <- bitcastUnify =<< - getElementPtr (z :: Value (Ptr a)) (getAllocArg s, ()) + ptr <- alloca + store (value zero) ptr + z <- load ptr + size <- bitcastUnify =<< + getElementPtr (z :: Value (Ptr a)) (getAllocArg s, ()) However, I found that bitcast on pointers causes no problems. Thus I switched to using pointers for size quantities. @@ -969,46 +1031,46 @@ This still allows for optimizations involving pointers. -- XXX What's the type returned by arrayMalloc? -- | Allocate heap (array) memory. arrayMalloc :: forall a n r s . (IsSized a n, AllocArg s) => - s -> CodeGenFunction r (Value (Ptr a)) -- XXX + s -> CodeGenFunction r (Value (Ptr a)) -- XXX arrayMalloc s = do - func <- staticFunction alignedMalloc + func <- staticFunction alignedMalloc -- func <- externFunction "malloc" - size <- sizeOfArray (undefined :: a) (getAllocArg s) - alignment <- alignOf (undefined :: a) - bitcastUnify =<< - call - (func :: Function (Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8))) - size - alignment + size <- sizeOfArray (undefined :: a) (getAllocArg s) + alignment <- alignOf (undefined :: a) + bitcastUnify =<< + call + (func :: Function (Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8))) + size + alignment -- XXX What's the type returned by malloc -- | Allocate stack memory. alloca :: forall a r s . (IsSized a s) => CodeGenFunction r (Value (Ptr a)) alloca = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ FFI.buildAlloca bldPtr (typeRef (undefined :: a)) + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildAlloca bldPtr (typeRef (undefined :: a)) -- XXX What's the type returned by arrayAlloca? -- | Allocate stack (array) memory. arrayAlloca :: forall a n r s . (IsSized a n, AllocArg s) => - s -> CodeGenFunction r (Value (Ptr a)) + s -> CodeGenFunction r (Value (Ptr a)) arrayAlloca s = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ - FFI.buildArrayAlloca bldPtr (typeRef (undefined :: a)) (case getAllocArg s of Value v -> v) + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildArrayAlloca bldPtr (typeRef (undefined :: a)) (case getAllocArg s of Value v -> v) -- FFI.buildFree deprecated since LLVM-2.7 -- XXX What's the type of free? -- | Free heap memory. free :: (IsType a) => Value (Ptr a) -> CodeGenFunction r () free ptr = do - func <- staticFunction alignedFree + func <- staticFunction alignedFree -- func <- externFunction "free" - _ <- call (func :: Function (Ptr Word8 -> IO ())) =<< bitcastUnify ptr - return () + _ <- call (func :: Function (Ptr Word8 -> IO ())) =<< bitcastUnify ptr + return () -- | If we want to export that, then we should have a Size type @@ -1016,125 +1078,125 @@ free ptr = do -- but it suffers from the ptrtoint(gep) bug. _sizeOf :: forall a r s . (IsSized a s) => a -> CodeGenFunction r (Value Word64) _sizeOf a = - liftIO $ liftM Value $ - FFI.sizeOf (typeRef a) + liftIO $ liftM Value $ + FFI.sizeOf (typeRef a) _alignOf :: forall a r s . (IsSized a s) => a -> CodeGenFunction r (Value Word64) _alignOf a = - liftIO $ liftM Value $ - FFI.alignOf (typeRef a) + liftIO $ liftM Value $ + FFI.alignOf (typeRef a) -- Here are reimplementation from Constants.cpp that avoid the ptrtoint(gep) bug #8281. -- see ConstantExpr::getSizeOf sizeOfArray :: forall a r s . (IsSized a s) => a -> Value Word32 -> CodeGenFunction r (Value (Ptr Word8)) sizeOfArray _ len = - bitcastUnify =<< - getElementPtr (value zero :: Value (Ptr a)) (len, ()) + bitcastUnify =<< + getElementPtr (value zero :: Value (Ptr a)) (len, ()) -- see ConstantExpr::getAlignOf alignOf :: forall a r s . (IsSized a s) => a -> CodeGenFunction r (Value (Ptr Word8)) alignOf _ = - bitcastUnify =<< - getElementPtr0 (value zero :: Value (Ptr (Struct (Bool, (a, ()))))) (d1, ()) + bitcastUnify =<< + getElementPtr0 (value zero :: Value (Ptr (Struct (Bool, (a, ()))))) (d1, ()) -- | Load a value from memory. load :: Value (Ptr a) -- ^ Address to load from. - -> CodeGenFunction r (Value a) + -> CodeGenFunction r (Value a) load (Value p) = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withEmptyCString $ FFI.buildLoad bldPtr p + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildLoad bldPtr p -- | Store a value in memory store :: Value a -- ^ Value to store. - -> Value (Ptr a) -- ^ Address to store to. - -> CodeGenFunction r () + -> Value (Ptr a) -- ^ Address to store to. + -> CodeGenFunction r () store (Value v) (Value p) = do - withCurrentBuilder_ $ \ bldPtr -> - FFI.buildStore bldPtr v p - return () + withCurrentBuilder_ $ \ bldPtr -> + FFI.buildStore bldPtr v p + return () {- -- XXX type is wrong -- | Address arithmetic. See LLVM description. -- (The type isn't as accurate as it should be.) getElementPtr :: (IsInteger i) => - Value (Ptr a) -> [Value i] -> CodeGenFunction r (Value (Ptr b)) + Value (Ptr a) -> [Value i] -> CodeGenFunction r (Value (Ptr b)) getElementPtr (Value ptr) ixs = - liftM Value $ - withCurrentBuilder $ \ bldPtr -> - U.withArrayLen [ v | Value v <- ixs ] $ \ idxLen idxPtr -> - U.withEmptyCString $ - FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen) + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withArrayLen [ v | Value v <- ixs ] $ \ idxLen idxPtr -> + U.withEmptyCString $ + FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen) -} -- |Acceptable arguments to 'getElementPointer'. class GetElementPtr optr ixs nptr | optr ixs -> nptr {-, ixs nptr -> optr, nptr optr -> ixs-} where - getIxList :: optr -> ixs -> [FFI.ValueRef] + getIxList :: optr -> ixs -> [FFI.ValueRef] -- |Acceptable single index to 'getElementPointer'. class IsIndexArg a where - getArg :: a -> FFI.ValueRef + getArg :: a -> FFI.ValueRef instance IsIndexArg (Value Word32) where - getArg (Value v) = v + getArg (Value v) = v instance IsIndexArg (Value Word64) where - getArg (Value v) = v + getArg (Value v) = v instance IsIndexArg (Value Int32) where - getArg (Value v) = v + getArg (Value v) = v instance IsIndexArg (Value Int64) where - getArg (Value v) = v + getArg (Value v) = v instance IsIndexArg (ConstValue Word32) where - getArg = unConst + getArg = unConst instance IsIndexArg (ConstValue Word64) where - getArg = unConst + getArg = unConst instance IsIndexArg (ConstValue Int32) where - getArg = unConst + getArg = unConst instance IsIndexArg (ConstValue Int64) where - getArg = unConst + getArg = unConst instance IsIndexArg Word32 where - getArg = unConst . constOf + getArg = unConst . constOf instance IsIndexArg Word64 where - getArg = unConst . constOf + getArg = unConst . constOf instance IsIndexArg Int32 where - getArg = unConst . constOf + getArg = unConst . constOf instance IsIndexArg Int64 where - getArg = unConst . constOf + getArg = unConst . constOf unConst :: ConstValue a -> FFI.ValueRef unConst (ConstValue v) = v -- End of indexing instance GetElementPtr a () a where - getIxList _ () = [] + getIxList _ () = [] -- Index in Array instance (GetElementPtr o i n, IsIndexArg a, Nat k) => GetElementPtr (Array k o) (a, i) n where - getIxList _ (v, i) = getArg v : getIxList (undefined :: o) i + getIxList _ (v, i) = getArg v : getIxList (undefined :: o) i -- Index in Vector instance (GetElementPtr o i n, IsIndexArg a, Pos k) => GetElementPtr (Vector k o) (a, i) n where - getIxList _ (v, i) = getArg v : getIxList (undefined :: o) i + getIxList _ (v, i) = getArg v : getIxList (undefined :: o) i -- Index in Struct and PackedStruct. -- The index has to be a type level integer to statically determine the record field type instance (GetElementPtr o i n, GetField fs a o, Nat a) => GetElementPtr (Struct fs) (a, i) n where - getIxList _ (v, i) = unConst (constOf (toNum v :: Word32)) : getIxList (undefined :: o) i + getIxList _ (v, i) = unConst (constOf (toNum v :: Word32)) : getIxList (undefined :: o) i instance (GetElementPtr o i n, GetField fs a o, Nat a) => GetElementPtr (PackedStruct fs) (a, i) n where - getIxList _ (v, i) = unConst (constOf (toNum v :: Word32)) : getIxList (undefined :: o) i + getIxList _ (v, i) = unConst (constOf (toNum v :: Word32)) : getIxList (undefined :: o) i class GetField as i a | as i -> a instance GetField (a, as) D0 a @@ -1144,20 +1206,20 @@ instance (GetField as i b, Succ i i') => GetField (a, as) i' b -- The index is a nested tuple of the form @(i1,(i2,( ... ())))@. -- (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)) + Value (Ptr o) -> (a, i) -> CodeGenFunction r (Value (Ptr n)) getElementPtr (Value ptr) (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) + 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) -- | 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 -- its actual value. This first indexing is often with 0. getElementPtr0 :: (GetElementPtr o i n) => - Value (Ptr o) -> i -> CodeGenFunction r (Value (Ptr n)) + Value (Ptr o) -> i -> CodeGenFunction r (Value (Ptr n)) getElementPtr0 p i = getElementPtr p (0::Word32, i) -------------------------------------- @@ -1167,32 +1229,32 @@ instance (IsConst a) => Eq (ConstValue a) {- instance (IsConst a) => Eq (ConstValue a) where - ConstValue x == ConstValue y = - if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOEQ) x y) - else ConstValue (FFI.constICmp (fromIntPredicate IntEQ) x y) - ConstValue x /= ConstValue y = - if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPONE) x y) - else ConstValue (FFI.constICmp (fromIntPredicate IntNE) x y) + ConstValue x == ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOEQ) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntEQ) x y) + ConstValue x /= ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPONE) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntNE) x y) instance (IsConst a) => Ord (ConstValue a) where - ConstValue x < ConstValue y = - if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOLT) x y) - else ConstValue (FFI.constICmp (fromIntPredicate IntLT) x y) - ConstValue x <= ConstValue y = - if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOLE) x y) - else ConstValue (FFI.constICmp (fromIntPredicate IntLE) x y) - ConstValue x > ConstValue y = - if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOGT) x y) - else ConstValue (FFI.constICmp (fromIntPredicate IntGT) x y) - ConstValue x >= ConstValue y = - if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOGE) x y) - else ConstValue (FFI.constICmp (fromIntPredicate IntGE) x y) + ConstValue x < ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOLT) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntLT) x y) + ConstValue x <= ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOLE) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntLE) x y) + ConstValue x > ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOGT) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntGT) x y) + ConstValue x >= ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOGE) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntGE) x y) -} instance (Num a, IsConst a) => Num (ConstValue a) where - ConstValue x + ConstValue y = ConstValue (FFI.constAdd x y) - ConstValue x - ConstValue y = ConstValue (FFI.constSub x y) - ConstValue x * ConstValue y = ConstValue (FFI.constMul x y) - negate (ConstValue x) = ConstValue (FFI.constNeg x) - fromInteger x = constOf (fromInteger x :: a) + ConstValue x + ConstValue y = ConstValue (FFI.constAdd x y) + ConstValue x - ConstValue y = ConstValue (FFI.constSub x y) + ConstValue x * ConstValue y = ConstValue (FFI.constMul x y) + negate (ConstValue x) = ConstValue (FFI.constNeg x) + fromInteger x = constOf (fromInteger x :: a) -} diff --git a/LLVM/Core/Util.hs b/LLVM/Core/Util.hs index 63a79d1..3ebef45 100644 --- a/LLVM/Core/Util.hs +++ b/LLVM/Core/Util.hs @@ -2,7 +2,7 @@ module LLVM.Core.Util( -- * Module handling Module(..), withModule, createModule, destroyModule, writeBitcodeToFile, readBitcodeFromFile, - getModuleValues, getFunctions, getGlobalVariables, valueHasType, + getModuleValues, getFunctions, getGlobalVariables, getGlobalDesc, GlobalDesc(..), Field(..), valueHasType, -- * Module provider handling ModuleProvider(..), withModuleProvider, createModuleProviderForExistingModule, -- * Pass manager handling @@ -32,6 +32,7 @@ module LLVM.Core.Util( withEmptyCString, functionType, buildEmptyPhi, addPhiIns, showTypeOf, getValueNameU, getObjList, annotateValueList, isConstant, + isConstantExpr, isCast, isStaticGEP, isZeroInitialized, isNull, -- * Transformation passes addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass, addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass, @@ -62,7 +63,7 @@ functionType :: Bool -> Type -> [Type] -> Type functionType varargs retType paramTypes = unsafePerformIO $ withArrayLen paramTypes $ \ len ptr -> return $ FFI.functionType retType ptr (fromIntegral len) - (fromBool varargs) + (fromBool varargs) -- unsafePerformIO just to wrap the non-effecting withArrayLen call structType :: [Type] -> Bool -> Type @@ -124,7 +125,7 @@ readBitcodeFromFile name = else do buf <- peek bufPtr prc <- FFI.parseBitcode buf modPtr errStr - if prc /= 0 then do + if prc /= 0 then do msg <- peek errStr >>= peekCString ioError $ userError $ "readBitcodeFromFile: parse return code " ++ show prc ++ ", " ++ msg else do @@ -146,6 +147,45 @@ getFunctions mdl = getObjList withModule FFI.getFirstFunction FFI.getNextFunctio getGlobalVariables :: Module -> IO [(String, Value)] getGlobalVariables mdl = getObjList withModule FFI.getFirstGlobal FFI.getNextGlobal mdl >>= annotateValueList +type Name = String +data GlobalDesc = Constant Name Field | Collection Name [GlobalDesc] + | Zeroes Name Int | Ascii Name String +data Field = Byte Int | Half Int | Word Int | Undef + +getGlobalDesc :: String -> Value -> IO GlobalDesc +getGlobalDesc gname v = do + t <- FFI.typeOf v + tk <- FFI.getTypeKind t + case tk of + FFI.ArrayTypeKind -> do + isZ <- isZeroInitialized v + isS <- isCString v + n <- FFI.getArrayLength t + if isZ + then return $ Zeroes gname $ fromIntegral n + else if isS + then do + s <- getAsCString v + return $ Ascii gname s + else do + e <- getOperands v + e' <- mapM ((getGlobalDesc "") . snd) e + return $ Collection gname e' + FFI.StructTypeKind -> do + e <- getOperands v + e' <- mapM ((getGlobalDesc "") . snd) e + return $ Collection gname e' + FFI.IntegerTypeKind -> do + w <- FFI.getIntTypeWidth t + vv <- FFI.constIntGetSExtValue v + return $ Constant gname $ case w of + 8 -> Byte $ fromIntegral vv + 16 -> Half $ fromIntegral vv + 32 -> Word $ fromIntegral vv + _ -> Undef + _ -> return $ Constant gname Undef +-- return $ Constant gname $ Word 0 + -- This is safe because we just ask for the type of a value. valueHasType :: Value -> Type -> Bool valueHasType v t = unsafePerformIO $ do @@ -160,27 +200,27 @@ showType' p = do pk <- FFI.getTypeKind p case pk of FFI.VoidTypeKind -> return "()" - 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.LabelTypeKind -> return "Label" - FFI.IntegerTypeKind -> do w <- FFI.getIntTypeWidth p; return $ "(IntN " ++ show w ++ ")" - FFI.FunctionTypeKind -> do + 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.LabelTypeKind -> return "Label" + FFI.IntegerTypeKind -> do w <- FFI.getIntTypeWidth p; return $ "(IntN " ++ show w ++ ")" + FFI.FunctionTypeKind -> do r <- FFI.getReturnType p - c <- FFI.countParamTypes p - let n = fromIntegral c - as <- allocaArray n $ \ args -> do - FFI.getParamTypes p args - peekArray n args - ts <- mapM showType' (as ++ [r]) - return $ "(" ++ intercalate " -> " ts ++ ")" - 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 ++ ")" + c <- FFI.countParamTypes p + let n = fromIntegral c + as <- allocaArray n $ \ args -> do + FFI.getParamTypes p args + peekArray n args + ts <- mapM showType' (as ++ [r]) + return $ "(" ++ intercalate " -> " ts ++ ")" + 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 ++ ")" -------------------------------------- -- Handle module providers @@ -441,13 +481,16 @@ getValueNameU a = do -- sometimes void values need explicit names too cs <- FFI.getValueName a str <- peekCString cs - if str == "" then return (show a) else return str + if str == "" then (if (head . show $ a) `elem` "" + then return ("v" ++ show a) + else return $ show a) + else return str getObjList :: (t1 -> (t2 -> IO [Ptr a]) -> t) -> (t2 -> IO (Ptr a)) -> (Ptr a -> IO (Ptr a)) -> t1 -> t getObjList withF firstF nextF obj = do withF obj $ \ objPtr -> do - ofst <- firstF objPtr + ofst <- firstF objPtr let oloop p = if p == nullPtr then return [] else do n <- nextF p ps <- oloop n @@ -464,10 +507,51 @@ isConstant v = do isC <- FFI.isConstant v if isC == 0 then return False else return True +isConstantExpr :: Value -> IO Bool +isConstantExpr v = do + isCE <- FFI.isConstantExpr v + if isCE == 0 then return False else return True + +isCast :: Value -> IO Bool +isCast v = do + isCE <- FFI.isConstantExpr v + if isCE == 0 then return False else do + i <- FFI.isCast v + if i == 0 then return False else return True + +isStaticGEP :: Value -> IO Bool +isStaticGEP v = do + isCE <- FFI.isConstantExpr v + if isCE == 0 then return False else do + i <- FFI.isStaticGEP v + if i == 0 then return False else return True + isIntrinsic :: Value -> IO Bool isIntrinsic v = do if FFI.getIntrinsicID v == 0 then return True else return False +isZeroInitialized :: Value -> IO Bool +isZeroInitialized v = do + isZ <- FFI.isZeroInitialized v + if isZ == 0 then return False else return True + +isNull :: Value -> IO Bool +isNull v = do + isN <- FFI.isNull v + if isN == 0 then return False else return True + +isCString :: Value -> IO Bool +isCString v = do + isS <- FFI.isCString v + if isS == 0 then return False else return True + +getAsCString :: Value -> IO String +getAsCString a = do + -- sometimes void values need explicit names too + cs <- FFI.getAsCString a + str <- peekCString cs + if str == "" then return (show a) else return str + -------------------------------------- type Use = FFI.UseRef @@ -493,6 +577,6 @@ isChildOf bb v = do getDep :: Use -> IO (String, String) getDep u = do - producer <- FFI.getUsedValue u >>= getValueNameU - consumer <- FFI.getUser u >>= getValueNameU - return (producer, consumer) + def <- FFI.getUsedValue u >>= getValueNameU + use <- FFI.getUser u >>= getValueNameU + return (def, use) diff --git a/base/LLVM/FFI/Core.hsc b/base/LLVM/FFI/Core.hsc index f9f926c..2caddeb 100644 --- a/base/LLVM/FFI/Core.hsc +++ b/base/LLVM/FFI/Core.hsc @@ -114,8 +114,14 @@ module LLVM.FFI.Core , constAllOnes , getUndef , isConstant + , isConstantExpr + , isCast + , isStaticGEP + , isZeroInitialized + , isCString , isNull , isUndef + , getAsCString -- ** Global variables, functions, and aliases (globals) , Linkage(..) @@ -500,51 +506,51 @@ module LLVM.FFI.Core , constIntGetZExtValue -- , constUnion - , contextCreate + , contextCreate -- , countUnionElementTypes - , createFunctionPassManagerForModule - , getAttribute - , getCurrentDebugLocation - , getFunctionAttr - , getGlobalContext - , getMDKindID - , getMDKindIDInContext - , getMetadata - , getOperand - , getNumOperands + , createFunctionPassManagerForModule + , getAttribute + , getCurrentDebugLocation + , getFunctionAttr + , getGlobalContext + , getMDKindID + , getMDKindIDInContext + , getMetadata + , getOperand + , getNumOperands -- , getUnionElementTypes - , hasMetadata - , insertIntoBuilder - , mDNode - , mDNodeInContext - , mDString - , mDStringInContext - , replaceAllUsesWith - , setCurrentDebugLocation - , setInstDebugLocation - , setMetadata + , hasMetadata + , insertIntoBuilder + , mDNode + , mDNodeInContext + , mDString + , mDStringInContext + , replaceAllUsesWith + , setCurrentDebugLocation + , setInstDebugLocation + , setMetadata -- , unionType -- , unionTypeInContext - -- ** Build instruction from opcode - , buildBinOp - , getConstOpcode - - , buildCast - , buildExtractValue - , buildInsertValue - - -- ** Use - , OpaqueUse - , UseRef - , getFirstUse - , getNextUse - , getNumUses - , getUsedValue - , getUser - , isUsedInBasicBlock - - ) where + -- ** Build instruction from opcode + , buildBinOp + , getConstOpcode + + , buildCast + , buildExtractValue + , buildInsertValue + + -- ** Use + , OpaqueUse + , UseRef + , getFirstUse + , getNextUse + , getNumUses + , getUsedValue + , getUser + , isUsedInBasicBlock + + ) where import Data.Typeable(Typeable) import Foreign.C.String (CString) #if __GLASGOW_HASKELL__ >= 704 @@ -557,39 +563,39 @@ import Foreign.Ptr (Ptr, FunPtr) #include data Module - deriving (Typeable) + deriving (Typeable) type ModuleRef = Ptr Module foreign import ccall unsafe "LLVMModuleCreateWithName" moduleCreateWithName - :: CString -> IO ModuleRef + :: CString -> IO ModuleRef foreign import ccall unsafe "LLVMDisposeModule" disposeModule - :: ModuleRef -> IO () + :: ModuleRef -> IO () foreign import ccall unsafe "&LLVMDisposeModule" ptrDisposeModule - :: FunPtr (ModuleRef -> IO ()) + :: FunPtr (ModuleRef -> IO ()) foreign import ccall unsafe "LLVMGetDataLayout" getDataLayout - :: ModuleRef -> IO CString + :: ModuleRef -> IO CString foreign import ccall unsafe "LLVMSetDataLayout" setDataLayout - :: ModuleRef -> CString -> IO () + :: ModuleRef -> CString -> IO () data ModuleProvider - deriving (Typeable) + deriving (Typeable) type ModuleProviderRef = Ptr ModuleProvider foreign import ccall unsafe "LLVMCreateModuleProviderForExistingModule" - createModuleProviderForExistingModule - :: ModuleRef -> IO ModuleProviderRef + createModuleProviderForExistingModule + :: ModuleRef -> IO ModuleProviderRef foreign import ccall unsafe "&LLVMDisposeModuleProvider" ptrDisposeModuleProvider - :: FunPtr (ModuleProviderRef -> IO ()) + :: FunPtr (ModuleProviderRef -> IO ()) data Type - deriving (Typeable) + deriving (Typeable) type TypeRef = Ptr Type foreign import ccall unsafe "LLVMInt1Type" int1Type :: TypeRef @@ -604,8 +610,8 @@ foreign import ccall unsafe "LLVMInt64Type" int64Type :: TypeRef -- | An integer type of the given width. foreign import ccall unsafe "LLVMIntType" integerType - :: CUInt -- ^ width in bits - -> TypeRef + :: CUInt -- ^ width in bits + -> TypeRef foreign import ccall unsafe "LLVMFloatType" floatType :: TypeRef @@ -621,43 +627,43 @@ foreign import ccall unsafe "LLVMVoidType" voidType :: TypeRef -- | Create a function type. foreign import ccall unsafe "LLVMFunctionType" functionType - :: TypeRef -- ^ return type - -> Ptr TypeRef -- ^ array of argument types - -> CUInt -- ^ number of elements in array - -> CInt -- ^ non-zero if function is varargs - -> TypeRef + :: TypeRef -- ^ return type + -> Ptr TypeRef -- ^ array of argument types + -> CUInt -- ^ number of elements in array + -> CInt -- ^ non-zero if function is varargs + -> TypeRef -- | Indicate whether a function takes varargs. foreign import ccall unsafe "LLVMIsFunctionVarArg" isFunctionVarArg - :: TypeRef -> IO CInt + :: TypeRef -> IO CInt -- | Give a function's return type. foreign import ccall unsafe "LLVMGetReturnType" getReturnType - :: TypeRef -> IO TypeRef + :: TypeRef -> IO TypeRef -- | Give the number of fixed parameters that a function takes. foreign import ccall unsafe "LLVMCountParamTypes" countParamTypes - :: TypeRef -> IO CUInt + :: TypeRef -> IO CUInt -- | Fill out an array with the types of a function's fixed -- parameters. foreign import ccall unsafe "LLVMGetParamTypes" getParamTypes - :: TypeRef -> Ptr TypeRef -> IO () + :: TypeRef -> Ptr TypeRef -> IO () foreign import ccall unsafe "LLVMArrayType" arrayType - :: TypeRef -- ^ element type - -> CUInt -- ^ element count - -> TypeRef + :: TypeRef -- ^ element type + -> CUInt -- ^ element count + -> TypeRef foreign import ccall unsafe "LLVMPointerType" pointerType - :: TypeRef -- ^ pointed-to type - -> CUInt -- ^ address space - -> TypeRef + :: TypeRef -- ^ pointed-to type + -> CUInt -- ^ address space + -> TypeRef foreign import ccall unsafe "LLVMVectorType" vectorType - :: TypeRef -- ^ element type - -> CUInt -- ^ element count - -> TypeRef + :: TypeRef -- ^ element type + -> CUInt -- ^ element count + -> TypeRef #if HS_LLVM_VERSION < 300 foreign import ccall unsafe "LLVMAddTypeName" addTypeName @@ -669,113 +675,131 @@ foreign import ccall unsafe "LLVMDeleteTypeName" deleteTypeName -- | Get the type of a sequential type's elements. foreign import ccall unsafe "LLVMGetElementType" getElementType - :: TypeRef -> IO TypeRef + :: TypeRef -> IO TypeRef data Value - deriving (Typeable) + deriving (Typeable) type ValueRef = Ptr Value foreign import ccall unsafe "LLVMAddGlobal" addGlobal - :: ModuleRef -> TypeRef -> CString -> IO ValueRef + :: ModuleRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMDeleteGlobal" deleteGlobal - :: ValueRef -> IO () + :: ValueRef -> IO () foreign import ccall unsafe "LLVMSetInitializer" setInitializer - :: ValueRef -> ValueRef -> IO () + :: ValueRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMGetNamedGlobal" getNamedGlobal - :: ModuleRef -> CString -> IO ValueRef + :: ModuleRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMGetInitializer" getInitializer - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMIsThreadLocal" isThreadLocal - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMSetThreadLocal" setThreadLocal - :: ValueRef -> CInt -> IO () + :: ValueRef -> CInt -> IO () foreign import ccall unsafe "LLVMIsGlobalConstant" isGlobalConstant - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMSetGlobalConstant" setGlobalConstant - :: ValueRef -> CInt -> IO () + :: ValueRef -> CInt -> IO () foreign import ccall unsafe "LLVMTypeOf" typeOf - :: ValueRef -> IO TypeRef + :: ValueRef -> IO TypeRef foreign import ccall unsafe "LLVMGetValueName" getValueName - :: ValueRef -> IO CString + :: ValueRef -> IO CString foreign import ccall unsafe "LLVMSetValueName" setValueName - :: ValueRef -> CString -> IO () + :: ValueRef -> CString -> IO () foreign import ccall unsafe "LLVMDumpValue" dumpValue - :: ValueRef -> IO () + :: ValueRef -> IO () foreign import ccall unsafe "LLVMConstAllOnes" constAllOnes - :: TypeRef -> ValueRef + :: TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstArray" constArray - :: TypeRef -> Ptr ValueRef -> CUInt -> ValueRef + :: TypeRef -> Ptr ValueRef -> CUInt -> ValueRef foreign import ccall unsafe "LLVMConstNull" constNull - :: TypeRef -> ValueRef + :: TypeRef -> ValueRef foreign import ccall unsafe "LLVMIsConstant" isConstant - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMIsConstantExpr" isConstantExpr + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMIsCast" isCast + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMIsStaticGEP" isStaticGEP + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMIsZeroInitialized" isZeroInitialized + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMIsCString" isCString + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMGetUndef" getUndef - :: TypeRef -> ValueRef + :: TypeRef -> ValueRef foreign import ccall unsafe "LLVMIsNull" isNull - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMIsUndef" isUndef - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMGetAsCString" getAsCString + :: ValueRef -> IO CString foreign import ccall unsafe "LLVMGetNamedFunction" getNamedFunction - :: ModuleRef -- ^ module - -> CString -- ^ name - -> IO ValueRef -- ^ function (@nullPtr@ if not found) + :: ModuleRef -- ^ module + -> CString -- ^ name + -> IO ValueRef -- ^ function (@nullPtr@ if not found) foreign import ccall unsafe "LLVMAddFunction" addFunction - :: ModuleRef -- ^ module - -> CString -- ^ name - -> TypeRef -- ^ type - -> IO ValueRef + :: ModuleRef -- ^ module + -> CString -- ^ name + -> TypeRef -- ^ type + -> IO ValueRef foreign import ccall unsafe "LLVMDeleteFunction" deleteFunction - :: ValueRef -- ^ function - -> IO () + :: ValueRef -- ^ function + -> IO () foreign import ccall unsafe "LLVMCountParams" countParams - :: ValueRef -- ^ function - -> CUInt + :: ValueRef -- ^ function + -> CUInt foreign import ccall unsafe "LLVMGetParam" getParam - :: ValueRef -- ^ function - -> CUInt -- ^ offset into array - -> ValueRef + :: ValueRef -- ^ function + -> CUInt -- ^ offset into array + -> ValueRef foreign import ccall unsafe "LLVMGetParams" getParams - :: ValueRef -- ^ function - -> Ptr ValueRef -- ^ array to fill out - -> IO () + :: ValueRef -- ^ function + -> Ptr ValueRef -- ^ array to fill out + -> IO () foreign import ccall unsafe "LLVMGetIntrinsicID" getIntrinsicID - :: ValueRef -- ^ function - -> CUInt + :: ValueRef -- ^ function + -> CUInt data CallingConvention = C - | Fast - | Cold - | X86StdCall - | X86FastCall - | GHC - deriving (Show, Eq, Ord, Enum, Bounded, Typeable) + | Fast + | Cold + | X86StdCall + | X86FastCall + | GHC + deriving (Show, Eq, Ord, Enum, Bounded, Typeable) fromCallingConvention :: CallingConvention -> CUInt fromCallingConvention C = (#const LLVMCCallConv) @@ -793,44 +817,44 @@ toCallingConvention c | c == (#const LLVMX86StdcallCallConv) = X86StdCall toCallingConvention c | c == (#const LLVMX86FastcallCallConv) = X86FastCall toCallingConvention c | c == 10 = GHC toCallingConvention c = error $ "LLVM.Core.FFI.toCallingConvention: " ++ - "unsupported calling convention" ++ show c + "unsupported calling convention" ++ show c foreign import ccall unsafe "LLVMGetFunctionCallConv" getFunctionCallConv - :: ValueRef -- ^ function - -> IO CUInt + :: ValueRef -- ^ function + -> IO CUInt foreign import ccall unsafe "LLVMSetFunctionCallConv" setFunctionCallConv - :: ValueRef -- ^ function - -> CUInt - -> IO () + :: ValueRef -- ^ function + -> CUInt + -> IO () foreign import ccall unsafe "LLVMGetGC" getGC - :: ValueRef -> IO CString + :: ValueRef -> IO CString foreign import ccall unsafe "LLVMSetGC" setGC - :: ValueRef -> CString -> IO () + :: ValueRef -> CString -> IO () foreign import ccall unsafe "LLVMIsDeclaration" isDeclaration - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt -- |An enumeration for the kinds of linkage for global values. data Linkage - = ExternalLinkage -- ^Externally visible function - | AvailableExternallyLinkage - | LinkOnceAnyLinkage -- ^Keep one copy of function when linking (inline) - | LinkOnceODRLinkage -- ^Same, but only replaced by something equivalent. - | WeakAnyLinkage -- ^Keep one copy of named function when linking (weak) - | WeakODRLinkage -- ^Same, but only replaced by something equivalent. - | AppendingLinkage -- ^Special purpose, only applies to global arrays - | InternalLinkage -- ^Rename collisions when linking (static functions) - | PrivateLinkage -- ^Like Internal, but omit from symbol table - | DLLImportLinkage -- ^Function to be imported from DLL - | DLLExportLinkage -- ^Function to be accessible from DLL - | ExternalWeakLinkage -- ^ExternalWeak linkage description - | GhostLinkage -- ^Stand-in functions for streaming fns from BC files - | CommonLinkage -- ^Tentative definitions - | LinkerPrivateLinkage -- ^Like Private, but linker removes. - deriving (Show, Eq, Ord, Enum, Typeable) + = ExternalLinkage -- ^Externally visible function + | AvailableExternallyLinkage + | LinkOnceAnyLinkage -- ^Keep one copy of function when linking (inline) + | LinkOnceODRLinkage -- ^Same, but only replaced by something equivalent. + | WeakAnyLinkage -- ^Keep one copy of named function when linking (weak) + | WeakODRLinkage -- ^Same, but only replaced by something equivalent. + | AppendingLinkage -- ^Special purpose, only applies to global arrays + | InternalLinkage -- ^Rename collisions when linking (static functions) + | PrivateLinkage -- ^Like Internal, but omit from symbol table + | DLLImportLinkage -- ^Function to be imported from DLL + | DLLExportLinkage -- ^Function to be accessible from DLL + | ExternalWeakLinkage -- ^ExternalWeak linkage description + | GhostLinkage -- ^Stand-in functions for streaming fns from BC files + | CommonLinkage -- ^Tentative definitions + | LinkerPrivateLinkage -- ^Like Private, but linker removes. + deriving (Show, Eq, Ord, Enum, Typeable) fromLinkage :: Linkage -> CUInt fromLinkage ExternalLinkage = (#const LLVMExternalLinkage) @@ -851,7 +875,7 @@ fromLinkage LinkerPrivateLinkage = (#const LLVMLinkerPrivateLinkage) toLinkage :: CUInt -> Linkage toLinkage c | c == (#const LLVMExternalLinkage) = ExternalLinkage -toLinkage c | c == (#const LLVMAvailableExternallyLinkage) = AvailableExternallyLinkage +toLinkage c | c == (#const LLVMAvailableExternallyLinkage) = AvailableExternallyLinkage toLinkage c | c == (#const LLVMLinkOnceAnyLinkage) = LinkOnceAnyLinkage toLinkage c | c == (#const LLVMLinkOnceODRLinkage) = LinkOnceODRLinkage toLinkage c | c == (#const LLVMWeakAnyLinkage) = WeakAnyLinkage @@ -868,23 +892,23 @@ toLinkage c | c == (#const LLVMLinkerPrivateLinkage) = LinkerPrivateLinka toLinkage _ = error "toLinkage: bad value" foreign import ccall unsafe "LLVMGetLinkage" getLinkage - :: ValueRef -> IO CUInt + :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMSetLinkage" setLinkage - :: ValueRef -> CUInt -> IO () + :: ValueRef -> CUInt -> IO () foreign import ccall unsafe "LLVMGetSection" getSection - :: ValueRef -> IO CString + :: ValueRef -> IO CString foreign import ccall unsafe "LLVMSetSection" setSection - :: ValueRef -> CString -> IO () + :: ValueRef -> CString -> IO () -- |An enumeration for the kinds of visibility of global values. data Visibility - = DefaultVisibility -- ^The GV is visible - | HiddenVisibility -- ^The GV is hidden - | ProtectedVisibility -- ^The GV is protected - deriving (Show, Eq, Ord, Enum) + = DefaultVisibility -- ^The GV is visible + | HiddenVisibility -- ^The GV is hidden + | ProtectedVisibility -- ^The GV is protected + deriving (Show, Eq, Ord, Enum) fromVisibility :: Visibility -> CUInt fromVisibility DefaultVisibility = (#const LLVMDefaultVisibility) @@ -898,222 +922,223 @@ toVisibility c | c == (#const LLVMProtectedVisibility) = ProtectedVisibility toVisibility _ = error "toVisibility: bad value" foreign import ccall unsafe "LLVMGetVisibility" getVisibility - :: ValueRef -> IO CUInt + :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMSetVisibility" setVisibility - :: ValueRef -> CUInt -> IO () + :: ValueRef -> CUInt -> IO () foreign import ccall unsafe "LLVMGetAlignment" getAlignment - :: ValueRef -> IO CUInt + :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMSetAlignment" setAlignment - :: ValueRef -> CUInt -> IO () + :: ValueRef -> CUInt -> IO () foreign import ccall unsafe "LLVMConstInt" constInt - :: TypeRef -> CULLong -> CInt -> ValueRef + :: TypeRef -> CULLong -> CInt -> ValueRef foreign import ccall unsafe "LLVMConstReal" constReal - :: TypeRef -> CDouble -> ValueRef + :: TypeRef -> CDouble -> ValueRef foreign import ccall unsafe "LLVMConstString" constString - :: CString -> CUInt -> CInt -> ValueRef + :: CString -> CUInt -> CInt -> ValueRef foreign import ccall unsafe "LLVMConstStruct" constStruct - :: Ptr ValueRef -> CUInt -> CInt -> ValueRef + :: Ptr ValueRef -> CUInt -> CInt -> ValueRef foreign import ccall unsafe "LLVMConstVector" constVector - :: Ptr ValueRef -> CUInt -> ValueRef + :: Ptr ValueRef -> CUInt -> ValueRef foreign import ccall unsafe "LLVMConstNeg" constNeg - :: ValueRef -> ValueRef + :: ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstNot" constNot - :: ValueRef -> ValueRef + :: ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstAdd" constAdd - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstSub" constSub - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstMul" constMul - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstUDiv" constUDiv - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstSDiv" constSDiv - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstFDiv" constFDiv - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstURem" constURem - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstSRem" constSRem - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstFRem" constFRem - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstAnd" constAnd - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstOr" constOr - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstXor" constXor - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstICmp" constICmp - :: CInt -> ValueRef -> ValueRef -> ValueRef + :: CInt -> ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstFCmp" constFCmp - :: CInt -> ValueRef -> ValueRef -> ValueRef + :: CInt -> ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstShl" constShl - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstLShr" constLShr - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstAShr" constAShr - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstGEP" constGEP - :: ValueRef -> Ptr ValueRef -> CUInt -> ValueRef + :: ValueRef -> Ptr ValueRef -> CUInt -> ValueRef foreign import ccall unsafe "LLVMConstTrunc" constTrunc - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstSExt" constSExt - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstZExt" constZExt - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstFPTrunc" constFPTrunc - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstFPExt" constFPExt - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstUIToFP" constUIToFP - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstSIToFP" constSIToFP - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstFPToUI" constFPToUI - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstFPToSI" constFPToSI - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstPtrToInt" constPtrToInt - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstIntToPtr" constIntToPtr - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstBitCast" constBitCast - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstSelect" constSelect - :: ValueRef -> ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstExtractElement" constExtractElement - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstInsertElement" constInsertElement - :: ValueRef -> ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstShuffleVector" constShuffleVector - :: ValueRef -> ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef -> ValueRef type BasicBlock = Value type BasicBlockRef = Ptr BasicBlock foreign import ccall unsafe "LLVMBasicBlockAsValue" basicBlockAsValue - :: BasicBlockRef -> ValueRef + :: BasicBlockRef -> ValueRef foreign import ccall unsafe "LLVMValueIsBasicBlock" valueIsBasicBlock - :: ValueRef -> Bool + :: ValueRef -> Bool foreign import ccall unsafe "LLVMValueAsBasicBlock" valueAsBasicBlock - :: ValueRef -- ^ basic block - -> BasicBlockRef + :: ValueRef -- ^ basic block + -> BasicBlockRef foreign import ccall unsafe "LLVMCountBasicBlocks" countBasicBlocks - :: ValueRef -- ^ function - -> IO CUInt + :: ValueRef -- ^ function + -> IO CUInt foreign import ccall unsafe "LLVMGetBasicBlocks" getBasicBlocks - :: ValueRef -- ^ function - -> Ptr BasicBlockRef -- ^ array to fill out - -> IO () + :: ValueRef -- ^ function + -> Ptr BasicBlockRef -- ^ array to fill out + -> IO () foreign import ccall unsafe "LLVMGetEntryBasicBlock" getEntryBasicBlock - :: ValueRef -- ^ function - -> IO BasicBlockRef + :: ValueRef -- ^ function + -> IO BasicBlockRef foreign import ccall unsafe "LLVMAppendBasicBlock" appendBasicBlock - :: ValueRef -- ^ function - -> CString -- ^ name for label - -> IO BasicBlockRef + :: ValueRef -- ^ function + -> CString -- ^ name for label + -> IO BasicBlockRef foreign import ccall unsafe "LLVMInsertBasicBlock" insertBasicBlock - :: BasicBlockRef -- ^ insert before this one - -> CString -- ^ name for label - -> IO BasicBlockRef + :: BasicBlockRef -- ^ insert before this one + -> CString -- ^ name for label + -> IO BasicBlockRef foreign import ccall unsafe "LLVMDeleteBasicBlock" deleteBasicBlock - :: BasicBlockRef -> IO () + :: BasicBlockRef -> IO () foreign import ccall unsafe "LLVMInstGetOpcode" instGetOpcode - :: ValueRef -> IO Int + :: ValueRef -> IO Int foreign import ccall unsafe "LLVMCmpInstGetPredicate" cmpInstGetPredicate - :: ValueRef -> IO Int + :: ValueRef -> IO Int data Builder - deriving (Typeable) + deriving (Typeable) type BuilderRef = Ptr Builder foreign import ccall unsafe "LLVMCreateBuilder" createBuilder - :: IO BuilderRef + :: IO BuilderRef foreign import ccall unsafe "&LLVMDisposeBuilder" ptrDisposeBuilder - :: FunPtr (BuilderRef -> IO ()) + :: FunPtr (BuilderRef -> IO ()) foreign import ccall unsafe "LLVMPositionBuilderBefore" positionBefore - :: BuilderRef -> ValueRef -> IO () + :: BuilderRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMPositionBuilderAtEnd" positionAtEnd - :: BuilderRef -> BasicBlockRef -> IO () + :: BuilderRef -> BasicBlockRef -> IO () foreign import ccall unsafe "LLVMBuildRetVoid" buildRetVoid - :: BuilderRef -> IO ValueRef + :: BuilderRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildRet" buildRet - :: BuilderRef -> ValueRef -> IO ValueRef + :: BuilderRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildBr" buildBr - :: BuilderRef -> BasicBlockRef -> IO ValueRef + :: BuilderRef -> BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildCondBr" buildCondBr - :: BuilderRef -> ValueRef -> BasicBlockRef -> BasicBlockRef -> IO ValueRef + :: BuilderRef -> ValueRef -> BasicBlockRef -> BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildSwitch" buildSwitch - :: BuilderRef -> ValueRef -> BasicBlockRef -> CUInt -> IO ValueRef + :: BuilderRef -> ValueRef -> BasicBlockRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMBuildInvoke" buildInvoke - :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt + :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> BasicBlockRef -> BasicBlockRef -> CString -> IO ValueRef + #if HS_LLVM_VERSION < 300 foreign import ccall unsafe "LLVMBuildUnwind" buildUnwind :: BuilderRef -> IO ValueRef #endif foreign import ccall unsafe "LLVMBuildUnreachable" buildUnreachable - :: BuilderRef -> IO ValueRef + :: BuilderRef -> IO ValueRef #if HS_LLVM_VERSION >= 300 -- New landing pad instructions for LLVM 3.0 @@ -1126,187 +1151,187 @@ foreign import ccall unsafe "LLVMSetCleanup" setCleanup #endif foreign import ccall unsafe "LLVMBuildAdd" buildAdd - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildSub" buildSub - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildMul" buildMul - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildUDiv" buildUDiv - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildSDiv" buildSDiv - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFDiv" buildFDiv - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildURem" buildURem - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildSRem" buildSRem - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFRem" buildFRem - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildShl" buildShl - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildLShr" buildLShr - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildAShr" buildAShr - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildAnd" buildAnd - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildOr" buildOr - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildXor" buildXor - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNeg" buildNeg - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNot" buildNot - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef -- Memory foreign import ccall unsafe "LLVMBuildMalloc" buildMalloc - :: BuilderRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildArrayMalloc" buildArrayMalloc - :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildAlloca" buildAlloca - :: BuilderRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildArrayAlloca" buildArrayAlloca - :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFree" buildFree - :: BuilderRef -> ValueRef -> IO ValueRef + :: BuilderRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildLoad" buildLoad - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildStore" buildStore - :: BuilderRef -> ValueRef -> ValueRef -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildGEP" buildGEP - :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString - -> IO ValueRef + :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString + -> IO ValueRef -- Casts foreign import ccall unsafe "LLVMBuildTrunc" buildTrunc - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildZExt" buildZExt - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildSExt" buildSExt - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFPToUI" buildFPToUI - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFPToSI" buildFPToSI - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildUIToFP" buildUIToFP - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildSIToFP" buildSIToFP - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFPTrunc" buildFPTrunc - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFPExt" buildFPExt - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildPtrToInt" buildPtrToInt - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildIntToPtr" buildIntToPtr - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildBitCast" buildBitCast - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef -- Comparisons foreign import ccall unsafe "LLVMBuildICmp" buildICmp - :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFCmp" buildFCmp - :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef -- Miscellaneous instructions foreign import ccall unsafe "LLVMBuildPhi" buildPhi - :: BuilderRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildCall" buildCall - :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildSelect" buildSelect - :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildVAArg" buildVAArg - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildExtractElement" buildExtractElement - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildInsertElement" buildInsertElement - :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildShuffleVector" buildShuffleVector - :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMAddCase" addCase - :: ValueRef -> ValueRef -> BasicBlockRef -> IO () + :: ValueRef -> ValueRef -> BasicBlockRef -> IO () foreign import ccall unsafe "LLVMCountIncoming" countIncoming - :: ValueRef -> IO CUInt + :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMAddIncoming" addIncoming - :: ValueRef -> Ptr ValueRef -> Ptr ValueRef -> CUInt -> IO () + :: ValueRef -> Ptr ValueRef -> Ptr ValueRef -> CUInt -> IO () foreign import ccall unsafe "LLVMGetIncomingValue" getIncomingValue - :: ValueRef -> CUInt -> IO ValueRef + :: ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMGetIncomingBlock" getIncomingBlock - :: ValueRef -> CUInt -> IO BasicBlockRef - + :: ValueRef -> CUInt -> IO BasicBlockRef + foreign import ccall unsafe "LLVMGetInstructionCallConv" getInstructionCallConv - :: ValueRef -> IO CUInt + :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMSetInstructionCallConv" setInstructionCallConv - :: ValueRef -> CUInt -> IO () + :: ValueRef -> CUInt -> IO () foreign import ccall unsafe "LLVMStructType" structType - :: Ptr TypeRef -> CUInt -> CInt -> TypeRef + :: Ptr TypeRef -> CUInt -> CInt -> TypeRef foreign import ccall unsafe "LLVMCountStructElementTypes" - countStructElementTypes :: TypeRef -> CUInt + countStructElementTypes :: TypeRef -> CUInt foreign import ccall unsafe "LLVMGetStructElementTypes" getStructElementTypes - :: TypeRef -> Ptr TypeRef -> IO () + :: TypeRef -> Ptr TypeRef -> IO () foreign import ccall unsafe "LLVMIsPackedStruct" isPackedStruct - :: TypeRef -> CInt + :: TypeRef -> CInt data MemoryBuffer - deriving (Typeable) + deriving (Typeable) type MemoryBufferRef = Ptr MemoryBuffer #if HS_LLVM_VERSION < 300 data TypeHandle - deriving (Typeable) + deriving (Typeable) type TypeHandleRef = Ptr TypeHandle #endif data TypeKind - = VoidTypeKind - | FloatTypeKind - | DoubleTypeKind - | X86_FP80TypeKind - | FP128TypeKind - | PPC_FP128TypeKind - | LabelTypeKind - | IntegerTypeKind - | FunctionTypeKind - | StructTypeKind - | ArrayTypeKind - | PointerTypeKind - | OpaqueTypeKind - | VectorTypeKind - deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable) + = VoidTypeKind + | FloatTypeKind + | DoubleTypeKind + | X86_FP80TypeKind + | FP128TypeKind + | PPC_FP128TypeKind + | LabelTypeKind + | IntegerTypeKind + | FunctionTypeKind + | StructTypeKind + | ArrayTypeKind + | PointerTypeKind + | OpaqueTypeKind + | VectorTypeKind + deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable) getTypeKind :: TypeRef -> IO TypeKind getTypeKind = fmap (toEnum . fromIntegral) . getTypeKindCUInt foreign import ccall unsafe "LLVMCreateMemoryBufferWithContentsOfFile" createMemoryBufferWithContentsOfFile - :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO CInt + :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO CInt foreign import ccall unsafe "LLVMCreateMemoryBufferWithSTDIN" createMemoryBufferWithSTDIN - :: Ptr MemoryBufferRef -> Ptr CString -> IO CInt + :: Ptr MemoryBufferRef -> Ptr CString -> IO CInt foreign import ccall unsafe "LLVMDisposeMemoryBuffer" disposeMemoryBuffer - :: MemoryBufferRef -> IO () + :: MemoryBufferRef -> IO () foreign import ccall unsafe "LLVMDisposeMessage" disposeMessage - :: CString -> IO () + :: CString -> IO () foreign import ccall unsafe "LLVMGetArrayLength" getArrayLength - :: TypeRef -> IO CUInt + :: TypeRef -> IO CUInt foreign import ccall unsafe "LLVMGetIntTypeWidth" getIntTypeWidth - :: TypeRef -> IO CUInt + :: TypeRef -> IO CUInt foreign import ccall unsafe "LLVMGetPointerAddressSpace" getPointerAddressSpace - :: TypeRef -> IO CUInt + :: TypeRef -> IO CUInt foreign import ccall unsafe "LLVMGetTarget" getTarget - :: ModuleRef -> IO CString + :: ModuleRef -> IO CString foreign import ccall unsafe "LLVMGetTypeKind" getTypeKindCUInt - :: TypeRef -> IO CUInt + :: TypeRef -> IO CUInt foreign import ccall unsafe "LLVMGetVectorSize" getVectorSize - :: TypeRef -> IO CUInt + :: TypeRef -> IO CUInt foreign import ccall unsafe "LLVMSetTarget" setTarget - :: ModuleRef -> CString -> IO () + :: ModuleRef -> CString -> IO () foreign import ccall unsafe "LLVMSizeOf" sizeOf - :: TypeRef -> IO ValueRef + :: TypeRef -> IO ValueRef #if HS_LLVM_VERSION < 300 foreign import ccall unsafe "LLVMCreateTypeHandle" createTypeHandle @@ -1327,27 +1352,27 @@ foreign import ccall unsafe "LLVMStructSetBody" structSetBody #endif data Attribute - = ZExtAttribute - | SExtAttribute - | NoReturnAttribute - | InRegAttribute - | StructRetAttribute - | NoUnwindAttribute - | NoAliasAttribute - | ByValAttribute - | NestAttribute - | ReadNoneAttribute - | ReadOnlyAttribute - | NoInlineAttribute - | AlwaysInlineAttribute - | OptimizeForSizeAttribute - | StackProtectAttribute - | StackProtectReqAttribute - | NoCaptureAttribute - | NoRedZoneAttribute - | NoImplicitFloatAttribute - | NakedAttribute - deriving (Show, Eq, Ord, Enum, Bounded, Typeable) + = ZExtAttribute + | SExtAttribute + | NoReturnAttribute + | InRegAttribute + | StructRetAttribute + | NoUnwindAttribute + | NoAliasAttribute + | ByValAttribute + | NestAttribute + | ReadNoneAttribute + | ReadOnlyAttribute + | NoInlineAttribute + | AlwaysInlineAttribute + | OptimizeForSizeAttribute + | StackProtectAttribute + | StackProtectReqAttribute + | NoCaptureAttribute + | NoRedZoneAttribute + | NoImplicitFloatAttribute + | NakedAttribute + deriving (Show, Eq, Ord, Enum, Bounded, Typeable) fromAttribute :: Attribute -> CAttribute fromAttribute ZExtAttribute = (#const LLVMZExtAttribute) @@ -1397,91 +1422,91 @@ toAttribute _ = error "toAttribute: bad value" type CAttribute = CInt data PassManager - deriving (Typeable) + deriving (Typeable) type PassManagerRef = Ptr PassManager data OpaqueUse - deriving (Typeable) + deriving (Typeable) type UseRef = Ptr OpaqueUse foreign import ccall unsafe "LLVMConstRealOfString" constRealOfString - :: TypeRef -> CString -> IO ValueRef + :: TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMCreateFunctionPassManager" createFunctionPassManager - :: ModuleProviderRef -> IO PassManagerRef + :: ModuleProviderRef -> IO PassManagerRef foreign import ccall unsafe "LLVMCreatePassManager" createPassManager - :: IO PassManagerRef + :: IO PassManagerRef foreign import ccall unsafe "LLVMDisposePassManager" disposePassManager - :: PassManagerRef -> IO () + :: PassManagerRef -> IO () foreign import ccall unsafe "&LLVMDisposePassManager" ptrDisposePassManager - :: FunPtr (PassManagerRef -> IO ()) + :: FunPtr (PassManagerRef -> IO ()) foreign import ccall unsafe "LLVMDumpModule" dumpModule - :: ModuleRef -> IO () + :: ModuleRef -> IO () foreign import ccall unsafe "LLVMFinalizeFunctionPassManager" finalizeFunctionPassManager - :: PassManagerRef -> IO CInt + :: PassManagerRef -> IO CInt foreign import ccall unsafe "LLVMGetBasicBlockParent" getBasicBlockParent - :: BasicBlockRef -> IO ValueRef + :: BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMGetFirstBasicBlock" getFirstBasicBlock - :: ValueRef -> IO BasicBlockRef + :: ValueRef -> IO BasicBlockRef foreign import ccall unsafe "LLVMGetFirstFunction" getFirstFunction - :: ModuleRef -> IO ValueRef + :: ModuleRef -> IO ValueRef foreign import ccall unsafe "LLVMGetFirstGlobal" getFirstGlobal - :: ModuleRef -> IO ValueRef + :: ModuleRef -> IO ValueRef foreign import ccall unsafe "LLVMGetFirstInstruction" getFirstInstruction - :: BasicBlockRef -> IO ValueRef + :: BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMGetFirstParam" getFirstParam - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetGlobalParent" getGlobalParent - :: ValueRef -> IO ModuleRef + :: ValueRef -> IO ModuleRef foreign import ccall unsafe "LLVMGetInsertBlock" getInsertBlock - :: BuilderRef -> IO BasicBlockRef + :: BuilderRef -> IO BasicBlockRef foreign import ccall unsafe "LLVMGetInstructionParent" getInstructionParent - :: ValueRef -> IO BasicBlockRef + :: ValueRef -> IO BasicBlockRef foreign import ccall unsafe "LLVMGetLastBasicBlock" getLastBasicBlock - :: ValueRef -> IO BasicBlockRef + :: ValueRef -> IO BasicBlockRef foreign import ccall unsafe "LLVMGetLastFunction" getLastFunction - :: ModuleRef -> IO ValueRef + :: ModuleRef -> IO ValueRef foreign import ccall unsafe "LLVMGetLastGlobal" getLastGlobal - :: ModuleRef -> IO ValueRef + :: ModuleRef -> IO ValueRef foreign import ccall unsafe "LLVMGetLastInstruction" getLastInstruction - :: BasicBlockRef -> IO ValueRef + :: BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMGetLastParam" getLastParam - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetNextBasicBlock" getNextBasicBlock - :: BasicBlockRef -> IO BasicBlockRef + :: BasicBlockRef -> IO BasicBlockRef foreign import ccall unsafe "LLVMGetNextFunction" getNextFunction - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetNextGlobal" getNextGlobal - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetNextInstruction" getNextInstruction - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetNextParam" getNextParam - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetParamParent" getParamParent - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetPreviousBasicBlock" getPreviousBasicBlock - :: BasicBlockRef -> IO BasicBlockRef + :: BasicBlockRef -> IO BasicBlockRef foreign import ccall unsafe "LLVMGetPreviousFunction" getPreviousFunction - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetPreviousGlobal" getPreviousGlobal - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetPreviousInstruction" getPreviousInstruction - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetPreviousParam" getPreviousParam - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMInitializeFunctionPassManager" initializeFunctionPassManager - :: PassManagerRef -> IO CInt + :: PassManagerRef -> IO CInt foreign import ccall unsafe "LLVMLabelType" labelType - :: TypeRef + :: TypeRef foreign import ccall unsafe "LLVMPositionBuilder" positionBuilder - :: BuilderRef -> BasicBlockRef -> ValueRef -> IO () + :: BuilderRef -> BasicBlockRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMRunFunctionPassManager" runFunctionPassManager - :: PassManagerRef -> ValueRef -> IO CInt + :: PassManagerRef -> ValueRef -> IO CInt foreign import ccall unsafe "LLVMRunPassManager" runPassManager - :: PassManagerRef -> ModuleRef -> IO CInt + :: PassManagerRef -> ModuleRef -> IO CInt foreign import ccall unsafe "LLVMSetInstrParamAlignment" setInstrParamAlignment - :: ValueRef -> CUInt -> CUInt -> IO () + :: ValueRef -> CUInt -> CUInt -> IO () foreign import ccall unsafe "LLVMSetParamAlignment" setParamAlignment - :: ValueRef -> CUInt -> IO () + :: ValueRef -> CUInt -> IO () #if HS_LLVM_VERSION < 300 foreign import ccall unsafe "LLVMOpaqueType" opaqueType @@ -1492,280 +1517,280 @@ foreign import ccall unsafe "LLVMOpaqueTypeInContext" opaqueTypeInContext data Context - deriving (Typeable) + deriving (Typeable) type ContextRef = Ptr Context foreign import ccall unsafe "LLVMAddAttribute" addAttribute - :: ValueRef -> CAttribute -> IO () + :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMAddInstrAttribute" addInstrAttribute - :: ValueRef -> CUInt -> CAttribute -> IO () + :: ValueRef -> CUInt -> CAttribute -> IO () foreign import ccall unsafe "LLVMIsTailCall" isTailCall - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMRemoveAttribute" removeAttribute - :: ValueRef -> CAttribute -> IO () + :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMRemoveInstrAttribute" removeInstrAttribute - :: ValueRef -> CUInt -> CAttribute -> IO () + :: ValueRef -> CUInt -> CAttribute -> IO () foreign import ccall unsafe "LLVMSetTailCall" setTailCall - :: ValueRef -> CInt -> IO () + :: ValueRef -> CInt -> IO () foreign import ccall unsafe "LLVMAddFunctionAttr" addFunctionAttr - :: ValueRef -> CAttribute -> IO () + :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMAlignOf" alignOf - :: TypeRef -> IO ValueRef + :: TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMAppendBasicBlockInContext" appendBasicBlockInContext - :: ContextRef -> ValueRef -> CString -> IO BasicBlockRef + :: ContextRef -> ValueRef -> CString -> IO BasicBlockRef foreign import ccall unsafe "LLVMBuildAggregateRet" buildAggregateRet - :: BuilderRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef + :: BuilderRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMBuildExactSDiv" buildExactSDiv - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFAdd" buildFAdd - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFMul" buildFMul - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFPCast" buildFPCast - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFSub" buildFSub - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildFNeg" buildFNeg - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildGlobalString" buildGlobalString - :: BuilderRef -> CString -> CString -> IO ValueRef + :: BuilderRef -> CString -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildGlobalStringPtr" buildGlobalStringPtr - :: BuilderRef -> CString -> CString -> IO ValueRef + :: BuilderRef -> CString -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildInBoundsGEP" buildInBoundsGEP - :: BuilderRef -> ValueRef -> (Ptr ValueRef) -> CUInt -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> (Ptr ValueRef) -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildIsNotNull" buildIsNotNull - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildIsNull" buildIsNull - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNSWAdd" buildNSWAdd - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildPointerCast" buildPointerCast - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildPtrDiff" buildPtrDiff - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildSExtOrBitCast" buildSExtOrBitCast - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildStructGEP" buildStructGEP - :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildTruncOrBitCast" buildTruncOrBitCast - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildZExtOrBitCast" buildZExtOrBitCast - :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMConstExactSDiv" constExactSDiv - :: ValueRef -> ValueRef -> IO ValueRef + :: ValueRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstFAdd" constFAdd - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstFMul" constFMul - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstFNeg" constFNeg - :: ValueRef -> ValueRef + :: ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstFPCast" constFPCast - :: ValueRef -> TypeRef -> ValueRef + :: ValueRef -> TypeRef -> ValueRef foreign import ccall unsafe "LLVMConstFSub" constFSub - :: ValueRef -> ValueRef -> ValueRef + :: ValueRef -> ValueRef -> ValueRef foreign import ccall unsafe "LLVMConstInBoundsGEP" constInBoundsGEP - :: ValueRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef + :: ValueRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstIntCast" constIntCast - :: ValueRef -> TypeRef -> CUInt -> IO ValueRef + :: ValueRef -> TypeRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstIntOfString" constIntOfString - :: TypeRef -> CString -> CUInt -> IO ValueRef + :: TypeRef -> CString -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstIntOfStringAndSize" constIntOfStringAndSize - :: TypeRef -> CString -> CUInt -> CUInt -> IO ValueRef + :: TypeRef -> CString -> CUInt -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstNSWAdd" constNSWAdd - :: ValueRef -> ValueRef -> IO ValueRef + :: ValueRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstPointerCast" constPointerCast - :: ValueRef -> TypeRef -> IO ValueRef + :: ValueRef -> TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMConstPointerNull" constPointerNull - :: TypeRef -> IO ValueRef + :: TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMConstRealOfStringAndSize" constRealOfStringAndSize - :: TypeRef -> CString -> CUInt -> IO ValueRef + :: TypeRef -> CString -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstSExtOrBitCast" constSExtOrBitCast - :: ValueRef -> TypeRef -> IO ValueRef + :: ValueRef -> TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMConstStringInContext" constStringInContext - :: ContextRef -> CString -> CUInt -> CInt -> IO ValueRef + :: ContextRef -> CString -> CUInt -> CInt -> IO ValueRef foreign import ccall unsafe "LLVMConstStructInContext" constStructInContext - :: ContextRef -> (Ptr ValueRef) -> CUInt -> CInt -> IO ValueRef + :: ContextRef -> (Ptr ValueRef) -> CUInt -> CInt -> IO ValueRef foreign import ccall unsafe "LLVMConstTruncOrBitCast" constTruncOrBitCast - :: ValueRef -> TypeRef -> IO ValueRef + :: ValueRef -> TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMConstZExtOrBitCast" constZExtOrBitCast - :: ValueRef -> TypeRef -> IO ValueRef + :: ValueRef -> TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMContextDispose" contextDispose - :: ContextRef -> IO () + :: ContextRef -> IO () foreign import ccall unsafe "LLVMCreateBuilderInContext" createBuilderInContext - :: ContextRef -> IO BuilderRef + :: ContextRef -> IO BuilderRef foreign import ccall unsafe "LLVMDoubleTypeInContext" doubleTypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMFP128TypeInContext" fP128TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMFloatTypeInContext" floatTypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMGetTypeByName" getTypeByName - :: ModuleRef -> CString -> IO TypeRef + :: ModuleRef -> CString -> IO TypeRef foreign import ccall unsafe "LLVMGetTypeContext" getTypeContext - :: TypeRef -> IO ContextRef + :: TypeRef -> IO ContextRef foreign import ccall unsafe "LLVMInsertBasicBlockInContext" insertBasicBlockInContext - :: ContextRef -> BasicBlockRef -> CString -> IO BasicBlockRef + :: ContextRef -> BasicBlockRef -> CString -> IO BasicBlockRef foreign import ccall unsafe "LLVMInsertIntoBuilderWithName" insertIntoBuilderWithName - :: BuilderRef -> ValueRef -> CString -> IO () + :: BuilderRef -> ValueRef -> CString -> IO () foreign import ccall unsafe "LLVMInt16TypeInContext" int16TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMInt1TypeInContext" int1TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMInt32TypeInContext" int32TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMInt64TypeInContext" int64TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMInt8TypeInContext" int8TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMIntTypeInContext" intTypeInContext - :: ContextRef -> CUInt -> IO TypeRef + :: ContextRef -> CUInt -> IO TypeRef foreign import ccall unsafe "LLVMLabelTypeInContext" labelTypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMModuleCreateWithNameInContext" moduleCreateWithNameInContext - :: CString -> ContextRef -> IO ModuleRef + :: CString -> ContextRef -> IO ModuleRef foreign import ccall unsafe "LLVMPPCFP128TypeInContext" pPCFP128TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMRemoveFunctionAttr" removeFunctionAttr - :: ValueRef -> CAttribute -> IO () + :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMStructTypeInContext" structTypeInContext - :: ContextRef -> (Ptr TypeRef) -> CUInt -> CInt -> IO TypeRef + :: ContextRef -> (Ptr TypeRef) -> CUInt -> CInt -> IO TypeRef foreign import ccall unsafe "LLVMVoidTypeInContext" voidTypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMX86FP80TypeInContext" x86FP80TypeInContext - :: ContextRef -> IO TypeRef + :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMAddAlias" addAlias - :: ModuleRef -> TypeRef -> ValueRef -> CString -> IO ValueRef + :: ModuleRef -> TypeRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMAddDestination" addDestination - :: ValueRef -> BasicBlockRef -> IO () + :: ValueRef -> BasicBlockRef -> IO () foreign import ccall unsafe "LLVMAddGlobalInAddressSpace" addGlobalInAddressSpace - :: ModuleRef -> TypeRef -> CString -> CUInt -> IO ValueRef + :: ModuleRef -> TypeRef -> CString -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMBlockAddress" blockAddress - :: ValueRef -> BasicBlockRef -> IO ValueRef + :: ValueRef -> BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildBinOp" buildBinOp - :: BuilderRef -> CUInt{-Opcode-} -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> CUInt{-Opcode-} -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildCast" buildCast - :: BuilderRef -> CUInt{-Opcode-} -> ValueRef -> TypeRef -> CString -> IO ValueRef + :: BuilderRef -> CUInt{-Opcode-} -> ValueRef -> TypeRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildExtractValue" buildExtractValue - :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildIndirectBr" buildIndirectBr - :: BuilderRef -> ValueRef -> CUInt -> IO ValueRef + :: BuilderRef -> ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMBuildInsertValue" buildInsertValue - :: BuilderRef -> ValueRef -> ValueRef -> CUInt -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNSWMul" buildNSWMul - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNSWNeg" buildNSWNeg - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNSWSub" buildNSWSub - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNUWAdd" buildNUWAdd - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNUWMul" buildNUWMul - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNUWNeg" buildNUWNeg - :: BuilderRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNUWSub" buildNUWSub - :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMClearInsertionPosition" clearInsertionPosition - :: BuilderRef -> IO () + :: BuilderRef -> IO () foreign import ccall unsafe "LLVMConstExtractValue" constExtractValue - :: ValueRef -> Ptr CUInt -> CUInt -> IO ValueRef + :: ValueRef -> Ptr CUInt -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstInlineAsm" constInlineAsm - :: TypeRef -> CString -> CString -> Bool -> Bool -> IO ValueRef + :: TypeRef -> CString -> CString -> Bool -> Bool -> IO ValueRef foreign import ccall unsafe "LLVMConstInsertValue" constInsertValue - :: ValueRef -> ValueRef -> Ptr CUInt -> CUInt -> IO ValueRef + :: ValueRef -> ValueRef -> Ptr CUInt -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstIntGetSExtValue" constIntGetSExtValue - :: ValueRef -> IO CLLong + :: ValueRef -> IO CLLong foreign import ccall unsafe "LLVMConstIntGetZExtValue" constIntGetZExtValue - :: ValueRef -> IO CULLong + :: ValueRef -> IO CULLong foreign import ccall unsafe "LLVMConstNSWMul" constNSWMul - :: ValueRef -> ValueRef -> IO ValueRef + :: ValueRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstNSWNeg" constNSWNeg - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstNSWSub" constNSWSub - :: ValueRef -> ValueRef -> IO ValueRef + :: ValueRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstNUWAdd" constNUWAdd - :: ValueRef -> ValueRef -> IO ValueRef + :: ValueRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstNUWMul" constNUWMul - :: ValueRef -> ValueRef -> IO ValueRef + :: ValueRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstNUWNeg" constNUWNeg - :: ValueRef -> IO ValueRef + :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMConstNUWSub" constNUWSub - :: ValueRef -> ValueRef -> IO ValueRef + :: ValueRef -> ValueRef -> IO ValueRef {- foreign import ccall unsafe "LLVMConstUnion" constUnion - :: TypeRef -> ValueRef -> IO ValueRef + :: TypeRef -> ValueRef -> IO ValueRef -} foreign import ccall unsafe "LLVMContextCreate" contextCreate - :: IO ContextRef + :: IO ContextRef {- foreign import ccall unsafe "LLVMCountUnionElementTypes" countUnionElementTypes - :: TypeRef -> IO CUInt + :: TypeRef -> IO CUInt -} foreign import ccall unsafe "LLVMCreateFunctionPassManagerForModule" createFunctionPassManagerForModule - :: ModuleRef -> IO PassManagerRef + :: ModuleRef -> IO PassManagerRef foreign import ccall unsafe "LLVMGetAttribute" getAttribute - :: ValueRef -> IO CUInt{-Attribute-} + :: ValueRef -> IO CUInt{-Attribute-} foreign import ccall unsafe "LLVMGetConstOpcode" getConstOpcode - :: ValueRef -> IO CUInt {-Opcode-} + :: ValueRef -> IO CUInt {-Opcode-} foreign import ccall unsafe "LLVMGetCurrentDebugLocation" getCurrentDebugLocation - :: BuilderRef -> IO ValueRef + :: BuilderRef -> IO ValueRef foreign import ccall unsafe "LLVMGetFirstUse" getFirstUse - :: ValueRef -> IO UseRef + :: ValueRef -> IO UseRef foreign import ccall unsafe "LLVMGetFunctionAttr" getFunctionAttr - :: ValueRef -> IO CUInt {-Attribute-} + :: ValueRef -> IO CUInt {-Attribute-} foreign import ccall unsafe "LLVMGetGlobalContext" getGlobalContext - :: IO ContextRef + :: IO ContextRef foreign import ccall unsafe "LLVMGetMDKindID" getMDKindID - :: CString -> CUInt -> IO CUInt + :: CString -> CUInt -> IO CUInt foreign import ccall unsafe "LLVMGetMDKindIDInContext" getMDKindIDInContext - :: ContextRef -> CString -> CUInt -> IO CUInt + :: ContextRef -> CString -> CUInt -> IO CUInt foreign import ccall unsafe "LLVMGetMetadata" getMetadata - :: ValueRef -> CUInt -> IO ValueRef + :: ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMGetNextUse" getNextUse - :: UseRef -> IO UseRef + :: UseRef -> IO UseRef foreign import ccall unsafe "LLVMGetOperand" getOperand - :: ValueRef -> CUInt -> IO ValueRef + :: ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMGetNumOperands" getNumOperands - :: ValueRef -> IO CUInt + :: ValueRef -> IO CUInt {- foreign import ccall unsafe "LLVMGetUnionElementTypes" getUnionElementTypes - :: TypeRef -> (Ptr TypeRef) -> IO () + :: TypeRef -> (Ptr TypeRef) -> IO () -} foreign import ccall unsafe "LLVMValueIsUsedInBasicBlock" isUsedInBasicBlock - :: BasicBlockRef -> ValueRef -> IO CInt + :: BasicBlockRef -> ValueRef -> IO CInt foreign import ccall unsafe "LLVMValueGetNumUses" getNumUses - :: ValueRef -> IO CUInt + :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMGetUsedValue" getUsedValue - :: UseRef -> IO ValueRef + :: UseRef -> IO ValueRef foreign import ccall unsafe "LLVMGetUser" getUser - :: UseRef -> IO ValueRef + :: UseRef -> IO ValueRef foreign import ccall unsafe "LLVMHasMetadata" hasMetadata - :: ValueRef -> IO CInt + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMInsertIntoBuilder" insertIntoBuilder - :: BuilderRef -> ValueRef -> IO () + :: BuilderRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMMDNode" mDNode - :: (Ptr ValueRef) -> CUInt -> IO ValueRef + :: (Ptr ValueRef) -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMMDNodeInContext" mDNodeInContext - :: ContextRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef + :: ContextRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMMDString" mDString - :: CString -> CUInt -> IO ValueRef + :: CString -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMMDStringInContext" mDStringInContext - :: ContextRef -> CString -> CUInt -> IO ValueRef + :: ContextRef -> CString -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMReplaceAllUsesWith" replaceAllUsesWith - :: ValueRef -> ValueRef -> IO () + :: ValueRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMSetCurrentDebugLocation" setCurrentDebugLocation - :: BuilderRef -> ValueRef -> IO () + :: BuilderRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMSetInstDebugLocation" setInstDebugLocation - :: BuilderRef -> ValueRef -> IO () + :: BuilderRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMSetMetadata" setMetadata - :: ValueRef -> CUInt -> ValueRef -> IO () + :: ValueRef -> CUInt -> ValueRef -> IO () {- foreign import ccall unsafe "LLVMUnionType" unionType - :: (Ptr TypeRef) -> CUInt -> IO TypeRef + :: (Ptr TypeRef) -> CUInt -> IO TypeRef foreign import ccall unsafe "LLVMUnionTypeInContext" unionTypeInContext - :: ContextRef -> (Ptr TypeRef) -> CUInt -> IO TypeRef + :: ContextRef -> (Ptr TypeRef) -> CUInt -> IO TypeRef -} diff --git a/base/LLVM/FFI/Target.hsc b/base/LLVM/FFI/Target.hsc index 62e6ef2..5002eb2 100644 --- a/base/LLVM/FFI/Target.hsc +++ b/base/LLVM/FFI/Target.hsc @@ -16,42 +16,41 @@ import LLVM.FFI.Core type ByteOrdering = CInt data TargetData - deriving (Typeable) + deriving (Typeable) type TargetDataRef = Ptr TargetData foreign import ccall unsafe "LLVMABIAlignmentOfType" aBIAlignmentOfType - :: TargetDataRef -> TypeRef -> CUInt + :: TargetDataRef -> TypeRef -> CUInt foreign import ccall unsafe "LLVMABISizeOfType" aBISizeOfType - :: TargetDataRef -> TypeRef -> CULLong + :: TargetDataRef -> TypeRef -> CULLong foreign import ccall unsafe "LLVMAddTargetData" addTargetData - :: TargetDataRef -> PassManagerRef -> IO () + :: TargetDataRef -> PassManagerRef -> IO () foreign import ccall unsafe "LLVMByteOrder" byteOrder - :: TargetDataRef -> ByteOrdering + :: TargetDataRef -> ByteOrdering foreign import ccall unsafe "LLVMCallFrameAlignmentOfType" callFrameAlignmentOfType - :: TargetDataRef -> TypeRef -> CUInt + :: TargetDataRef -> TypeRef -> CUInt foreign import ccall unsafe "LLVMCopyStringRepOfTargetData" copyStringRepOfTargetData - :: TargetDataRef -> IO CString + :: TargetDataRef -> IO CString foreign import ccall unsafe "LLVMCreateTargetData" createTargetData - :: CString -> IO TargetDataRef + :: CString -> IO TargetDataRef foreign import ccall unsafe "LLVMDisposeTargetData" disposeTargetData - :: TargetDataRef -> IO () + :: TargetDataRef -> IO () foreign import ccall unsafe "LLVMElementAtOffset" elementAtOffset - :: TargetDataRef -> TypeRef -> CULLong -> CUInt + :: TargetDataRef -> TypeRef -> CULLong -> CUInt foreign import ccall unsafe "LLVMIntPtrType" intPtrType - :: TargetDataRef -> TypeRef + :: TargetDataRef -> TypeRef -- Removed in LLVM_3.0 ? -- foreign import ccall unsafe "LLVMInvalidateStructLayout" invalidateStructLayout -- :: TargetDataRef -> TypeRef -> IO () foreign import ccall unsafe "LLVMOffsetOfElement" offsetOfElement - :: TargetDataRef -> TypeRef -> CUInt -> CULLong + :: TargetDataRef -> TypeRef -> CUInt -> CULLong foreign import ccall unsafe "LLVMPointerSize" pointerSize - :: TargetDataRef -> CUInt + :: TargetDataRef -> CUInt foreign import ccall unsafe "LLVMPreferredAlignmentOfGlobal" preferredAlignmentOfGlobal - :: TargetDataRef -> ValueRef -> CUInt + :: TargetDataRef -> ValueRef -> CUInt foreign import ccall unsafe "LLVMPreferredAlignmentOfType" preferredAlignmentOfType - :: TargetDataRef -> TypeRef -> CUInt + :: TargetDataRef -> TypeRef -> CUInt foreign import ccall unsafe "LLVMSizeOfTypeInBits" sizeOfTypeInBits - :: TargetDataRef -> TypeRef -> CULLong + :: TargetDataRef -> TypeRef -> CULLong foreign import ccall unsafe "LLVMStoreSizeOfType" storeSizeOfType - :: TargetDataRef -> TypeRef -> CULLong - + :: TargetDataRef -> TypeRef -> CULLong diff --git a/base/cbits/extra.cpp b/base/cbits/extra.cpp index 8a3ea49..616050f 100644 --- a/base/cbits/extra.cpp +++ b/base/cbits/extra.cpp @@ -11,7 +11,7 @@ * this list of conditions and the following disclaimer in the documentation * and/or other materials provided with the distribution. * - * * Neither the name of this software, nor the names of its + * * Neither the name of this software, nor the names of its * contributors may be used to endorse or promote products derived from * this software without specific prior written permission. * @@ -96,75 +96,75 @@ unsigned LLVMInitNativeTarget() char *LLVMDumpModuleToString(LLVMModuleRef module) { - std::string s; - llvm::raw_string_ostream buf(s); - llvm::Module *p = llvm::unwrap(module); - assert(p); - p->print(buf, NULL); - return strdup(buf.str().c_str()); + std::string s; + llvm::raw_string_ostream buf(s); + llvm::Module *p = llvm::unwrap(module); + assert(p); + p->print(buf, NULL); + return strdup(buf.str().c_str()); } char *LLVMDumpTypeToString(LLVMTypeRef type) { - std::string s; - llvm::raw_string_ostream buf(s); - llvm::Type *p = llvm::unwrap(type); - assert(p); - p->print(buf); - return strdup(buf.str().c_str()); + std::string s; + llvm::raw_string_ostream buf(s); + llvm::Type *p = llvm::unwrap(type); + assert(p); + p->print(buf); + return strdup(buf.str().c_str()); } char *LLVMDumpValueToString(LLVMValueRef value) { - std::string s; - llvm::raw_string_ostream buf(s); - llvm::Value *p = llvm::unwrap(value); - assert(p); - p->print(buf); - return strdup(buf.str().c_str()); + std::string s; + llvm::raw_string_ostream buf(s); + llvm::Value *p = llvm::unwrap(value); + assert(p); + p->print(buf); + return strdup(buf.str().c_str()); } unsigned LLVMModuleGetPointerSize(LLVMModuleRef module) { - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); + llvm::Module *modulep = llvm::unwrap(module); + assert(modulep); - llvm::Module::PointerSize p = modulep->getPointerSize(); - if (p == llvm::Module::Pointer32) - return 32; - else if (p == llvm::Module::Pointer64) - return 64; - return 0; + llvm::Module::PointerSize p = modulep->getPointerSize(); + if (p == llvm::Module::Pointer32) + return 32; + else if (p == llvm::Module::Pointer64) + return 64; + return 0; } LLVMValueRef LLVMModuleGetOrInsertFunction(LLVMModuleRef module, - const char *name, LLVMTypeRef function_type) + const char *name, LLVMTypeRef function_type) { - assert(name); + assert(name); - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); + llvm::Module *modulep = llvm::unwrap(module); + assert(modulep); - llvm::FunctionType *ftp = llvm::unwrap(function_type); - assert(ftp); + llvm::FunctionType *ftp = llvm::unwrap(function_type); + assert(ftp); - llvm::Constant *f = modulep->getOrInsertFunction(name, ftp); - return wrap(f); + llvm::Constant *f = modulep->getOrInsertFunction(name, ftp); + return wrap(f); } int LLVMHasInitializer(LLVMValueRef global_var) { - llvm::GlobalVariable *gvp = llvm::unwrap(global_var); - assert(gvp); + llvm::GlobalVariable *gvp = llvm::unwrap(global_var); + assert(gvp); - return gvp->hasInitializer(); + return gvp->hasInitializer(); } #define inst_checkfn(ourfn, llvmfn) \ unsigned ourfn (LLVMValueRef v) { \ - llvm::Instruction *ip = llvm::unwrap(v); \ - assert(ip); \ - return ip-> llvmfn () ? 1 : 0; \ + llvm::Instruction *ip = llvm::unwrap(v); \ + assert(ip); \ + return ip-> llvmfn () ? 1 : 0; \ } inst_checkfn(LLVMInstIsTerminator, isTerminator) @@ -178,32 +178,50 @@ inst_checkfn(LLVMInstIsCommutative, isCommutative) unsigned LLVMInstIsVolatile(LLVMValueRef v) { - using namespace llvm; - Instruction *ip = unwrap(v); - assert(ip); - return ((isa(*ip) && cast(*ip).isVolatile()) || - (isa(*ip) && cast(*ip).isVolatile()) ); + using namespace llvm; + Instruction *ip = unwrap(v); + assert(ip); + return ((isa(*ip) && cast(*ip).isVolatile()) || + (isa(*ip) && cast(*ip).isVolatile()) ); } +LLVMBool LLVMIsConstantExpr(LLVMValueRef Ty) { + using namespace llvm; + return isa(unwrap(Ty)); +} + +LLVMBool LLVMIsCast(LLVMValueRef Ty) { + llvm::ConstantExpr *cep = llvm::unwrap(Ty); + assert(cep); + return cep->isCast(); +} + +LLVMBool LLVMIsStaticGEP(LLVMValueRef Ty) { + llvm::ConstantExpr *cep = llvm::unwrap(Ty); + assert(cep); + return cep->isGEPWithNoNotionalOverIndexing(); +} + + const char *LLVMInstGetOpcodeName(LLVMValueRef inst) { - llvm::Instruction *instp = llvm::unwrap(inst); - assert(instp); - return instp->getOpcodeName(); + llvm::Instruction *instp = llvm::unwrap(inst); + assert(instp); + return instp->getOpcodeName(); } unsigned LLVMInstGetOpcode(LLVMValueRef inst) { - llvm::Instruction *instp = llvm::unwrap(inst); - assert(instp); - return instp->getOpcode(); + llvm::Instruction *instp = llvm::unwrap(inst); + assert(instp); + return instp->getOpcode(); } unsigned LLVMCmpInstGetPredicate(LLVMValueRef cmpinst) { - llvm::CmpInst *instp = llvm::unwrap(cmpinst); - assert(instp); - return instp->getPredicate(); + llvm::CmpInst *instp = llvm::unwrap(cmpinst); + assert(instp); + return instp->getPredicate(); } /* llvm::unwrap a set of `n' wrapped objects starting at `values', @@ -211,311 +229,329 @@ unsigned LLVMCmpInstGetPredicate(LLVMValueRef cmpinst) template void unwrap_vec(W *values, unsigned n, std::vector& out) { - out.clear(); + out.clear(); - while (n--) { - UW *p = llvm::unwrap(*values); - assert(p); - out.push_back(p); - ++values; - } + while (n--) { + UW *p = llvm::unwrap(*values); + assert(p); + out.push_back(p); + ++values; + } } /* Same as llvm::unwrap_vec, but use a vector of const pointers. */ template void unwrap_cvec(W *values, unsigned n, std::vector& out) { - out.clear(); + out.clear(); - while (n--) { - UW *p = llvm::unwrap(*values); - assert(p); - out.push_back(p); - ++values; - } + while (n--) { + UW *p = llvm::unwrap(*values); + assert(p); + out.push_back(p); + ++values; + } } -LLVMValueRef LLVMBuildRetMultiple(LLVMBuilderRef builder, - LLVMValueRef *values, unsigned n_values) +LLVMValueRef LLVMBuildRetMultiple(LLVMBuilderRef builder, + LLVMValueRef *values, unsigned n_values) { - assert(values); + assert(values); - std::vector values_vec; - unwrap_vec(values, n_values, values_vec); + std::vector values_vec; + unwrap_vec(values, n_values, values_vec); - llvm::IRBuilder<> *builderp = llvm::unwrap(builder); - assert(builderp); + llvm::IRBuilder<> *builderp = llvm::unwrap(builder); + assert(builderp); - return llvm::wrap(builderp->CreateAggregateRet(&values_vec[0], values_vec.size())); + return llvm::wrap(builderp->CreateAggregateRet(&values_vec[0], values_vec.size())); } -LLVMValueRef LLVMBuildGetResult(LLVMBuilderRef builder, - LLVMValueRef value, unsigned index, const char *name) +LLVMValueRef LLVMBuildGetResult(LLVMBuilderRef builder, + LLVMValueRef value, unsigned index, const char *name) { - assert(name); + assert(name); - llvm::IRBuilder<> *builderp = llvm::unwrap(builder); - assert(builderp); + llvm::IRBuilder<> *builderp = llvm::unwrap(builder); + assert(builderp); - return llvm::wrap(builderp->CreateExtractValue(llvm::unwrap(value), index, name)); + return llvm::wrap(builderp->CreateExtractValue(llvm::unwrap(value), index, name)); } unsigned LLVMValueGetID(LLVMValueRef value) { - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); + llvm::Value *valuep = llvm::unwrap(value); + assert(valuep); - return valuep->getValueID(); + return valuep->getValueID(); } unsigned LLVMValueGetNumUses(LLVMValueRef value) { - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); + llvm::Value *valuep = llvm::unwrap(value); + assert(valuep); - return valuep->getNumUses(); + return valuep->getNumUses(); } unsigned LLVMValueGetUses(LLVMValueRef value, LLVMValueRef **refs) { - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); + llvm::Value *valuep = llvm::unwrap(value); + assert(valuep); - unsigned n = valuep->getNumUses(); - if (n == 0) - return 0; + unsigned n = valuep->getNumUses(); + if (n == 0) + return 0; - assert(refs); - LLVMValueRef *out = (LLVMValueRef *)malloc(sizeof(LLVMValueRef) * n); - if (!out) - return 0; - *refs = out; + assert(refs); + LLVMValueRef *out = (LLVMValueRef *)malloc(sizeof(LLVMValueRef) * n); + if (!out) + return 0; + *refs = out; - memset(out, 0, sizeof(LLVMValueRef) * n); - llvm::Value::use_iterator it = valuep->use_begin(); - while (it != valuep->use_end()) { - *out++ = llvm::wrap(*it); - ++it; - } + memset(out, 0, sizeof(LLVMValueRef) * n); + llvm::Value::use_iterator it = valuep->use_begin(); + while (it != valuep->use_end()) { + *out++ = llvm::wrap(*it); + ++it; + } - return n; + return n; } unsigned LLVMValueIsUsedInBasicBlock(LLVMValueRef value, LLVMBasicBlockRef bb) { - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); - llvm::BasicBlock *bbp = llvm::unwrap(bb); - assert(bbp); - return valuep->isUsedInBasicBlock(bbp); + llvm::Value *valuep = llvm::unwrap(value); + assert(valuep); + llvm::BasicBlock *bbp = llvm::unwrap(bb); + assert(bbp); + return valuep->isUsedInBasicBlock(bbp); } void LLVMDisposeValueRefArray(LLVMValueRef *refs) { - assert(refs); - free(refs); + assert(refs); + free(refs); } unsigned LLVMUserGetNumOperands(LLVMValueRef user) { - llvm::User *userp = llvm::unwrap(user); - assert(userp); - return userp->getNumOperands(); + llvm::User *userp = llvm::unwrap(user); + assert(userp); + return userp->getNumOperands(); } LLVMValueRef LLVMUserGetOperand(LLVMValueRef user, unsigned idx) { - llvm::User *userp = llvm::unwrap(user); - assert(userp); - llvm::Value *operand = userp->getOperand(idx); - return llvm::wrap(operand); + llvm::User *userp = llvm::unwrap(user); + assert(userp); + llvm::Value *operand = userp->getOperand(idx); + return llvm::wrap(operand); } unsigned LLVMGetDoesNotThrow(LLVMValueRef fn) { - llvm::Function *fnp = llvm::unwrap(fn); - assert(fnp); + llvm::Function *fnp = llvm::unwrap(fn); + assert(fnp); - return fnp->doesNotThrow(); + return fnp->doesNotThrow(); } void LLVMSetDoesNotThrow(LLVMValueRef fn, int DoesNotThrow) { - llvm::Function *fnp = llvm::unwrap(fn); - assert(fnp); + llvm::Function *fnp = llvm::unwrap(fn); + assert(fnp); - return fnp->setDoesNotThrow((bool)DoesNotThrow); + return fnp->setDoesNotThrow(); } LLVMValueRef LLVMGetIntrinsic(LLVMModuleRef module, int id, - LLVMTypeRef *types, unsigned n_types) + LLVMTypeRef *types, unsigned n_types) { - assert(types); + assert(types); #if HS_LLVM_VERSION >= 300 - std::vector types_vec; - unwrap_vec(types, n_types, types_vec); + std::vector types_vec; + unwrap_vec(types, n_types, types_vec); #else - std::vector types_vec; - unwrap_cvec(types, n_types, types_vec); + std::vector types_vec; + unwrap_cvec(types, n_types, types_vec); #endif - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); + llvm::Module *modulep = llvm::unwrap(module); + assert(modulep); #if HS_LLVM_VERSION >= 300 - llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, - llvm::Intrinsic::ID(id), types_vec); + llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, + llvm::Intrinsic::ID(id), types_vec); #else - llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, - llvm::Intrinsic::ID(id), &types_vec[0], types_vec.size()); + llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, + llvm::Intrinsic::ID(id), &types_vec[0], types_vec.size()); #endif - return wrap(intfunc); + return wrap(intfunc); } LLVMModuleRef LLVMGetModuleFromAssembly(const char *asmtext, unsigned txtlen, - char **out) + char **out) { - assert(asmtext); - assert(out); + assert(asmtext); + assert(out); - llvm::Module *modulep; - llvm::SMDiagnostic error; - if (!(modulep = llvm::ParseAssemblyString(asmtext, NULL, error, - llvm::getGlobalContext()))) { - std::string s; - llvm::raw_string_ostream buf(s); - error.Print("llvm-py", buf); - *out = strdup(buf.str().c_str()); - return NULL; - } + llvm::Module *modulep; + llvm::SMDiagnostic error; + if (!(modulep = llvm::ParseAssemblyString(asmtext, NULL, error, + llvm::getGlobalContext()))) { + std::string s; + llvm::raw_string_ostream buf(s); + error.print("llvm-py", buf, true); + *out = strdup(buf.str().c_str()); + return NULL; + } - return wrap(modulep); + return wrap(modulep); } LLVMModuleRef LLVMGetModuleFromBitcode(const char *bitcode, unsigned bclen, - char **out) + char **out) { - assert(bitcode); - assert(out); + assert(bitcode); + assert(out); - llvm::StringRef as_str(bitcode, bclen); + llvm::StringRef as_str(bitcode, bclen); - llvm::MemoryBuffer *mbp; - if (!(mbp = llvm::MemoryBuffer::getMemBufferCopy(as_str))) - return NULL; + llvm::MemoryBuffer *mbp; + if (!(mbp = llvm::MemoryBuffer::getMemBufferCopy(as_str))) + return NULL; - std::string msg; - llvm::Module *modulep; - if (!(modulep = llvm::ParseBitcodeFile(mbp, llvm::getGlobalContext(), - &msg))) - *out = strdup(msg.c_str()); + std::string msg; + llvm::Module *modulep; + if (!(modulep = llvm::ParseBitcodeFile(mbp, llvm::getGlobalContext(), + &msg))) + *out = strdup(msg.c_str()); - delete mbp; - return wrap(modulep); + delete mbp; + return wrap(modulep); } unsigned LLVMLinkModules(LLVMModuleRef dest, LLVMModuleRef src, unsigned mode, char **out) { - llvm::Module *sourcep = llvm::unwrap(src); - assert(sourcep); - llvm::Module *destinationp = llvm::unwrap(dest); - assert(destinationp); + llvm::Module *sourcep = llvm::unwrap(src); + assert(sourcep); + llvm::Module *destinationp = llvm::unwrap(dest); + assert(destinationp); - std::string msg; - bool err; + std::string msg; + bool err; -#if HS_LLVM_VERSION >= 300 - err = llvm::Linker::LinkModules(destinationp, sourcep, mode, &msg); +#if HS_LLVM_VERSION >= 300 + err = llvm::Linker::LinkModules(destinationp, sourcep, mode, &msg); #else - err = llvm::Linker::LinkModules(destinationp, sourcep, &msg); + err = llvm::Linker::LinkModules(destinationp, sourcep, &msg); #endif - if (err) { - *out = strdup(msg.c_str()); - return 0; - } + if (err) { + *out = strdup(msg.c_str()); + return 0; + } - return 1; + return 1; } unsigned char *LLVMGetBitcodeFromModule(LLVMModuleRef module, unsigned *lenp) { - assert(lenp); + assert(lenp); - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); + llvm::Module *modulep = llvm::unwrap(module); + assert(modulep); - /* get bc into a string */ - std::string s; - llvm::raw_string_ostream buf(s); - llvm::WriteBitcodeToFile(modulep, buf); - const std::string& bc = buf.str(); + /* get bc into a string */ + std::string s; + llvm::raw_string_ostream buf(s); + llvm::WriteBitcodeToFile(modulep, buf); + const std::string& bc = buf.str(); - /* and then into a malloc()-ed block */ - size_t bclen = bc.size(); - unsigned char *bytes = (unsigned char *)malloc(bclen); - if (!bytes) - return NULL; - memcpy(bytes, bc.data(), bclen); + /* and then into a malloc()-ed block */ + size_t bclen = bc.size(); + unsigned char *bytes = (unsigned char *)malloc(bclen); + if (!bytes) + return NULL; + memcpy(bytes, bc.data(), bclen); - /* return */ - *lenp = bclen; - return bytes; + /* return */ + *lenp = bclen; + return bytes; } /* Return 0 on failure (with errmsg filled in), 1 on success. */ unsigned LLVMLoadLibraryPermanently(const char* filename, char **errmsg) { - assert(filename); - assert(errmsg); + assert(filename); + assert(errmsg); - /* Note: the LLVM API returns true on failure. Don't ask why. */ - std::string msg; - if (llvm::sys::DynamicLibrary::LoadLibraryPermanently(filename, &msg)) { - *errmsg = strdup(msg.c_str()); - return 0; - } + /* Note: the LLVM API returns true on failure. Don't ask why. */ + std::string msg; + if (llvm::sys::DynamicLibrary::LoadLibraryPermanently(filename, &msg)) { + *errmsg = strdup(msg.c_str()); + return 0; + } - return 1; + return 1; } void *LLVMGetPointerToFunction(LLVMExecutionEngineRef ee, LLVMValueRef fn) { - llvm::ExecutionEngine *eep = llvm::unwrap(ee); - assert(eep); + llvm::ExecutionEngine *eep = llvm::unwrap(ee); + assert(eep); - llvm::Function *fnp = llvm::unwrap(fn); - assert(fnp); + llvm::Function *fnp = llvm::unwrap(fn); + assert(fnp); - return eep->getPointerToFunction(fnp); + return eep->getPointerToFunction(fnp); } int LLVMInlineFunction(LLVMValueRef call) { - llvm::Value *callp = llvm::unwrap(call); - assert(callp); + llvm::Value *callp = llvm::unwrap(call); + assert(callp); - llvm::CallSite cs = llvm::CallSite(callp); + llvm::CallSite cs = llvm::CallSite(callp); - llvm::InlineFunctionInfo unused; - return llvm::InlineFunction(cs, unused); + llvm::InlineFunctionInfo unused; + return llvm::InlineFunction(cs, unused); } +LLVMBool LLVMIsZeroInitialized(LLVMValueRef Ty) { + return llvm::isa(llvm::unwrap(Ty)); +} + +LLVMBool LLVMIsCString(LLVMValueRef Val) { + if (llvm::ConstantDataSequential *C = llvm::dyn_cast(llvm::unwrap(Val))) + return C->isCString(); + return false; +} + +const char *LLVMGetAsCString(LLVMValueRef Val) { + if (llvm::ConstantDataSequential *C = llvm::dyn_cast(llvm::unwrap(Val))) + return (C->getAsString()).str().c_str(); + return NULL; +} + + + /* Passes. A few passes (listed below) are used directly from LLVM-C, * rest are defined here. */ #define define_pass(P) \ void LLVMAdd ## P ## Pass (LLVMPassManagerRef passmgr) { \ - using namespace llvm; \ - llvm::PassManagerBase *pmp = llvm::unwrap(passmgr); \ - assert(pmp); \ - pmp->add( create ## P ## Pass ()); \ + using namespace llvm; \ + llvm::PassManagerBase *pmp = llvm::unwrap(passmgr); \ + assert(pmp); \ + pmp->add( create ## P ## Pass ()); \ } define_pass( AAEval ) @@ -540,7 +576,7 @@ define_pass( InstCount ) define_pass( InstructionNamer ) define_pass( LazyValueInfo ) define_pass( LCSSA ) -define_pass( LoopDependenceAnalysis ) +//define_pass( LoopDependenceAnalysis ) define_pass( LoopExtractor ) define_pass( LoopSimplify ) define_pass( LoopStrengthReduce ) @@ -564,6 +600,5 @@ define_pass( StripNonDebugSymbols ) define_pass( UnifyFunctionExitNodes ) /* we support only internalize(true) */ -llvm::ModulePass *createInternalize2Pass() { return llvm::createInternalizePass(true); } +llvm::ModulePass *createInternalize2Pass() { return llvm::createInternalizePass(); } define_pass( Internalize2 ) - diff --git a/base/configure.ac b/base/configure.ac index 026eb7c..7f4b078 100644 --- a/base/configure.ac +++ b/base/configure.ac @@ -85,7 +85,7 @@ LDFLAGS="$llvm_ldflags $LDFLAGS $TARGET_LDFLAGS" llvm_extra_ghci_libs="" -AC_SEARCH_LIBS([LLVMModuleCreateWithName],[LLVM-2.7 LLVM-2.8 LLVM-2.9 LLVM-3.0]) +AC_SEARCH_LIBS([LLVMModuleCreateWithName],[LLVM-2.7 LLVM-2.8 LLVM-2.9 LLVM-3.0 LLVM-3.2]) if test "$ac_cv_search_LLVMModuleCreateWithName" = "no"; then llvm_all_libs="`$llvm_config --libs all`" else @@ -117,15 +117,15 @@ AC_CHECK_HEADERS([llvm/Support/DynamicLibrary.h], [], [], save_LIBS="$LIBS" LIBS="-lLLVMSupport -lpthread -ldl $LIBS" -AC_CHECK_LIB(LLVMCore, LLVMModuleCreateWithName, [], []) -if test "$ac_cv_lib_LLVMCore_LLVMModuleCreateWithName" = "no"; then - unset ac_cv_lib_LLVMCore_LLVMModuleCreateWithName - LIBS="-lLLVMSupport $save_LIBS" - AC_CHECK_LIB(LLVMCore, LLVMModuleCreateWithName, [], - [AC_MSG_ERROR(could not find LLVM C bindings)]) -fi +dnl AC_CHECK_LIB(LLVMCore, LLVMModuleCreateWithName, [], []) +dnl if test "$ac_cv_lib_LLVMCore_LLVMModuleCreateWithName" = "no"; then +dnl unset ac_cv_lib_LLVMCore_LLVMModuleCreateWithName +dnl LIBS="-lLLVMSupport $save_LIBS" +dnl AC_CHECK_LIB(LLVMCore, LLVMModuleCreateWithName, [], +dnl [AC_MSG_ERROR(could not find LLVM C bindings)]) +dnl fi -llvm_num_version="`echo $llvm_version | tr . 0`" +llvm_num_version="`echo $llvm_version | tr . 0 | tr -d svn`" AC_DEFINE_UNQUOTED([HS_LLVM_VERSION], [$llvm_num_version], [Define to the version of LLVM, e.g. 209 for 2.9.]) diff --git a/base/include/extra.h b/base/include/extra.h index da5bc1c..2d3332f 100644 --- a/base/include/extra.h +++ b/base/include/extra.h @@ -146,6 +146,12 @@ unsigned LLVMInstIsTrapping (LLVMValueRef inst); /* As above, but these are wrap methods from subclasses of Instruction. */ unsigned LLVMInstIsVolatile (LLVMValueRef inst); +LLVMBool LLVMIsConstantExpr(LLVMValueRef Ty); + +LLVMBool LLVMIsCast(LLVMValueRef Ty); + +LLVMBool LLVMIsStaticGEP(LLVMValueRef Ty); + /* Wraps llvm::Instruction::getOpcodeName(). */ const char *LLVMInstGetOpcodeName(LLVMValueRef inst); @@ -191,6 +197,15 @@ void *LLVMGetPointerToFunction(LLVMExecutionEngineRef ee, LLVMValueRef fn); * containing the call is still in a proper state (not changed). */ int LLVMInlineFunction(LLVMValueRef call); +/* Checks if a constant was declared with zeroinitializer */ +LLVMBool LLVMIsZeroInitialized(LLVMValueRef Ty); + +/* Checks if a constant is an ASCII string */ +LLVMBool LLVMIsCString(LLVMValueRef Val); + +/* Returns string content (zero-terminated) */ +const char *LLVMGetAsCString(LLVMValueRef Val); + /* Passes. Some passes are used directly from LLVM-C, rest are declared * here. */