diff --git a/LLVM/FFI/Analysis.hsc b/LLVM/FFI/Analysis.hsc --- a/LLVM/FFI/Analysis.hsc +++ b/LLVM/FFI/Analysis.hsc @@ -14,9 +14,9 @@ type VerifierFailureAction = CInt foreign import ccall unsafe "LLVMVerifyFunction" verifyFunction - :: ValueRef -> VerifierFailureAction -> IO Bool + :: ValueRef -> VerifierFailureAction -> IO CInt foreign import ccall unsafe "LLVMVerifyModule" verifyModule - :: ModuleRef -> VerifierFailureAction -> (Ptr CString) -> IO Bool + :: ModuleRef -> VerifierFailureAction -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMViewFunctionCFG" viewFunctionCFG :: ValueRef -> IO () foreign import ccall unsafe "LLVMViewFunctionCFGOnly" viewFunctionCFGOnly diff --git a/LLVM/FFI/BitReader.hsc b/LLVM/FFI/BitReader.hsc --- a/LLVM/FFI/BitReader.hsc +++ b/LLVM/FFI/BitReader.hsc @@ -12,14 +12,14 @@ import LLVM.FFI.Core foreign import ccall unsafe "LLVMGetBitcodeModuleProvider" getBitcodeModuleProvider - :: MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO Bool + :: MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMParseBitcode" parseBitcode - :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool + :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMGetBitcodeModuleProviderInContext" getBitcodeModuleProviderInContext - :: ContextRef -> MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO Bool + :: ContextRef -> MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMParseBitcodeInContext" parseBitcodeInContext - :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool + :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMGetBitcodeModule" getBitcodeModule - :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool + :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMGetBitcodeModuleInContext" getBitcodeModuleInContext - :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool + :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt diff --git a/LLVM/FFI/BitWriter.hsc b/LLVM/FFI/BitWriter.hsc --- a/LLVM/FFI/BitWriter.hsc +++ b/LLVM/FFI/BitWriter.hsc @@ -11,8 +11,8 @@ import LLVM.FFI.Core foreign import ccall unsafe "LLVMWriteBitcodeToFile" writeBitcodeToFile - :: ModuleRef -> CString -> IO Bool + :: ModuleRef -> CString -> IO CInt foreign import ccall unsafe "LLVMWriteBitcodeToFileHandle" writeBitcodeToFileHandle - :: ModuleRef -> CInt -> IO Bool + :: ModuleRef -> CInt -> IO CInt foreign import ccall unsafe "LLVMWriteBitcodeToFD" writeBitcodeToFD - :: ModuleRef -> CInt -> Bool -> Bool -> IO Bool + :: ModuleRef -> CInt -> CInt -> CInt -> IO CInt diff --git a/LLVM/FFI/Core.hsc b/LLVM/FFI/Core.hsc --- a/LLVM/FFI/Core.hsc +++ b/LLVM/FFI/Core.hsc @@ -135,7 +135,7 @@ , setSection , getAlignment , setAlignment - + -- ** Global variables , addGlobal , getNamedGlobal @@ -646,12 +646,12 @@ :: TypeRef -- ^ return type -> Ptr TypeRef -- ^ array of argument types -> CUInt -- ^ number of elements in array - -> Bool -- ^ non-zero if function is varargs + -> CInt -- ^ non-zero if function is varargs -> TypeRef -- | Indicate whether a function takes varargs. foreign import ccall unsafe "LLVMIsFunctionVarArg" isFunctionVarArg - :: TypeRef -> IO Bool + :: TypeRef -> IO CInt -- | Give a function's return type. foreign import ccall unsafe "LLVMGetReturnType" getReturnType @@ -683,7 +683,7 @@ #if HS_LLVM_VERSION < 300 foreign import ccall unsafe "LLVMAddTypeName" addTypeName - :: ModuleRef -> CString -> TypeRef -> IO Bool + :: ModuleRef -> CString -> TypeRef -> IO CInt foreign import ccall unsafe "LLVMDeleteTypeName" deleteTypeName :: ModuleRef -> CString -> IO () @@ -714,16 +714,16 @@ :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMIsThreadLocal" isThreadLocal - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMSetThreadLocal" setThreadLocal - :: ValueRef -> Bool -> IO () + :: ValueRef -> CInt -> IO () foreign import ccall unsafe "LLVMIsGlobalConstant" isGlobalConstant - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMSetGlobalConstant" setGlobalConstant - :: ValueRef -> Bool -> IO () + :: ValueRef -> CInt -> IO () foreign import ccall unsafe "LLVMTypeOf" typeOf :: ValueRef -> IO TypeRef @@ -747,16 +747,16 @@ :: TypeRef -> ValueRef foreign import ccall unsafe "LLVMIsConstant" isConstant - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMGetUndef" getUndef :: TypeRef -> ValueRef foreign import ccall unsafe "LLVMIsNull" isNull - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMIsUndef" isUndef - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMGetNamedFunction" getNamedFunction :: ModuleRef -- ^ module @@ -833,12 +833,12 @@ :: ValueRef -> CString -> IO () foreign import ccall unsafe "LLVMIsDeclaration" isDeclaration - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt -- |An enumeration for the kinds of linkage for global values. data Linkage = ExternalLinkage -- ^Externally visible function - | AvailableExternallyLinkage + | 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) @@ -849,7 +849,7 @@ | 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 + | 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) @@ -873,7 +873,7 @@ 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 @@ -933,16 +933,16 @@ foreign import ccall unsafe "LLVMConstInt" constInt - :: TypeRef -> CULLong -> Bool -> ValueRef + :: TypeRef -> CULLong -> CInt -> ValueRef foreign import ccall unsafe "LLVMConstReal" constReal :: TypeRef -> CDouble -> ValueRef foreign import ccall unsafe "LLVMConstString" constString - :: CString -> CUInt -> Bool -> ValueRef + :: CString -> CUInt -> CInt -> ValueRef foreign import ccall unsafe "LLVMConstStruct" constStruct - :: Ptr ValueRef -> CUInt -> Bool -> ValueRef + :: Ptr ValueRef -> CUInt -> CInt -> ValueRef foreign import ccall unsafe "LLVMConstVector" constVector :: Ptr ValueRef -> CUInt -> ValueRef @@ -1062,7 +1062,7 @@ :: BasicBlockRef -> ValueRef foreign import ccall unsafe "LLVMValueIsBasicBlock" valueIsBasicBlock - :: ValueRef -> Bool + :: ValueRef -> CInt foreign import ccall unsafe "LLVMValueAsBasicBlock" valueAsBasicBlock :: ValueRef -- ^ basic block @@ -1316,20 +1316,20 @@ :: ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMGetIncomingBlock" getIncomingBlock :: ValueRef -> CUInt -> IO BasicBlockRef - + foreign import ccall unsafe "LLVMGetInstructionCallConv" getInstructionCallConv :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMSetInstructionCallConv" setInstructionCallConv :: ValueRef -> CUInt -> IO () foreign import ccall unsafe "LLVMStructType" structType - :: Ptr TypeRef -> CUInt -> Bool -> TypeRef + :: Ptr TypeRef -> CUInt -> CInt -> TypeRef foreign import ccall unsafe "LLVMCountStructElementTypes" countStructElementTypes :: TypeRef -> CUInt foreign import ccall unsafe "LLVMGetStructElementTypes" getStructElementTypes :: TypeRef -> Ptr TypeRef -> IO () foreign import ccall unsafe "LLVMIsPackedStruct" isPackedStruct - :: TypeRef -> Bool + :: TypeRef -> CInt data MemoryBuffer deriving (Typeable) @@ -1364,11 +1364,11 @@ getTypeKind = fmap (toEnum . fromIntegral) . getTypeKindCUInt foreign import ccall unsafe "LLVMCreateMemoryBufferWithContentsOfFile" createMemoryBufferWithContentsOfFile - :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO Bool + :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO CInt foreign import ccall unsafe "LLVMCreateMemoryBufferWithSTDIN" createMemoryBufferWithSTDIN - :: Ptr MemoryBufferRef -> Ptr CString -> IO Bool + :: Ptr MemoryBufferRef -> Ptr CString -> IO CInt foreign import ccall unsafe "LLVMCreateMemoryBufferWithMemoryRange" createMemoryBufferWithMemoryRange - :: Ptr a -> CSize -> CString -> Bool -> IO MemoryBufferRef + :: Ptr a -> CSize -> CString -> CInt -> IO MemoryBufferRef foreign import ccall unsafe "LLVMCreateMemoryBufferWithMemoryRangeCopy" createMemoryBufferWithMemoryRangeCopy :: Ptr a -> CSize -> CString -> IO MemoryBufferRef foreign import ccall unsafe "LLVMDisposeMemoryBuffer" disposeMemoryBuffer @@ -1409,7 +1409,7 @@ foreign import ccall unsafe "LLVMGetStructName" getStructName :: TypeRef -> IO CString foreign import ccall unsafe "LLVMStructSetBody" structSetBody - :: TypeRef -> Ptr TypeRef -> CUInt -> Bool -> IO () + :: TypeRef -> Ptr TypeRef -> CUInt -> CUInt -> IO () #endif data Attribute @@ -1509,9 +1509,9 @@ foreign import ccall unsafe "LLVMDumpValueToString" dumpValueToString :: ValueRef -> IO CString foreign import ccall unsafe "LLVMPrintModuleToFile" printModuleToFile - :: ModuleRef -> CString -> (Ptr CString) -> IO Bool + :: ModuleRef -> CString -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMFinalizeFunctionPassManager" finalizeFunctionPassManager - :: PassManagerRef -> IO Bool + :: PassManagerRef -> IO CInt foreign import ccall unsafe "LLVMGetBasicBlockParent" getBasicBlockParent :: BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMGetFirstBasicBlock" getFirstBasicBlock @@ -1563,15 +1563,15 @@ foreign import ccall unsafe "LLVMGetPreviousParam" getPreviousParam :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMInitializeFunctionPassManager" initializeFunctionPassManager - :: PassManagerRef -> IO Bool + :: PassManagerRef -> IO CInt foreign import ccall unsafe "LLVMLabelType" labelType :: TypeRef foreign import ccall unsafe "LLVMPositionBuilder" positionBuilder :: BuilderRef -> BasicBlockRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMRunFunctionPassManager" runFunctionPassManager - :: PassManagerRef -> ValueRef -> IO Bool + :: PassManagerRef -> ValueRef -> IO CInt foreign import ccall unsafe "LLVMRunPassManager" runPassManager - :: PassManagerRef -> ModuleRef -> IO Bool + :: PassManagerRef -> ModuleRef -> IO CInt foreign import ccall unsafe "LLVMSetInstrParamAlignment" setInstrParamAlignment :: ValueRef -> CUInt -> CUInt -> IO () foreign import ccall unsafe "LLVMSetParamAlignment" setParamAlignment @@ -1594,13 +1594,13 @@ foreign import ccall unsafe "LLVMAddInstrAttribute" addInstrAttribute :: ValueRef -> CUInt -> CAttribute -> IO () foreign import ccall unsafe "LLVMIsTailCall" isTailCall - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMRemoveAttribute" removeAttribute :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMRemoveInstrAttribute" removeInstrAttribute :: ValueRef -> CUInt -> CAttribute -> IO () foreign import ccall unsafe "LLVMSetTailCall" setTailCall - :: ValueRef -> Bool -> IO () + :: ValueRef -> CInt -> IO () foreign import ccall unsafe "LLVMAddFunctionAttr" addFunctionAttr :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMAlignOf" alignOf @@ -1676,9 +1676,9 @@ foreign import ccall unsafe "LLVMConstSExtOrBitCast" constSExtOrBitCast :: ValueRef -> TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMConstStringInContext" constStringInContext - :: ContextRef -> CString -> CUInt -> Bool -> IO ValueRef + :: ContextRef -> CString -> CUInt -> CInt -> IO ValueRef foreign import ccall unsafe "LLVMConstStructInContext" constStructInContext - :: ContextRef -> (Ptr ValueRef) -> CUInt -> Bool -> IO ValueRef + :: ContextRef -> (Ptr ValueRef) -> CUInt -> CInt -> IO ValueRef foreign import ccall unsafe "LLVMConstTruncOrBitCast" constTruncOrBitCast :: ValueRef -> TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMConstZExtOrBitCast" constZExtOrBitCast @@ -1730,7 +1730,7 @@ foreign import ccall unsafe "LLVMRemoveFunctionAttr" removeFunctionAttr :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMStructTypeInContext" structTypeInContext - :: ContextRef -> (Ptr TypeRef) -> CUInt -> Bool -> IO TypeRef + :: ContextRef -> (Ptr TypeRef) -> CUInt -> CInt -> IO TypeRef foreign import ccall unsafe "LLVMVoidTypeInContext" voidTypeInContext :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMX86FP80TypeInContext" x86FP80TypeInContext @@ -1776,7 +1776,7 @@ foreign import ccall unsafe "LLVMConstExtractValue" constExtractValue :: ValueRef -> Ptr CUInt -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstInlineAsm" constInlineAsm - :: TypeRef -> CString -> CString -> Bool -> Bool -> IO ValueRef + :: TypeRef -> CString -> CString -> CInt -> CInt -> IO ValueRef foreign import ccall unsafe "LLVMConstInsertValue" constInsertValue :: ValueRef -> ValueRef -> Ptr CUInt -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstIntGetSExtValue" constIntGetSExtValue @@ -1838,7 +1838,7 @@ :: TypeRef -> (Ptr TypeRef) -> IO () -} foreign import ccall unsafe "LLVMValueIsUsedInBasicBlock" isUsedInBasicBlock - :: BasicBlockRef -> ValueRef -> IO Bool + :: BasicBlockRef -> ValueRef -> IO CInt foreign import ccall unsafe "LLVMValueGetNumUses" getNumUses :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMGetUsedValue" getUsedValue @@ -1846,7 +1846,7 @@ foreign import ccall unsafe "LLVMGetUser" getUser :: UseRef -> IO ValueRef foreign import ccall unsafe "LLVMHasMetadata" hasMetadata - :: ValueRef -> IO Bool + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMInsertIntoBuilder" insertIntoBuilder :: BuilderRef -> ValueRef -> IO () foreign import ccall unsafe "LLVMMDNode" mdNode diff --git a/LLVM/FFI/ExecutionEngine.hsc b/LLVM/FFI/ExecutionEngine.hsc --- a/LLVM/FFI/ExecutionEngine.hsc +++ b/LLVM/FFI/ExecutionEngine.hsc @@ -151,11 +151,11 @@ foreign import ccall unsafe "LLVMAddModule" addModule :: ExecutionEngineRef -> ModuleRef -> IO () foreign import ccall unsafe "LLVMCreateExecutionEngineForModule" createExecutionEngineForModule - :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO Bool + :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMCreateInterpreterForModule" createInterpreterForModule - :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO Bool + :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule - :: (Ptr ExecutionEngineRef) -> ModuleRef -> CUInt -> (Ptr CString) -> IO Bool + :: (Ptr ExecutionEngineRef) -> ModuleRef -> CUInt -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine :: ExecutionEngineRef -> IO () {- @@ -163,4 +163,4 @@ :: GenericValueRef -> IO () -} foreign import ccall unsafe "LLVMRemoveModule" removeModule - :: ExecutionEngineRef -> ModuleRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool + :: ExecutionEngineRef -> ModuleRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt diff --git a/LLVM/FFI/Linker.hsc b/LLVM/FFI/Linker.hsc --- a/LLVM/FFI/Linker.hsc +++ b/LLVM/FFI/Linker.hsc @@ -3,7 +3,7 @@ module LLVM.FFI.Linker where import LLVM.FFI.Core import Foreign.C.String(CString) -import Foreign.C.Types(CUInt(..)) +import Foreign.C.Types(CUInt(..), CInt(..)) import Foreign.Ptr(Ptr) #include @@ -21,4 +21,4 @@ toLinkerMode c = error $ "LLVM.FFI.Linker.toLinkerMode: unrecognized linker mode" ++ show c foreign import ccall unsafe "LLVMLinkModules" linkModules - :: ModuleRef -> ModuleRef -> CUInt -> Ptr CString -> IO Bool + :: ModuleRef -> ModuleRef -> CUInt -> Ptr CString -> IO CInt diff --git a/LLVM/FFI/Support.hsc b/LLVM/FFI/Support.hsc --- a/LLVM/FFI/Support.hsc +++ b/LLVM/FFI/Support.hsc @@ -26,7 +26,7 @@ #if HS_LLVM_VERSION >= 300 foreign import ccall unsafe "LLVMAddEmitObjectPass" addEmitObjectPass - :: ModuleRef -> CString -> IO CUInt + :: ModuleRef -> CString -> IO CUInt #endif foreign import ccall unsafe "LLVMDisablePrettyStackTrace" disablePrettyStackTrace diff --git a/LLVM/FFI/Transforms/PassManagerBuilder.hsc b/LLVM/FFI/Transforms/PassManagerBuilder.hsc --- a/LLVM/FFI/Transforms/PassManagerBuilder.hsc +++ b/LLVM/FFI/Transforms/PassManagerBuilder.hsc @@ -33,4 +33,4 @@ :: PassManagerBuilderRef -> PassManagerRef -> IO () foreign import ccall unsafe "LLVMPassManagerBuilderPopulateLTOPassManager" passManagerBuilderPopulateLTOPassManager - :: PassManagerBuilderRef -> PassManagerRef -> Bool -> Bool -> IO () + :: PassManagerBuilderRef -> PassManagerRef -> CInt -> CInt -> IO () diff --git a/LLVM/Target/Native.hs b/LLVM/Target/Native.hs --- a/LLVM/Target/Native.hs +++ b/LLVM/Target/Native.hs @@ -9,7 +9,7 @@ -- TARGET is expanded by CPP to the native target architecture. import LLVM.Target.TARGET -foreign import ccall unsafe "LLVMInitNativeTarget" +foreign import ccall unsafe "LLVMInitNativeTarget" llvmInitializeNativeTarget :: IO CUInt -- | Initialize jitter to the native target. diff --git a/LLVM/Wrapper/Analysis.hs b/LLVM/Wrapper/Analysis.hs --- a/LLVM/Wrapper/Analysis.hs +++ b/LLVM/Wrapper/Analysis.hs @@ -7,19 +7,20 @@ import Foreign.C.String (peekCString) import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Utils (toBool) import Foreign.Storable (peek) import Foreign.ForeignPtr.Safe (withForeignPtr) -- VerifierFailureAction 2 is 'no side effects' verifyFunction :: Value -> IO Bool -verifyFunction f = FFI.verifyFunction f 2 +verifyFunction f = fmap toBool $ FFI.verifyFunction f 2 verifyModule :: Module -> IO (Maybe String) verifyModule (MkModule m _) = alloca $ \msgPtr -> do result <- withForeignPtr m (\m' -> FFI.verifyModule m' 2 msgPtr) msg <- peek msgPtr - if not result + if not . toBool $ result then return Nothing else do str <- peekCString msg FFI.disposeMessage msg diff --git a/LLVM/Wrapper/BitReader.hs b/LLVM/Wrapper/BitReader.hs --- a/LLVM/Wrapper/BitReader.hs +++ b/LLVM/Wrapper/BitReader.hs @@ -1,6 +1,7 @@ module LLVM.Wrapper.BitReader (parseBitcodeInContext) where import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Utils (toBool) import Foreign.C.String (peekCString) import Foreign.Storable (peek) import Foreign.ForeignPtr.Safe (withForeignPtr) @@ -17,7 +18,7 @@ withForeignPtr ctx $ \ctx' -> withForeignPtr buf $ \buf' -> do errOccurred <- FFI.parseBitcodeInContext ctx' buf' modPtr msgPtr - if errOccurred + if toBool errOccurred then fmap Left $ peek msgPtr >>= peekCString else fmap Right $ peek modPtr >>= initModule @@ -29,6 +30,6 @@ withForeignPtr ctx $ \ctx' -> withForeignPtr buf $ \buf' -> do errOccurred <- FFI.getBitcodeModuleInContext ctx' buf' modPtr msgPtr - if errOccurred + if toBool errOccurred then fmap Left $ peek msgPtr >>= peekCString else fmap Right $ peek modPtr >>= initModule diff --git a/LLVM/Wrapper/BitWriter.hs b/LLVM/Wrapper/BitWriter.hs --- a/LLVM/Wrapper/BitWriter.hs +++ b/LLVM/Wrapper/BitWriter.hs @@ -11,5 +11,5 @@ writeBitcodeToFile :: Module -> FilePath -> IO () writeBitcodeToFile (MkModule m _) p = do result <- withForeignPtr m (withCString p . FFI.writeBitcodeToFile) - when result $ + when (result /= 0) $ fail $ "Failed to write bitcode to " ++ p diff --git a/LLVM/Wrapper/Core.hs b/LLVM/Wrapper/Core.hs --- a/LLVM/Wrapper/Core.hs +++ b/LLVM/Wrapper/Core.hs @@ -49,7 +49,10 @@ , setLinkage , constStructInContext + , isConstant, isNull, isUndef + -- ** Scalar constants + , constInt , constRealOfString , constString , constStringInContext @@ -80,6 +83,8 @@ , addAttribute , removeAttribute , addFunctionAttr + , isTailCall + , setTailCall -- ** Metadata , setMetadata @@ -198,6 +203,7 @@ import Foreign.C.Types import Foreign.Marshal.Array import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Utils (fromBool, toBool) import Foreign.Storable (peek) import Foreign.ForeignPtr.Safe (ForeignPtr, withForeignPtr, newForeignPtr, newForeignPtr_) import System.IO.Unsafe (unsafePerformIO) @@ -233,11 +239,8 @@ , constNull , constPointerNull , getUndef - , constInt , constReal - , isConstant, isNull, isUndef - , constInBoundsGEP , constIntCast , constIntOfString @@ -305,8 +308,6 @@ , constNUWNeg , constNUWSub - , isTailCall - , setTailCall , deleteFunction , createModuleProviderForExistingModule @@ -353,7 +354,7 @@ alloca $ \msgPtr -> do errOccurred <- withCString path $ \cpath -> FFI.createMemoryBufferWithContentsOfFile cpath bufPtr msgPtr - if errOccurred + if toBool errOccurred then peek msgPtr >>= peekCString >>= fail else peek bufPtr >>= newForeignPtr FFI.ptrDisposeMemoryBuffer @@ -362,13 +363,13 @@ alloca $ \bufPtr -> alloca $ \msgPtr -> do errOccurred <- FFI.createMemoryBufferWithSTDIN bufPtr msgPtr - if errOccurred + if toBool errOccurred then peek msgPtr >>= peekCString >>= fail else peek bufPtr >>= newForeignPtr FFI.ptrDisposeMemoryBuffer createMemoryBufferWithMemoryRange :: Ptr a -> CSize -> String -> Bool -> IO MemoryBuffer createMemoryBufferWithMemoryRange p len name nullTerm = - withCString name (\cname -> FFI.createMemoryBufferWithMemoryRange p len cname nullTerm) + withCString name (\cname -> FFI.createMemoryBufferWithMemoryRange p len cname (fromBool nullTerm)) >>= newForeignPtr FFI.ptrDisposeMemoryBuffer createMemoryBufferWithMemoryRangeCopy :: Ptr a -> CSize -> String -> IO MemoryBuffer @@ -390,7 +391,7 @@ (\f -> alloca (\msgPtr -> do result <- withForeignPtr m (\modPtr -> FFI.printModuleToFile modPtr f msgPtr) msg <- peek msgPtr - when result $ do + when (toBool result) $ do str <- peekCString msg FFI.disposeMessage msg fail str)) @@ -435,7 +436,7 @@ runPassManager (MkPassManager p) (MkModule m _) = withForeignPtr m $ \mptr -> withForeignPtr p $ \pptr -> - FFI.runPassManager pptr mptr + fmap toBool $ FFI.runPassManager pptr mptr createFunctionPassManagerForModule :: Module -> IO PassManager createFunctionPassManagerForModule (MkModule m _) = @@ -443,15 +444,15 @@ initializeFunctionPassManager :: PassManager -> IO Bool initializeFunctionPassManager (MkPassManager p) = - withForeignPtr p FFI.initializeFunctionPassManager + fmap toBool $ withForeignPtr p FFI.initializeFunctionPassManager runFunctionPassManager :: PassManager -> Value -> IO Bool runFunctionPassManager (MkPassManager p) f = - withForeignPtr p (`FFI.runFunctionPassManager` f) + fmap toBool $ withForeignPtr p (`FFI.runFunctionPassManager` f) finalizeFunctionPassManager :: PassManager -> IO Bool finalizeFunctionPassManager (MkPassManager p) = - withForeignPtr p FFI.finalizeFunctionPassManager + fmap toBool $ withForeignPtr p FFI.finalizeFunctionPassManager addFunction :: Module -> String -> Type -> IO Value addFunction (MkModule m _) name ty = withForeignPtr m (\mPtr -> withCString name (\n -> FFI.addFunction mPtr n ty)) @@ -495,19 +496,19 @@ functionType :: Type -> [Type] -> Bool -> Type functionType returnTy argTys isVarArg = unsafePerformIO $ withArrayLen argTys $ \len ptr -> - return $ FFI.functionType returnTy ptr (fromIntegral len) isVarArg + return $ FFI.functionType returnTy ptr (fromIntegral len) (fromBool isVarArg) -- unsafePerformIO just to wrap the non-effecting withArrayLen call structType :: [Type] -> Bool -> Type structType types packed = unsafePerformIO $ withArrayLen types $ \ len ptr -> - return $ FFI.structType ptr (fromIntegral len) packed + return $ FFI.structType ptr (fromIntegral len) (fromBool packed) structTypeInContext :: Context -> [Type] -> Bool -> IO Type structTypeInContext ctx types packed = withForeignPtr ctx $ \ctx' -> withArrayLen types $ \ len ptr -> - FFI.structTypeInContext ctx' ptr (fromIntegral len) packed + FFI.structTypeInContext ctx' ptr (fromIntegral len) (fromBool packed) structCreateNamed :: String -> IO Type structCreateNamed name = do @@ -521,7 +522,7 @@ structSetBody :: Type -> [Type] -> Bool -> IO () structSetBody struct body packed = withArrayLen body $ \len ptr -> - FFI.structSetBody struct ptr (fromIntegral len) packed + FFI.structSetBody struct ptr (fromIntegral len) (fromBool packed) appendBasicBlock :: Value -> String -> IO BasicBlock appendBasicBlock function name = withCString name $ FFI.appendBasicBlock function @@ -557,8 +558,20 @@ constStructInContext ctx values packed = withForeignPtr ctx $ \ctx' -> withArrayLen values $ \ len ptr -> - FFI.constStructInContext ctx' ptr (fromIntegral len) packed + FFI.constStructInContext ctx' ptr (fromIntegral len) (fromBool packed) +isConstant :: Value -> IO Bool +isConstant = fmap toBool . FFI.isConstant + +isNull :: Value -> IO Bool +isNull = fmap toBool . FFI.isNull + +isUndef :: Value -> IO Bool +isUndef = fmap toBool . FFI.isUndef + +constInt :: Type -> CULLong -> Bool -> Value +constInt ity value signExtend = FFI.constInt ity value (fromBool signExtend) + -- unsafePerformIO just to wrap the non-effecting withCString call constRealOfString :: Type -> String -> Value constRealOfString ty str @@ -568,13 +581,13 @@ constString :: String -> Bool -> Value constString str dontNullTerminate = unsafePerformIO $ withCStringLen str $ \(ptr, len) -> - return $ FFI.constString ptr (fromIntegral len) dontNullTerminate + return $ FFI.constString ptr (fromIntegral len) (fromBool dontNullTerminate) constStringInContext :: Context -> String -> Bool -> IO Value constStringInContext ctx str dontNullTerminate = withForeignPtr ctx $ \ctx' -> withCStringLen str $ \(ptr, len) -> - FFI.constStringInContext ctx' ptr (fromIntegral len) dontNullTerminate + FFI.constStringInContext ctx' ptr (fromIntegral len) (fromBool dontNullTerminate) createBuilder :: IO Builder createBuilder = FFI.createBuilder >>= newForeignPtr FFI.ptrDisposeBuilder @@ -719,6 +732,12 @@ addFunctionAttr :: Value -> Attribute -> IO () addFunctionAttr v a = FFI.addFunctionAttr v $ FFI.fromAttribute a + +isTailCall :: Value -> IO Bool +isTailCall = fmap toBool . FFI.isTailCall + +setTailCall :: Value -> Bool -> IO () +setTailCall f = FFI.setTailCall f . fromBool setMetadata :: Value -> MetadataKind -> Value -> IO () setMetadata instruction kind = FFI.setMetadata instruction (FFI.fromMetadataKind kind) diff --git a/LLVM/Wrapper/ExecutionEngine.hs b/LLVM/Wrapper/ExecutionEngine.hs --- a/LLVM/Wrapper/ExecutionEngine.hs +++ b/LLVM/Wrapper/ExecutionEngine.hs @@ -84,7 +84,7 @@ = alloca $ \msgPtr -> alloca $ \eeref -> do r <- FFI.EE.createJITCompilerForModule eeref m optlvl msgPtr - if r + if toBool r then peek msgPtr >>= peekCString >>= fail else peek eeref @@ -93,7 +93,7 @@ = alloca $ \msgPtr -> alloca $ \eeref -> do r <- FFI.EE.createInterpreterForModule eeref m msgPtr - if r + if toBool r then peek msgPtr >>= peekCString >>= fail else peek eeref @@ -102,6 +102,6 @@ = alloca $ \msgPtr -> alloca $ \eeref -> do r <- FFI.EE.createExecutionEngineForModule eeref m msgPtr - if r + if toBool r then peek msgPtr >>= peekCString >>= fail else peek eeref diff --git a/LLVM/Wrapper/Linker.hs b/LLVM/Wrapper/Linker.hs --- a/LLVM/Wrapper/Linker.hs +++ b/LLVM/Wrapper/Linker.hs @@ -9,6 +9,7 @@ import Foreign.C.String (peekCString) import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Utils (toBool) import Foreign.Storable (peek) import Foreign.ForeignPtr.Safe (withForeignPtr) @@ -22,7 +23,7 @@ result <- FFI.linkModules dest' src' (FFI.fromLinkerMode mode) msgPtr writeIORef srcOurs False msg <- peek msgPtr - if not result + if not . toBool $ result then return Nothing else do str <- peekCString msg FFI.disposeMessage msg diff --git a/LLVM/Wrapper/Target.hs b/LLVM/Wrapper/Target.hs --- a/LLVM/Wrapper/Target.hs +++ b/LLVM/Wrapper/Target.hs @@ -16,9 +16,9 @@ , aBIAlignmentOfType , aBISizeOfType , pointerSize - , preferredAlignmentOfGlobal - , preferredAlignmentOfType - , sizeOfTypeInBits + , preferredAlignmentOfGlobal + , preferredAlignmentOfType + , sizeOfTypeInBits , storeSizeOfType , elementAtOffset , offsetOfElement diff --git a/LLVM/Wrapper/Transforms/PassManagerBuilder.hs b/LLVM/Wrapper/Transforms/PassManagerBuilder.hs --- a/LLVM/Wrapper/Transforms/PassManagerBuilder.hs +++ b/LLVM/Wrapper/Transforms/PassManagerBuilder.hs @@ -2,6 +2,7 @@ import Foreign.C.Types import Foreign.ForeignPtr.Safe (withForeignPtr) +import Foreign.Marshal.Utils (fromBool, toBool) import qualified LLVM.FFI.Transforms.PassManagerBuilder as FFI import LLVM.Wrapper.Internal @@ -33,5 +34,5 @@ passManagerBuilderPopulateLTOPassManager (MkPassManagerBuilder b) (MkPassManager m) internalize inline = withForeignPtr b $ \bptr -> withForeignPtr m $ \mptr -> - FFI.passManagerBuilderPopulateLTOPassManager bptr mptr internalize inline + FFI.passManagerBuilderPopulateLTOPassManager bptr mptr (fromBool internalize) (fromBool inline) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -50,6 +50,10 @@ http://hackage.haskell.org/trac/ghc/ticket/3658 http://hackage.haskell.org/trac/ghc/ticket/5987 +ghci versions < 7.7 have their own special linker, we do not support it. +ghci versions >= 7.7 use the system dynamic linker, we do support it. +If you have a problem using llvm-base with ghci >= 7.7 please file a bug report. + Staying in touch ---------------- diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} import System.Directory import System.Environment import System.FilePath @@ -17,10 +19,11 @@ import Distribution.Simple.Register import Distribution.Simple.Utils import Distribution.Text ( display ) +import Language.Haskell.TH main = do - let hooks = autoconfUserHooks { postConf = if os == "mingw32" - then generateBuildInfo + let hooks = autoconfUserHooks { postConf = if os == "mingw32" + then generateBuildInfo else postConf autoconfUserHooks , instHook = installHookWithExtraGhciLibraries , regHook = regHookWithExtraGhciLibraries @@ -79,14 +82,46 @@ else setupMessage verbosity "Package contains no library to register:" (packageId pkg_descr) where verbosity = fromFlag (regVerbosity flags) - + + + +{- +this is the workaround for conditional compilation if template haskell was more + permissive, but isn't + + --- what i'd like to write, but can't because template haskell rejecting + the branch that has the wrong api version + extractCLBI x= + $(if cabalVersion >= Version [1,17,0] [] + then [| getComponentLocalBuildInfo 'x CLibName |] + else [| + let LocalBuildInfo { libraryConfig = Just clbi } = 'x + in clbi |] + ) + + +-} + +--- horrible hack to support cabal versions both above and below 1.17 +extractCLBI x= + $(if cabalVersion >= Version [1,17,0] [] + then appE (appE ( varE $ mkName "getComponentLocalBuildInfo") ( varE 'x) ) (conE ( mkName "CLibName")) + + else letE + [valD (recP + (mkName "LocalBuildInfo" ) + [fieldPat (mkName "libraryConfig") + (conP (mkName "Just") [varP $ mkName "clbi"] ) ] ) + (normalB $ varE 'x) [] ] + (varE $ mkName "clbi") ) + register' :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () register' pkg@PackageDescription { library = Just lib } - lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags + lbi regFlags = do - + let clbi = extractCLBI lbi installedPkgInfoRaw <- generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref diff --git a/cbits/extra.cpp b/cbits/extra.cpp --- a/cbits/extra.cpp +++ b/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. * @@ -34,6 +34,13 @@ * Python bindings. */ +#ifndef __STDC_LIMIT_MACROS +#define __STDC_LIMIT_MACROS +#endif +#ifndef __STDC_CONSTANT_MACROS +#define __STDC_CONSTANT_MACROS +#endif + #include "hs_llvm_config.h" // standard includes @@ -42,9 +49,6 @@ #include #include -#define __STDC_LIMIT_MACROS -#define __STDC_CONSTANT_MACROS - // LLVM includes #if HS_LLVM_VERSION < 303 #include "llvm/LLVMContext.h" @@ -268,7 +272,7 @@ } } -LLVMValueRef LLVMBuildRetMultiple(LLVMBuilderRef builder, +LLVMValueRef LLVMBuildRetMultiple(LLVMBuilderRef builder, LLVMValueRef *values, unsigned n_values) { assert(values); @@ -282,7 +286,7 @@ return llvm::wrap(builderp->CreateAggregateRet(&values_vec[0], values_vec.size())); } -LLVMValueRef LLVMBuildGetResult(LLVMBuilderRef builder, +LLVMValueRef LLVMBuildGetResult(LLVMBuilderRef builder, LLVMValueRef value, unsigned index, const char *name) { assert(name); @@ -399,10 +403,10 @@ assert(modulep); #if HS_LLVM_VERSION >= 300 - llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, + llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, llvm::Intrinsic::ID(id), types_vec); #else - llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, + llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, llvm::Intrinsic::ID(id), &types_vec[0], types_vec.size()); #endif return wrap(intfunc); @@ -452,7 +456,7 @@ #if HS_LLVM_VERSION < 302 unsigned LLVMLinkModules(LLVMModuleRef dest, LLVMModuleRef src, unsigned mode, - char **out) + char **out) { llvm::Module *sourcep = llvm::unwrap(src); assert(sourcep); @@ -462,7 +466,7 @@ std::string msg; bool err; -#if HS_LLVM_VERSION >= 300 +#if HS_LLVM_VERSION >= 300 err = llvm::Linker::LinkModules(destinationp, sourcep, mode, &msg); #else err = llvm::Linker::LinkModules(destinationp, sourcep, &msg); @@ -562,7 +566,7 @@ std::string features = ""; // llvm::StringMap featureMap (10); - + // // this returns false at the moment, but it appears to not make a huge difference // // as the next iteration just doesn't do anything. // llvm::sys::getHostCPUFeatures (featureMap); @@ -576,7 +580,7 @@ // } - llvm::TargetMachine *machine = + llvm::TargetMachine *machine = Target->createTargetMachine (triple, cpu, features, llvm::TargetOptions()); @@ -593,7 +597,7 @@ false)) return false; - + llvm::Module *mod = llvm::unwrap (modRef); pass_manager.run (*mod); @@ -601,72 +605,29 @@ } #endif -/* Passes. A few passes (listed below) are used directly from LLVM-C, - * rest are defined here. - */ +/* Passes */ -#define define_pass(P) \ +/* we support only internalize(true) */ +llvm::ModulePass *createInternalize2Pass() { + return llvm::createInternalizePass(); +} + +/* All passes are listed in passes-inl.h + * The list is shared between extra.cpp and extra.h. + * + * In this file the declare_or_define_pass macro is used to expand + * the passes into function definitions. + */ +#define declare_or_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 ()); \ } - -define_pass( AAEval ) -define_pass( AliasAnalysisCounter ) -define_pass( AlwaysInliner ) -// Name conflicts with those in LLVM proper, have a safer prefix? -// define_pass( BasicAliasAnalysis ) -define_pass( BlockPlacement ) -define_pass( BreakCriticalEdges ) -define_pass( CodeGenPrepare ) -#if HS_LLVM_VERSION < 303 -define_pass( DbgInfoPrinter ) -#endif -define_pass( DeadCodeElimination ) -define_pass( DeadInstElimination ) -define_pass( DemoteRegisterToMemory ) -define_pass( DomOnlyPrinter ) -define_pass( DomOnlyViewer ) -define_pass( DomPrinter ) -define_pass( DomViewer ) -define_pass( DependenceAnalysis ) -define_pass( EdgeProfiler ) -define_pass( GlobalsModRef ) -define_pass( InstCount ) -define_pass( InstructionNamer ) -define_pass( LazyValueInfo ) -define_pass( LCSSA ) -define_pass( LoopExtractor ) -define_pass( LoopSimplify ) -define_pass( LoopStrengthReduce ) -define_pass( LowerInvoke ) -define_pass( LowerSwitch ) -define_pass( MergeFunctions ) -define_pass( NoAA ) -define_pass( NoProfileInfo ) -define_pass( OptimalEdgeProfiler ) -define_pass( PartialInlining ) -define_pass( PostDomOnlyPrinter ) -define_pass( PostDomOnlyViewer ) -define_pass( PostDomPrinter ) -define_pass( PostDomViewer ) -define_pass( ProfileEstimator ) -define_pass( ProfileLoader ) -define_pass( ProfileVerifier ) -define_pass( ScalarEvolutionAliasAnalysis ) -define_pass( SingleLoopExtractor ) -define_pass( StripNonDebugSymbols ) -define_pass( UnifyFunctionExitNodes ) -define_pass( Internalize ) - -/* we support only internalize(true) */ -llvm::ModulePass *createInternalize2Pass() { - return llvm::createInternalizePass(); -} +#include "passes-inl.h" +#undef declare_or_define_pass -define_pass( Internalize2 ) #if HS_LLVM_VERSION < 302 LLVMBool LLVMPrintModuleToFile(LLVMModuleRef M, const char *Filename, diff --git a/cbits/free.c b/cbits/free.c --- a/cbits/free.c +++ b/cbits/free.c @@ -1,13 +1,18 @@ +#ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS +#endif +#ifndef __STDC_CONSTANT_MACROS #define __STDC_CONSTANT_MACROS +#endif + #include #include /* C function to free function object resources. Can be called from a finalizer. */ void c_freeFunctionObject(LLVMExecutionEngineRef execEngine, - LLVMModuleProviderRef moduleProvider, - LLVMValueRef f) + LLVMModuleProviderRef moduleProvider, + LLVMValueRef f) { LLVMModuleRef mod; LLVMFreeMachineCodeForFunction(execEngine, f); diff --git a/cbits/support.cpp b/cbits/support.cpp --- a/cbits/support.cpp +++ b/cbits/support.cpp @@ -1,5 +1,9 @@ +#ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS +#endif +#ifndef __STDC_CONSTANT_MACROS #define __STDC_CONSTANT_MACROS +#endif #include "hs_llvm_config.h" @@ -23,7 +27,7 @@ using namespace llvm; void LLVMCreateStandardFunctionPasses(LLVMPassManagerRef PM, - unsigned OptimizationLevel) + unsigned OptimizationLevel) { #if HS_LLVM_VERSION >= 300 llvm::PassManagerBuilder Builder; @@ -44,13 +48,13 @@ } void LLVMCreateStandardModulePasses(LLVMPassManagerRef PM, - unsigned OptLevel, - int OptimizeSize, - int UnitAtATime, - int UnrollLoops, - int SimplifyLibCalls, - int HaveExceptions, - int DisableInline) + unsigned OptLevel, + int OptimizeSize, + int UnitAtATime, + int UnrollLoops, + int SimplifyLibCalls, + int HaveExceptions, + int DisableInline) { #if HS_LLVM_VERSION >= 300 llvm::PassManagerBuilder Builder; @@ -59,7 +63,7 @@ Builder.DisableUnrollLoops = !UnrollLoops; Builder.DisableSimplifyLibCalls = !SimplifyLibCalls; Builder.DisableUnitAtATime = !UnitAtATime; - + Pass *InliningPass = 0; if (DisableInline) { diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -31,7 +31,7 @@ AC_PATH_PROGS(llvm_config, [llvm-config], [AC_MSG_ERROR(could not find llvm-config in $llvm_bindir)], ["$llvm_bindir:$PATH"]) - + dnl * Choose target platform dnl dnl We don't use the standard autoconf macros for this, but instead @@ -86,7 +86,7 @@ llvm_extra_ghci_libs="" -AC_SEARCH_LIBS([LLVMModuleCreateWithName],[LLVM-2.7 LLVM-2.8 LLVM-2.9 LLVM-3.0 LLVM-3.1 LLVM-3.2]) +AC_SEARCH_LIBS([LLVMModuleCreateWithName],[LLVM-2.7 LLVM-2.8 LLVM-2.9 LLVM-3.0 LLVM-3.1 LLVM-3.2]) if test "$ac_cv_search_LLVMModuleCreateWithName" = "no"; then llvm_all_libs="`$llvm_config --libs all`" else diff --git a/include/extra.h b/include/extra.h --- a/include/extra.h +++ b/include/extra.h @@ -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. * @@ -102,14 +102,14 @@ LLVMValueRef LLVMConstVFCmp(LLVMRealPredicate predicate, LLVMValueRef lhs, LLVMValueRef rhs); -/* Wraps llvm::IRBuilder::CreateVICmp(). */ +/* Wraps llvm::IRBuilder::CreateVICmp(). */ LLVMValueRef LLVMBuildVICmp(LLVMBuilderRef builder, LLVMIntPredicate predicate, LLVMValueRef lhs, LLVMValueRef rhs, const char *name); -/* Wraps llvm::IRBuilder::CreateVFCmp(). */ +/* Wraps llvm::IRBuilder::CreateVFCmp(). */ LLVMValueRef LLVMBuildVFCmp(LLVMBuilderRef builder, LLVMRealPredicate predicate, LLVMValueRef lhs, LLVMValueRef rhs, const char *name); - + /* Wraps llvm::Intrinsic::getDeclaration(). */ LLVMValueRef LLVMGetIntrinsic(LLVMModuleRef builder, int id, LLVMTypeRef *types, unsigned n_types); @@ -118,12 +118,12 @@ unsigned LLVMModuleGetPointerSize(LLVMModuleRef module); /* Wraps llvm::Module::getOrInsertFunction(). */ -LLVMValueRef LLVMModuleGetOrInsertFunction(LLVMModuleRef module, +LLVMValueRef LLVMModuleGetOrInsertFunction(LLVMModuleRef module, const char *name, LLVMTypeRef function_type); -/* Wraps llvm::GlobalVariable::hasInitializer(). */ +/* Wraps llvm::GlobalVariable::hasInitializer(). */ int LLVMHasInitializer(LLVMValueRef global_var); - + /* The following functions wrap various llvm::Instruction::isXXX() functions. * All of them take an instruction and return 0 (isXXX returned false) or 1 * (isXXX returned false). */ @@ -166,7 +166,7 @@ * filled in) and 1 on success. Dispose error message after use with * LLVMDisposeMessage(). */ unsigned LLVMLinkModules(LLVMModuleRef dest, LLVMModuleRef src, - unsigned mode, char **errmsg); + unsigned mode, char **errmsg); #endif /* Returns pointer to a heap-allocated block of `*len' bytes containing bit code @@ -178,12 +178,12 @@ * use, via LLVMDisposeMessage(). */ unsigned LLVMLoadLibraryPermanently(const char* filename, char **errmsg); -/* Wraps llvm::ExecutionEngine::getPointerToFunction(). Returns a pointer +/* Wraps llvm::ExecutionEngine::getPointerToFunction(). Returns a pointer * to the JITted function. */ void *LLVMGetPointerToFunction(LLVMExecutionEngineRef ee, LLVMValueRef fn); -/* Wraps llvm::InlineFunction(). Inlines a function. C is the call - * instruction, created by LLVMBuildCall. Even if it fails, the Function +/* Wraps llvm::InlineFunction(). Inlines a function. C is the call + * instruction, created by LLVMBuildCall. Even if it fails, the Function * containing the call is still in a proper state (not changed). */ int LLVMInlineFunction(LLVMValueRef call); @@ -191,60 +191,16 @@ bool LLVMAddEmitObjectPass (LLVMModuleRef modRef, const char* filename); #endif -/* Passes. Some passes are used directly from LLVM-C, rest are declared - * here. */ - -#define declare_pass(P) \ +/* All passes are listed in passes-inl.h + * The list is shared between extra.cpp and extra.h. + * + * In this file the declare_or_define_pass macro is used to expand + * the passes into function declarations. + */ +#define declare_or_define_pass(P) \ void LLVMAdd ## P ## Pass (LLVMPassManagerRef PM); - -declare_pass( AAEval ) -declare_pass( AliasAnalysisCounter ) -declare_pass( AlwaysInliner ) -// Name conflicts with those in LLVM proper, have a safer prefix? -// declare_pass( BasicAliasAnalysis ) -declare_pass( BlockPlacement ) -declare_pass( BreakCriticalEdges ) -declare_pass( CodeGenPrepare ) -declare_pass( DbgInfoPrinter ) -declare_pass( DeadCodeElimination ) -declare_pass( DeadInstElimination ) -declare_pass( DemoteRegisterToMemory ) -declare_pass( DomOnlyPrinter ) -declare_pass( DomOnlyViewer ) -declare_pass( DomPrinter ) -declare_pass( DomViewer ) -declare_pass( EdgeProfiler ) -declare_pass( GlobalsModRef ) -declare_pass( InstCount ) -declare_pass( InstructionNamer ) -declare_pass( LazyValueInfo ) -declare_pass( LCSSA ) -declare_pass( LoopDependenceAnalysis ) -declare_pass( LoopExtractor ) -declare_pass( LoopSimplify ) -declare_pass( LoopStrengthReduce ) -declare_pass( LowerInvoke ) -declare_pass( LowerSwitch ) -declare_pass( MergeFunctions ) -declare_pass( NoAA ) -declare_pass( NoProfileInfo ) -declare_pass( OptimalEdgeProfiler ) -declare_pass( PartialInlining ) -declare_pass( PostDomOnlyPrinter ) -declare_pass( PostDomOnlyViewer ) -declare_pass( PostDomPrinter ) -declare_pass( PostDomViewer ) -declare_pass( ProfileEstimator ) -declare_pass( ProfileLoader ) -declare_pass( ProfileVerifier ) -declare_pass( ScalarEvolutionAliasAnalysis ) -declare_pass( SingleLoopExtractor ) -declare_pass( StripNonDebugSymbols ) -declare_pass( StructRetPromotion ) -declare_pass( TailDuplication ) -declare_pass( UnifyFunctionExitNodes ) - -declare_pass( Internalize2 ) +#include "passes-inl.h" +#undef declare_or_define_pass #if HS_LLVM_VERSION < 302 LLVMBool LLVMPrintModuleToFile(LLVMModuleRef M, const char *Filename, char **ErrorMessage); diff --git a/include/support.h b/include/support.h --- a/include/support.h +++ b/include/support.h @@ -6,16 +6,16 @@ #endif void LLVMCreateStandardFunctionPasses(LLVMPassManagerRef PM, - unsigned OptimizationLevel); + unsigned OptimizationLevel); void LLVMCreateStandardModulePasses(LLVMPassManagerRef PM, - unsigned OptimizationLevel, - int OptimizeSize, - int UnitAtATime, - int UnrollLoops, - int SimplifyLibCalls, - int HaveExceptions, - int DisableInlining); + unsigned OptimizationLevel, + int OptimizeSize, + int UnitAtATime, + int UnrollLoops, + int SimplifyLibCalls, + int HaveExceptions, + int DisableInlining); void LLVMDisablePrettyStackTrace(); diff --git a/llvm-base.cabal b/llvm-base.cabal --- a/llvm-base.cabal +++ b/llvm-base.cabal @@ -1,5 +1,5 @@ name: llvm-base -version: 3.2.0.0 +version: 3.2.0.1 license: BSD3 license-file: LICENSE synopsis: FFI bindings to the LLVM compiler toolkit. @@ -7,7 +7,7 @@ FFI bindings to the LLVM compiler toolkit. . We try to stay up to date with LLVM releases. The current version - of this package is compatible with LLVM 3.0 and 2.9. Please + of this package is compatible with at least LLVM 3.2. Please understand that the package may or may not work against older LLVM releases; we don't have the time or resources to test across multiple releases. diff --git a/tools/FunctionMangulation.hs b/tools/FunctionMangulation.hs --- a/tools/FunctionMangulation.hs +++ b/tools/FunctionMangulation.hs @@ -51,13 +51,13 @@ rewriteFunction cret cname cparams = let ret = "IO " ++ renameType (strip cret) params = map renameParam . split (==',') $ cparams - params' = if params == ["()"] then [] else params + params' = if params == ["()"] then [] else params name = let (n:ame) = cname in toLower n : ame in foreign ++ "\"LLVM" ++ cname ++ "\" " ++ name ++ "\n :: " ++ intercalate " -> " (params' ++ [ret]) where renameParam = renameType . dropName . strip foreign = "foreign import ccall unsafe " - + rewrite :: Monad m => String -> m [String] rewrite s = do matches <- s =~~ pattern