llvm 0.6.8.0 → 0.7.0.0

raw patch · 49 files changed

+916/−98 lines, 49 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• INSTALL.txt +1/−1
• LICENSE +3/−1
• LLVM/Core.hs +4/−5
• LLVM/Core/CodeGen.hs +6/−28
• LLVM/Core/Instructions.hs +17/−4
• LLVM/Core/Util.hs +2/−2
• LLVM/FFI/BitReader.hsc +4/−0
• LLVM/FFI/Core.hsc +303/−31
• LLVM/FFI/ExecutionEngine.hsc +11/−0
• LLVM/FFI/Transforms/IPO.hsc +34/−0
• LLVM/FFI/Transforms/Scalar.hsc +33/−10
• LLVM/Target/ARM.hs +10/−0
• LLVM/Target/Alpha.hs +10/−0
• LLVM/Target/Blackfin.hs +10/−0
• LLVM/Target/CBackend.hs +10/−0
• LLVM/Target/CellSPU.hs +10/−0
• LLVM/Target/CppBackend.hs +10/−0
• LLVM/Target/MSIL.hs +10/−0
• LLVM/Target/MSP430.hs +10/−0
• LLVM/Target/Mips.hs +10/−0
• LLVM/Target/Native.hs +20/−0
• LLVM/Target/PIC16.hs +10/−0
• LLVM/Target/PowerPC.hs +10/−0
• LLVM/Target/Sparc.hs +10/−0
• LLVM/Target/SystemZ.hs +10/−0
• LLVM/Target/X86.hs +10/−0
• LLVM/Target/XCore.hs +10/−0
• LLVM/Util/Optimize.hs +109/−0
• Makefile +1/−0
• cbits/free.c +2/−0
• configure +4/−3
• configure.ac +4/−2
• examples/Align.hs +3/−0
• examples/Arith.hs +2/−0
• examples/Array.hs +5/−0
• examples/BrainF.hs +3/−0
• examples/DotProd.hs +2/−0
• examples/Fibonacci.hs +6/−0
• examples/HelloJIT.hs +1/−0
• examples/Makefile +2/−2
• examples/Struct.hs +40/−0
• examples/Varargs.hs +36/−0
• examples/Vector.hs +2/−0
• examples/structCheck.c +9/−0
• llvm.buildinfo.in +3/−3
• llvm.buildinfo.windows.in +3/−3
• llvm.cabal +25/−2
• tools/FunctionMangulation.hs +65/−0
• tools/Makefile +1/−1

@@ -10,7 +10,7 @@ -------------  Firstly, you'll need to have LLVM.  I recommend installing LLVM-version 2.5 (from llvm.org) which is what it's been tested with.+version 2.6 (from llvm.org) which is what it's been tested with.  Install from source.: Build this and install it somewhere.  Follow the LLVM instructions,

@@ -4,13 +4,15 @@ University of Illinois/NCSA Open Source License -Copyright (c) 2007 Bryan O'Sullivan+Copyright (c) 2007-2009 Bryan O'Sullivan All rights reserved.  Developed by:      Bryan O'Sullivan <bos@serpentine.com>     http://www.serpentine.com/blog/++    Lennart Augustsson <lennart@augustsson.net>  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the

@@ -27,6 +27,8 @@ -- @createX@.  Furthermore, an explicit name can be given to an entity by the -- @newNamedX@ function; the @newX@ function just generates a fresh name. module LLVM.Core(+    -- * Initialize+    initializeNativeTarget,     -- * Modules     Module, newModule, newNamedModule, defineModule, destroyModule, createModule,     ModuleProvider, createModuleProviderForExistingModule,@@ -64,11 +66,7 @@     addAttributes, Attribute(..),     castVarArgs,     -- * Debugging-    dumpValue, dumpType, getValueName,-    -- * Transformations-    addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass,-    addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass,-    addTargetData+    dumpValue, dumpType, getValueName     ) where import qualified LLVM.FFI.Core as FFI import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, getModuleValues, valueHasType)@@ -79,6 +77,7 @@ import LLVM.Core.Instructions import LLVM.Core.Type import LLVM.Core.Vector+import LLVM.Target.Native  -- |Print a value. dumpValue :: Value a -> IO ()

@@ -5,6 +5,7 @@     getModuleValues, ModuleValue, castModuleValue,     -- * Globals     Linkage(..),+    Visibility(..),     -- * Function creation     Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction,     addAttributes,@@ -35,6 +36,7 @@ import Data.TypeLevel hiding (Bool, Eq, (+), (==)) import LLVM.Core.CodeGenMonad import qualified LLVM.FFI.Core as FFI+import LLVM.FFI.Core(Linkage(..), Visibility(..)) import qualified LLVM.Core.Util as U import LLVM.Core.Type import LLVM.Core.Data@@ -177,7 +179,7 @@ newNamedFunction linkage name = do     modul <- getModule     let typ = typeRef (undefined :: a)-    liftIO $ liftM Value $ U.addFunction modul (fromIntegral $ fromEnum linkage) name typ+    liftIO $ liftM Value $ U.addFunction modul linkage name typ  -- | Create a new function.  Use 'newNamedFunction' to create a function with external linkage, since -- it needs a known name.@@ -316,7 +318,7 @@             let linkage = ExternalLinkage             modul <- getFunctionModule             let typ = typeRef (undefined :: a)-            f <- liftIO $ U.addFunction modul (fromIntegral $ fromEnum linkage) name typ+            f <- liftIO $ U.addFunction modul linkage name typ             putExterns ((name, f) : es) 	    return $ Value f @@ -345,7 +347,7 @@ newNamedGlobal isConst linkage name = do     modul <- getModule     let typ = typeRef (undefined :: a)-    liftIO $ liftM Value $ do g <- U.addGlobal modul (fromIntegral $ fromEnum linkage) name typ+    liftIO $ liftM Value $ do g <- U.addGlobal modul linkage name typ     	     	   	      when isConst $ FFI.setGlobalConstant g 1 			      return g @@ -387,34 +389,10 @@     modul <- getModule     name <- genMSym "str"     let typ = FFI.arrayType (typeRef (undefined :: Word8)) (fromIntegral n)-    liftIO $ liftM Value $ do g <- U.addGlobal modul (fromIntegral $ fromEnum InternalLinkage) name typ+    liftIO $ liftM Value $ do g <- U.addGlobal modul InternalLinkage name typ     	     	   	      FFI.setGlobalConstant g 1 			      FFI.setInitializer g s 			      return g-------------------------------------------- |An enumeration for the kinds of linkage for global values.-data Linkage-    = ExternalLinkage     -- ^Externally visible function-    | LinkOnceLinkage     -- ^Keep one copy of function when linking (inline)-    | WeakLinkage         -- ^Keep one copy of named function when linking (weak)-    | AppendingLinkage    -- ^Special purpose, only applies to global arrays-    | InternalLinkage     -- ^Rename collisions when linking (static functions)-    | 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    -    deriving (Show, Eq, Ord, Enum, Typeable)--{---- |An enumeration for the kinds of visibility of global values.-data VisibilityTypes-    = DefaultVisibility   -- ^The GV is visible-    | HiddenVisibility    -- ^The GV is hidden-    | ProtectedVisibility -- ^The GV is protected-    deriving (Show, Eq, Ord, Enum)--}  -------------------------------------- 

@@ -12,6 +12,7 @@     -- | Arithmetic operations with the normal semantics.     -- The u instractions are unsigned, the s instructions are signed.     add, sub, mul, neg,+    fadd, fsub, fmul, -- fneg,     udiv, sdiv, fdiv, urem, srem, frem,     -- * Logical binary operations     -- |Logical instructions with the normal semantics.@@ -153,11 +154,11 @@ class ABinOp a b c | a b -> c where     abinop :: FFIConstBinOp -> FFIBinOp -> a -> b -> CodeGenFunction r c -add :: (IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c)+add :: ({-IsInteger-} IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) add = abinop FFI.constAdd FFI.buildAdd-sub :: (IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c)+sub :: ({-IsInteger-} IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) sub = abinop FFI.constSub FFI.buildSub-mul :: (IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c)+mul :: ({-IsInteger-} IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) mul = abinop FFI.constMul FFI.buildMul  udiv :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c)@@ -169,6 +170,13 @@ srem :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) srem = abinop FFI.constSRem FFI.buildSRem +fadd :: (IsFloating c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c)+fadd = abinop FFI.constFAdd FFI.buildFAdd+fsub :: (IsFloating c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c)+fsub = abinop FFI.constFSub FFI.buildFSub+fmul :: (IsFloating c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c)+fmul = abinop FFI.constFMul FFI.buildFMul+ -- | Floating point division. fdiv :: (IsFloating c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) fdiv = abinop FFI.constFDiv FFI.buildFDiv@@ -225,8 +233,13 @@     withCurrentBuilder $ \ bld ->       U.withEmptyCString $ op bld a -neg :: (IsArithmetic a) => Value a -> CodeGenFunction r (Value a)+neg :: ({-IsInteger-} IsArithmetic a) => Value a -> CodeGenFunction r (Value a) neg (Value x) = buildUnOp FFI.buildNeg x++{-+fneg :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+fneg (Value x) = buildUnOp FFI.buildFNeg x+-}  inv :: (IsInteger a) => Value a -> CodeGenFunction r (Value a) inv (Value x) = buildUnOp FFI.buildNot x

@@ -253,7 +253,7 @@     withModule modul $ \ modulPtr ->       withCString name $ \ namePtr -> do         f <- FFI.addFunction modulPtr namePtr typ-        FFI.setLinkage f linkage+        FFI.setLinkage f (FFI.fromLinkage linkage)         return f  getParam :: Function -> Int -> Value@@ -266,7 +266,7 @@     withModule modul $ \ modulPtr ->       withCString name $ \ namePtr -> do         v <- FFI.addGlobal modulPtr typ namePtr-        FFI.setLinkage v linkage+        FFI.setLinkage v (FFI.fromLinkage linkage)         return v  -- unsafePerformIO is safe because it's only used for the withCStringLen conversion

@@ -11,3 +11,7 @@     :: MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt foreign import ccall unsafe "LLVMParseBitcode" parseBitcode     :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt+foreign import ccall unsafe "LLVMGetBitcodeModuleProviderInContext" getBitcodeModuleProviderInContext+    :: ContextRef -> MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt+foreign import ccall unsafe "LLVMParseBitcodeInContext" parseBitcodeInContext+    :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt

@@ -107,15 +107,21 @@     , isUndef      -- ** Global variables, functions, and aliases (globals)-    , Linkage-    , Visibility-    , isDeclaration+    , Linkage(..)+    , fromLinkage+    , toLinkage     , getLinkage     , setLinkage-    , getSection-    , setSection++    , Visibility(..)+    , fromVisibility+    , toVisibility     , getVisibility     , setVisibility++    , isDeclaration+    , getSection+    , setSection     , getAlignment     , setAlignment       @@ -191,6 +197,12 @@     , constAdd     , constSub     , constMul+    , constExactSDiv+    , constFAdd+    , constFMul+    , constFNeg+    , constFPCast+    , constFSub     , constUDiv     , constSDiv     , constFDiv@@ -271,8 +283,13 @@     , buildAdd     , buildSub     , buildMul+    , buildFAdd+    , buildFMul+    , buildFPCast+    , buildFSub     , buildUDiv     , buildSDiv+    , buildExactSDiv     , buildFDiv     , buildURem     , buildSRem@@ -309,7 +326,24 @@     , buildPtrToInt     , buildIntToPtr     , buildBitCast+    , buildPointerCast+    , buildTruncOrBitCast+    , buildZExtOrBitCast+    , buildSExtOrBitCast +    , buildPtrDiff++    -- * Misc+    , buildAggregateRet+    , buildGlobalString+    , buildGlobalStringPtr+    , buildInBoundsGEP+    , buildIntCast+    , buildIsNotNull+    , buildIsNull+    , buildNSWAdd+    , buildStructGEP+     -- ** Comparisons     , buildICmp     , buildFCmp@@ -337,15 +371,17 @@     , disposeMessage      -- * Parameter passing-    , addInstrAttribute     , addAttribute-    , removeInstrAttribute-    , removeAttribute     , setInstrParamAlignment     , setParamAlignment     , Attribute(..)     , fromAttribute     , toAttribute+    , addInstrAttribute+    , removeFunctionAttr+    , removeAttribute+    , removeInstrAttribute+    , addFunctionAttr      -- * Pass manager     , PassManager@@ -358,7 +394,59 @@     , runFunctionPassManager     , runPassManager +    -- * Context functions+    , Context+    , ContextRef++    -- * Debug     , dumpModule+++    -- * Misc+    , alignOf+    , constInBoundsGEP+    , constIntCast+    , constIntOfString+    , constIntOfStringAndSize+    , constNSWAdd+    , constPointerCast+    , constPointerNull+    , constRealOfStringAndSize+    , constSExtOrBitCast++    , getTypeByName+    , insertIntoBuilderWithName++    -- * Context functions+    , moduleCreateWithNameInContext+    , appendBasicBlockInContext+    , insertBasicBlockInContext+    , createBuilderInContext++    , contextDispose++    , constStringInContext+    , constStructInContext+    , constTruncOrBitCast+    , constZExtOrBitCast++    , doubleTypeInContext+    , fP128TypeInContext+    , floatTypeInContext+    , int16TypeInContext+    , int1TypeInContext+    , int32TypeInContext+    , int64TypeInContext+    , int8TypeInContext+    , intTypeInContext+    , labelTypeInContext+    , opaqueTypeInContext+    , pPCFP128TypeInContext+    , structTypeInContext+    , voidTypeInContext+    , x86FP80TypeInContext+    , getTypeContext+     ) where import Data.Typeable(Typeable) import Foreign.C.String (CString)@@ -619,13 +707,65 @@ foreign import ccall unsafe "LLVMIsDeclaration" isDeclaration     :: ValueRef -> IO CInt -type Linkage = CUInt+-- |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) +fromLinkage :: Linkage -> CUInt+fromLinkage ExternalLinkage             = (#const LLVMExternalLinkage)+fromLinkage AvailableExternallyLinkage  = (#const LLVMAvailableExternallyLinkage )+fromLinkage LinkOnceAnyLinkage          = (#const LLVMLinkOnceAnyLinkage)+fromLinkage LinkOnceODRLinkage          = (#const LLVMLinkOnceODRLinkage)+fromLinkage WeakAnyLinkage              = (#const LLVMWeakAnyLinkage)+fromLinkage WeakODRLinkage              = (#const LLVMWeakODRLinkage)+fromLinkage AppendingLinkage            = (#const LLVMAppendingLinkage)+fromLinkage InternalLinkage             = (#const LLVMInternalLinkage)+fromLinkage PrivateLinkage              = (#const LLVMPrivateLinkage)+fromLinkage DLLImportLinkage            = (#const LLVMDLLImportLinkage)+fromLinkage DLLExportLinkage            = (#const LLVMDLLExportLinkage)+fromLinkage ExternalWeakLinkage         = (#const LLVMExternalWeakLinkage)+fromLinkage GhostLinkage                = (#const LLVMGhostLinkage)+fromLinkage CommonLinkage               = (#const LLVMCommonLinkage)+fromLinkage LinkerPrivateLinkage        = (#const LLVMLinkerPrivateLinkage)++toLinkage :: CUInt -> Linkage+toLinkage c | c == (#const LLVMExternalLinkage)             = ExternalLinkage+toLinkage c | c == (#const LLVMAvailableExternallyLinkage)  = AvailableExternallyLinkage +toLinkage c | c == (#const LLVMLinkOnceAnyLinkage)          = LinkOnceAnyLinkage+toLinkage c | c == (#const LLVMLinkOnceODRLinkage)          = LinkOnceODRLinkage+toLinkage c | c == (#const LLVMWeakAnyLinkage)              = WeakAnyLinkage+toLinkage c | c == (#const LLVMWeakODRLinkage)              = WeakODRLinkage+toLinkage c | c == (#const LLVMAppendingLinkage)            = AppendingLinkage+toLinkage c | c == (#const LLVMInternalLinkage)             = InternalLinkage+toLinkage c | c == (#const LLVMPrivateLinkage)              = PrivateLinkage+toLinkage c | c == (#const LLVMDLLImportLinkage)            = DLLImportLinkage+toLinkage c | c == (#const LLVMDLLExportLinkage)            = DLLExportLinkage+toLinkage c | c == (#const LLVMExternalWeakLinkage)         = ExternalWeakLinkage+toLinkage c | c == (#const LLVMGhostLinkage)                = GhostLinkage+toLinkage c | c == (#const LLVMCommonLinkage)               = CommonLinkage+toLinkage c | c == (#const LLVMLinkerPrivateLinkage)        = LinkerPrivateLinkage+toLinkage _ = error "toLinkage: bad value"+ foreign import ccall unsafe "LLVMGetLinkage" getLinkage-    :: ValueRef -> IO Linkage+    :: ValueRef -> IO CUInt  foreign import ccall unsafe "LLVMSetLinkage" setLinkage-    :: ValueRef -> Linkage -> IO ()+    :: ValueRef -> CUInt -> IO ()  foreign import ccall unsafe "LLVMGetSection" getSection     :: ValueRef -> IO CString@@ -633,13 +773,29 @@ foreign import ccall unsafe "LLVMSetSection" setSection     :: ValueRef -> CString -> IO () -type Visibility = CUInt+-- |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) +fromVisibility :: Visibility -> CUInt+fromVisibility DefaultVisibility   = (#const LLVMDefaultVisibility)+fromVisibility HiddenVisibility    = (#const LLVMHiddenVisibility)+fromVisibility ProtectedVisibility = (#const LLVMProtectedVisibility)++toVisibility :: CUInt -> Visibility+toVisibility c | c == (#const LLVMDefaultVisibility)   = DefaultVisibility+toVisibility c | c == (#const LLVMHiddenVisibility)    = HiddenVisibility+toVisibility c | c == (#const LLVMProtectedVisibility) = ProtectedVisibility+toVisibility _ = error "toVisibility: bad value"+ foreign import ccall unsafe "LLVMGetVisibility" getVisibility-    :: ValueRef -> IO Visibility+    :: ValueRef -> IO CUInt  foreign import ccall unsafe "LLVMSetVisibility" setVisibility-    :: ValueRef -> Visibility -> IO ()+    :: ValueRef -> CUInt -> IO ()  foreign import ccall unsafe "LLVMGetAlignment" getAlignment     :: ValueRef -> IO CUInt@@ -1158,6 +1314,12 @@     :: ValueRef -> CUInt -> CUInt -> IO () foreign import ccall unsafe "LLVMSetParamAlignment" setParamAlignment     :: ValueRef -> CUInt -> IO ()+++data Context+    deriving (Typeable)+type ContextRef = Ptr Context+ foreign import ccall unsafe "LLVMAddAttribute" addAttribute     :: ValueRef -> CAttribute -> IO () foreign import ccall unsafe "LLVMAddInstrAttribute" addInstrAttribute@@ -1170,21 +1332,131 @@     :: ValueRef -> CUInt -> CAttribute -> IO () foreign import ccall unsafe "LLVMSetTailCall" setTailCall     :: ValueRef -> CInt -> IO ()-{--foreign import ccall unsafe "LLVMAddAlias" addAlias-    :: ModuleRef -> TypeRef -> ValueRef -> CString -> IO ValueRef-foreign import ccall unsafe "LLVMBuildExtractValue" buildExtractValue+foreign import ccall unsafe "LLVMAddFunctionAttr" addFunctionAttr+    :: ValueRef -> CAttribute -> IO ()+foreign import ccall unsafe "LLVMAlignOf" alignOf+    :: TypeRef -> IO ValueRef+foreign import ccall unsafe "LLVMAppendBasicBlockInContext" appendBasicBlockInContext+    :: ContextRef -> ValueRef -> CString -> IO BasicBlockRef+foreign import ccall unsafe "LLVMBuildAggregateRet" buildAggregateRet+    :: BuilderRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef+foreign import ccall unsafe "LLVMBuildExactSDiv" buildExactSDiv+    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildFAdd" buildFAdd+    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildFMul" buildFMul+    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildFPCast" buildFPCast+    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildFSub" buildFSub+    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildGlobalString" buildGlobalString+    :: BuilderRef -> CString -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildGlobalStringPtr" buildGlobalStringPtr+    :: BuilderRef -> CString -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildInBoundsGEP" buildInBoundsGEP+    :: BuilderRef -> ValueRef -> (Ptr ValueRef) -> CUInt -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildIntCast" buildIntCast+    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildIsNotNull" buildIsNotNull+    :: BuilderRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildIsNull" buildIsNull+    :: BuilderRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildNSWAdd" buildNSWAdd+    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildPointerCast" buildPointerCast+    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildPtrDiff" buildPtrDiff+    :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildSExtOrBitCast" buildSExtOrBitCast+    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildStructGEP" buildStructGEP     :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef-foreign import ccall unsafe "LLVMBuildInsertValue" buildInsertValue-    :: BuilderRef -> ValueRef -> ValueRef -> CUInt -> CString -> IO ValueRef-foreign import ccall unsafe "LLVMClearInsertionPosition" clearInsertionPosition-    :: BuilderRef -> IO ()-foreign import ccall unsafe "LLVMConstExtractValue" constExtractValue-    :: ValueRef -> Ptr CUInt -> CUInt -> IO ValueRef-foreign import ccall unsafe "LLVMConstInlineAsm" constInlineAsm-    :: TypeRef -> CString -> CString -> CInt -> IO ValueRef-foreign import ccall unsafe "LLVMConstInsertValue" constInsertValue-    :: ValueRef -> ValueRef -> Ptr CUInt -> IO ValueRef-foreign import ccall unsafe "LLVMInsertIntoBuilder" insertIntoBuilder-    :: BuilderRef -> ValueRef -> IO ()--}+foreign import ccall unsafe "LLVMBuildTruncOrBitCast" buildTruncOrBitCast+    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMBuildZExtOrBitCast" buildZExtOrBitCast+    :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef+foreign import ccall unsafe "LLVMConstExactSDiv" constExactSDiv+    :: ValueRef -> ValueRef -> IO ValueRef+foreign import ccall unsafe "LLVMConstFAdd" constFAdd+    :: ValueRef -> ValueRef -> ValueRef+foreign import ccall unsafe "LLVMConstFMul" constFMul+    :: ValueRef -> ValueRef -> ValueRef+foreign import ccall unsafe "LLVMConstFNeg" constFNeg+    :: ValueRef -> ValueRef+foreign import ccall unsafe "LLVMConstFPCast" constFPCast+    :: ValueRef -> TypeRef -> ValueRef+foreign import ccall unsafe "LLVMConstFSub" constFSub+    :: ValueRef -> ValueRef -> ValueRef+foreign import ccall unsafe "LLVMConstInBoundsGEP" constInBoundsGEP+    :: ValueRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef+foreign import ccall unsafe "LLVMConstIntCast" constIntCast+    :: ValueRef -> TypeRef -> CUInt -> IO ValueRef+foreign import ccall unsafe "LLVMConstIntOfString" constIntOfString+    :: TypeRef -> CString -> CUInt -> IO ValueRef+foreign import ccall unsafe "LLVMConstIntOfStringAndSize" constIntOfStringAndSize+    :: TypeRef -> CString -> CUInt -> CUInt -> IO ValueRef+foreign import ccall unsafe "LLVMConstNSWAdd" constNSWAdd+    :: ValueRef -> ValueRef -> IO ValueRef+foreign import ccall unsafe "LLVMConstPointerCast" constPointerCast+    :: ValueRef -> TypeRef -> IO ValueRef+foreign import ccall unsafe "LLVMConstPointerNull" constPointerNull+    :: TypeRef -> IO ValueRef+foreign import ccall unsafe "LLVMConstRealOfStringAndSize" constRealOfStringAndSize+    :: TypeRef -> CString -> CUInt -> IO ValueRef+foreign import ccall unsafe "LLVMConstSExtOrBitCast" constSExtOrBitCast+    :: ValueRef -> TypeRef -> IO ValueRef+foreign import ccall unsafe "LLVMConstStringInContext" constStringInContext+    :: ContextRef -> CString -> CUInt -> CInt -> IO ValueRef+foreign import ccall unsafe "LLVMConstStructInContext" constStructInContext+    :: ContextRef -> (Ptr ValueRef) -> CUInt -> CInt -> IO ValueRef+foreign import ccall unsafe "LLVMConstTruncOrBitCast" constTruncOrBitCast+    :: ValueRef -> TypeRef -> IO ValueRef+foreign import ccall unsafe "LLVMConstZExtOrBitCast" constZExtOrBitCast+    :: ValueRef -> TypeRef -> IO ValueRef+foreign import ccall unsafe "LLVMContextDispose" contextDispose+    :: ContextRef -> IO ()+foreign import ccall unsafe "LLVMCreateBuilderInContext" createBuilderInContext+    :: ContextRef -> IO BuilderRef+foreign import ccall unsafe "LLVMDoubleTypeInContext" doubleTypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMFP128TypeInContext" fP128TypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMFloatTypeInContext" floatTypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMGetTypeByName" getTypeByName+    :: ModuleRef -> CString -> IO TypeRef+foreign import ccall unsafe "LLVMGetTypeContext" getTypeContext+    :: TypeRef -> IO ContextRef+foreign import ccall unsafe "LLVMInsertBasicBlockInContext" insertBasicBlockInContext+    :: ContextRef -> BasicBlockRef -> CString -> IO BasicBlockRef+foreign import ccall unsafe "LLVMInsertIntoBuilderWithName" insertIntoBuilderWithName+    :: BuilderRef -> ValueRef -> CString -> IO ()+foreign import ccall unsafe "LLVMInt16TypeInContext" int16TypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMInt1TypeInContext" int1TypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMInt32TypeInContext" int32TypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMInt64TypeInContext" int64TypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMInt8TypeInContext" int8TypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMIntTypeInContext" intTypeInContext+    :: ContextRef -> CUInt -> IO TypeRef+foreign import ccall unsafe "LLVMLabelTypeInContext" labelTypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMModuleCreateWithNameInContext" moduleCreateWithNameInContext+    :: CString -> ContextRef -> IO ModuleRef+foreign import ccall unsafe "LLVMOpaqueTypeInContext" opaqueTypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMPPCFP128TypeInContext" pPCFP128TypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMRemoveFunctionAttr" removeFunctionAttr+    :: ValueRef -> CAttribute -> IO ()+foreign import ccall unsafe "LLVMStructTypeInContext" structTypeInContext+    :: ContextRef -> (Ptr TypeRef) -> CUInt -> CInt -> IO TypeRef+foreign import ccall unsafe "LLVMVoidTypeInContext" voidTypeInContext+    :: ContextRef -> IO TypeRef+foreign import ccall unsafe "LLVMX86FP80TypeInContext" x86FP80TypeInContext+    :: ContextRef -> IO TypeRef

@@ -31,6 +31,10 @@     , createGenericValueOfPointer     , genericValueToPointer     , ptrDisposeGenericValue++    -- * Linking+--    , linkInInterpreter+    , linkInJIT     ) where import Data.Typeable import Foreign.C.String (CString)@@ -114,3 +118,10 @@  foreign import ccall unsafe "LLVMGetPointerToGlobal" getPointerToGlobal     :: ExecutionEngineRef -> ValueRef -> IO (FunPtr a)++{-+foreign import ccall unsafe "LLVMLinkInInterpreter" linkInInterpreter+    :: IO ()+-}+foreign import ccall unsafe "LLVMLinkInJIT" linkInJIT+    :: IO ()

@@ -0,0 +1,34 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}++module LLVM.FFI.Transforms.IPO where++import LLVM.FFI.Core++foreign import ccall unsafe "LLVMAddArgumentPromotionPass" addArgumentPromotionPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddConstantMergePass" addConstantMergePass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddDeadArgEliminationPass" addDeadArgEliminationPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddDeadTypeEliminationPass" addDeadTypeEliminationPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddFunctionAttrsPass" addFunctionAttrsPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddFunctionInliningPass" addFunctionInliningPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddGlobalDCEPass" addGlobalDCEPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddGlobalOptimizerPass" addGlobalOptimizerPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddIPConstantPropagationPass" addIPConstantPropagationPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddLowerSetJmpPass" addLowerSetJmpPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddPruneEHPass" addPruneEHPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddRaiseAllocationsPass" addRaiseAllocationsPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddStripDeadPrototypesPass" addStripDeadPrototypesPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddStripSymbolsPass" addStripSymbolsPass+    :: PassManagerRef -> IO ()

@@ -1,14 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} -module LLVM.FFI.Transforms.Scalar(-       addCFGSimplificationPass-     , addConstantPropagationPass-     , addDemoteMemoryToRegisterPass-     , addGVNPass-     , addInstructionCombiningPass-     , addPromoteMemoryToRegisterPass-     , addReassociatePass-     ) where+module LLVM.FFI.Transforms.Scalar where  import LLVM.FFI.Core @@ -26,4 +18,35 @@     :: PassManagerRef -> IO () foreign import ccall unsafe "LLVMAddReassociatePass" addReassociatePass     :: PassManagerRef -> IO ()-+foreign import ccall unsafe "LLVMAddAggressiveDCEPass" addAggressiveDCEPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddCondPropagationPass" addCondPropagationPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddDeadStoreEliminationPass" addDeadStoreEliminationPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddIndVarSimplifyPass" addIndVarSimplifyPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddJumpThreadingPass" addJumpThreadingPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddLICMPass" addLICMPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddLoopDeletionPass" addLoopDeletionPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddLoopIndexSplitPass" addLoopIndexSplitPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddLoopRotatePass" addLoopRotatePass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddLoopUnrollPass" addLoopUnrollPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddLoopUnswitchPass" addLoopUnswitchPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddMemCpyOptPass" addMemCpyOptPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddSCCPPass" addSCCPPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddScalarReplAggregatesPass" addScalarReplAggregatesPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddSimplifyLibCallsPass" addSimplifyLibCallsPass+    :: PassManagerRef -> IO ()+foreign import ccall unsafe "LLVMAddTailCallEliminationPass" addTailCallEliminationPass+    :: PassManagerRef -> IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.ARM(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeARMTargetInfo+    initializeARMTarget++foreign import ccall unsafe "LLVMInitializeARMTargetInfo" initializeARMTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeARMTarget" initializeARMTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.Alpha(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeAlphaTargetInfo+    initializeAlphaTarget++foreign import ccall unsafe "LLVMInitializeAlphaTargetInfo" initializeAlphaTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeAlphaTarget" initializeAlphaTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.Blackfin(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeBlackfinTargetInfo+    initializeBlackfinTarget++foreign import ccall unsafe "LLVMInitializeBlackfinTargetInfo" initializeBlackfinTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeBlackfinTarget" initializeBlackfinTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.CBackend(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeCBackendTargetInfo+    initializeCBackendTarget++foreign import ccall unsafe "LLVMInitializeCBackendTargetInfo" initializeCBackendTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeCBackendTarget" initializeCBackendTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.CellSPU(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeCellSPUTargetInfo+    initializeCellSPUTarget++foreign import ccall unsafe "LLVMInitializeCellSPUTargetInfo" initializeCellSPUTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeCellSPUTarget" initializeCellSPUTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.CppBackend(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeCppBackendTargetInfo+    initializeCppBackendTarget++foreign import ccall unsafe "LLVMInitializeCppBackendTargetInfo" initializeCppBackendTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeCppBackendTarget" initializeCppBackendTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.MSIL(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeMSILTargetInfo+    initializeMSILTarget++foreign import ccall unsafe "LLVMInitializeMSILTargetInfo" initializeMSILTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeMSILTarget" initializeMSILTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.MSP430(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeMSP430TargetInfo+    initializeMSP430Target++foreign import ccall unsafe "LLVMInitializeMSP430TargetInfo" initializeMSP430TargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeMSP430Target" initializeMSP430Target :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.Mips(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeMipsTargetInfo+    initializeMipsTarget++foreign import ccall unsafe "LLVMInitializeMipsTargetInfo" initializeMipsTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeMipsTarget" initializeMipsTarget :: IO ()

@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}+module LLVM.Target.Native(initializeNativeTarget) where+import Control.Monad+import Control.Concurrent.MVar+import System.IO.Unsafe++-- TARGET is expanded by CPP to the native target architecture.+import LLVM.Target.TARGET++-- | Initialize jitter to the native target.+-- The operation is idempotent.+initializeNativeTarget :: IO ()+initializeNativeTarget = do+    done <- takeMVar refDone+    when (not done) initializeTarget+    putMVar refDone True++-- UNSAFE: global variable to keep track of initialization state.+refDone :: MVar Bool+refDone = unsafePerformIO $ newMVar False

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.PIC16(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializePIC16TargetInfo+    initializePIC16Target++foreign import ccall unsafe "LLVMInitializePIC16TargetInfo" initializePIC16TargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializePIC16Target" initializePIC16Target :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.PowerPC(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializePowerPCTargetInfo+    initializePowerPCTarget++foreign import ccall unsafe "LLVMInitializePowerPCTargetInfo" initializePowerPCTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializePowerPCTarget" initializePowerPCTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.Sparc(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeSparcTargetInfo+    initializeSparcTarget++foreign import ccall unsafe "LLVMInitializeSparcTargetInfo" initializeSparcTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeSparcTarget" initializeSparcTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.SystemZ(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeSystemZTargetInfo+    initializeSystemZTarget++foreign import ccall unsafe "LLVMInitializeSystemZTargetInfo" initializeSystemZTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeSystemZTarget" initializeSystemZTarget :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.X86(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeX86TargetInfo+    initializeX86Target++foreign import ccall unsafe "LLVMInitializeX86TargetInfo" initializeX86TargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeX86Target" initializeX86Target :: IO ()

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module LLVM.Target.XCore(initializeTarget) where++initializeTarget :: IO ()+initializeTarget = do+    initializeXCoreTargetInfo+    initializeXCoreTarget++foreign import ccall unsafe "LLVMInitializeXCoreTargetInfo" initializeXCoreTargetInfo :: IO ()+foreign import ccall unsafe "LLVMInitializeXCoreTarget" initializeXCoreTarget :: IO ()

@@ -0,0 +1,109 @@+module LLVM.Util.Optimize(optimizeModule) where+import Control.Monad+import Foreign.Ptr(nullPtr)++import LLVM.Core.Util(Module, withModule)+import qualified LLVM.FFI.Core as FFI+import LLVM.FFI.Target(addTargetData, createTargetData)+import LLVM.FFI.Transforms.IPO+import LLVM.FFI.Transforms.Scalar++optimizeModule :: Int -> Module -> IO Int+optimizeModule optLevel mdl = withModule mdl $ \ m -> do+    passes <- FFI.createPassManager++    -- Pass the module target data to the pass manager.+    target <- FFI.getDataLayout m >>= createTargetData+    addTargetData target passes++--FCN    fPasses <- FFI.createFunctionPassManager mp+    let fPasses = nullPtr+    -- XXX add module target data++--    addVerifierPass passes -- XXX does not exist+    addLowerSetJmpPass passes+    addOptimizationPasses passes fPasses optLevel++    --FCN XXX loop through all functions and optimize them.+--    initializeFunctionPassManager fPasses+--    runFunctionPassManager fPasses fcn++--    addVerifierPass passes -- XXX does not exist++    rc <- FFI.runPassManager passes m+    -- XXX discard pass manager?++    return (fromIntegral rc)++addOptimizationPasses :: FFI.PassManagerRef -> FFI.PassManagerRef -> Int -> IO ()+addOptimizationPasses passes fPasses optLevel = do+    createStandardFunctionPasses fPasses optLevel++    let inline = addFunctionInliningPass --  if optLevel > 1 then addFunctionInliningPass else const (return ())+    createStandardModulePasses passes optLevel True (optLevel > 1) True True inline++createStandardFunctionPasses :: FFI.PassManagerRef -> Int -> IO ()+createStandardFunctionPasses fPasses optLevel = do+  when False $ do -- FCN+    addCFGSimplificationPass fPasses+    if optLevel == 1 then+        addPromoteMemoryToRegisterPass fPasses+     else+        addScalarReplAggregatesPass fPasses+    addInstructionCombiningPass fPasses++createStandardModulePasses :: FFI.PassManagerRef -> Int -> Bool -> Bool -> Bool -> Bool -> (FFI.PassManagerRef -> IO()) -> IO ()+createStandardModulePasses passes optLevel unitAtATime unrollLoops simplifyLibCalls haveExceptions inliningPass = do+    when unitAtATime $ do+        addRaiseAllocationsPass passes+    addCFGSimplificationPass passes+    addPromoteMemoryToRegisterPass passes+    when unitAtATime $ do+        addGlobalOptimizerPass passes+        addGlobalDCEPass passes+        addIPConstantPropagationPass passes+        addDeadArgEliminationPass passes+    addInstructionCombiningPass passes+    addCFGSimplificationPass passes+    when unitAtATime $ do+        when haveExceptions $ addPruneEHPass passes+        addFunctionAttrsPass passes+    inliningPass passes+    when (optLevel > 2) $ do+        addArgumentPromotionPass passes+    when simplifyLibCalls $ do+        addSimplifyLibCallsPass passes+    addInstructionCombiningPass passes+    addJumpThreadingPass passes+    addCFGSimplificationPass passes+    addScalarReplAggregatesPass passes+    addInstructionCombiningPass passes+    addCondPropagationPass passes+    addTailCallEliminationPass passes+    addCFGSimplificationPass passes+    addReassociatePass passes+    addLoopRotatePass passes+    addLICMPass passes+    addLoopUnswitchPass passes+    addInstructionCombiningPass passes+    addIndVarSimplifyPass passes+    addLoopDeletionPass passes+    when unrollLoops $+      addLoopUnrollPass passes+    addInstructionCombiningPass passes+    addGVNPass passes+    addMemCpyOptPass passes+    addSCCPPass passes++    addInstructionCombiningPass passes+    addCondPropagationPass passes+    addDeadStoreEliminationPass passes+    addAggressiveDCEPass passes+    addCFGSimplificationPass passes++    when unitAtATime $ do+      addStripDeadPrototypesPass passes+      addDeadTypeEliminationPass passes++    when (optLevel > 1 && unitAtATime) $+      addConstantMergePass passes

@@ -47,6 +47,7 @@ clean: 	-$(MAKE) -C examples clean 	-$(MAKE) -C tests clean+	-$(MAKE) -C tools clean 	-rm -f Setup.hi Setup.o 	-./setup clean 	-rm -f setup setup.exe setup.exe.manifest

@@ -1,3 +1,5 @@+#define __STDC_LIMIT_MACROS+#define __STDC_CONSTANT_MACROS #include <llvm-c/Core.h> #include <llvm-c/ExecutionEngine.h> 

@@ -641,8 +641,9 @@ LIBOBJS llvm_ldflags llvm_includedir-llvm_engine_libs+llvm_all_libs llvm_cppflags+llvm_target EGREP GREP CPP@@ -2498,8 +2499,8 @@ llvm_cppflags="`$llvm_config --cppflags`" llvm_includedir="`$llvm_config --includedir`" llvm_ldflags="`$llvm_config --ldflags`"--llvm_engine_libs="`$llvm_config --libs engine`"+llvm_all_libs="`$llvm_config --libs all`"+llvm_target="`$llvm_config --libs engine | sed 's/.*LLVM\(.[^ ]*\)CodeGen.*/\1/'`"  CPPFLAGS="$llvm_cppflags $CPPFLAGS" LDFLAGS="$llvm_ldflags $LDFLAGS"

@@ -32,7 +32,8 @@ llvm_includedir="`$llvm_config --includedir`" llvm_ldflags="`$llvm_config --ldflags`" -llvm_engine_libs="`$llvm_config --libs engine`"+llvm_all_libs="`$llvm_config --libs all`"+llvm_target="`$llvm_config --libs engine | sed 's/.*LLVM\(.[^ ]*\)CodeGen.*/\1/'`"  CPPFLAGS="$llvm_cppflags $CPPFLAGS" LDFLAGS="$llvm_ldflags $LDFLAGS"@@ -49,7 +50,8 @@   [AC_MSG_ERROR(could not find LLVM C bindings)])  AC_SUBST([llvm_cppflags])-AC_SUBST([llvm_engine_libs])+AC_SUBST([llvm_all_libs])+AC_SUBST([llvm_target]) AC_SUBST([llvm_includedir]) AC_SUBST([llvm_ldflags]) 

@@ -7,6 +7,9 @@  main :: IO () main = do+    -- Initialize jitter+    initializeNativeTarget+     td <- getTargetData     print (littleEndian td,            aBIAlignmentOfType td $ typeRef (undefined :: Word32),

@@ -42,6 +42,8 @@  main :: IO () main = do+    -- Initialize jitter+    initializeNativeTarget      let mSomeFn' = mSomeFn     ioSomeFn <- simpleFunction mSomeFn'

@@ -4,6 +4,7 @@ import LLVM.Core --import LLVM.ExecutionEngine import LLVM.Util.Loop+import LLVM.Util.Optimize  cg :: CodeGenModule (Function (Double -> IO (Ptr Double))) cg = do@@ -52,6 +53,10 @@  main :: IO () main = do+    -- Initialize jitter+    initializeNativeTarget     m <- newModule     _f <- defineModule m cg     writeBitcodeToFile "Arr.bc" m+    optimizeModule 3 m+    writeBitcodeToFile "Arr-opt.bc" m

@@ -24,6 +24,9 @@  main :: IO () main = do+    -- Initialize jitter+    initializeNativeTarget+     aargs <- getArgs     let (args, debug) = if take 1 aargs == ["-"] then (tail aargs, True) else (aargs, False)     let text = "+++++++++++++++++++++++++++++++++" ++  -- constant 33

@@ -35,6 +35,8 @@  main :: IO () main = do+    -- Initialize jitter+    initializeNativeTarget     let mDotProd' = mDotProd     writeCodeGenModule "DotProd.bc" mDotProd' 

@@ -5,6 +5,7 @@ import Data.Word  import LLVM.Core+import LLVM.Util.Optimize import LLVM.ExecutionEngine  -- Our module will have these two functions.@@ -18,6 +19,8 @@     args <- getArgs     let args' = if null args then ["10"] else args +    -- Initialize jitter+    initializeNativeTarget     -- Create a module,     m <- newNamedModule "fib"     -- and define its contents.@@ -29,6 +32,9 @@     -- Write the code to a file for later perusal.     -- Can be disassembled with llvm-dis.     writeBitcodeToFile "Fibonacci.bc" m++    optimizeModule 3 m+    writeBitcodeToFile "Fibonacci-opt.bc" m      -- Generate code for mfib, and then throw away the IO in the type.     -- The result is an ordinary Haskell function.

@@ -17,6 +17,7 @@  main :: IO () main = do+    initializeNativeTarget     greet <- simpleFunction bldGreet     greet     greet

@@ -1,7 +1,7 @@ ghc := ghc ghcflags := -Wall -optl -w # -DHAS_GETPOINTERTOGLOBAL=1-examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align Struct+examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align Struct Varargs  all: $(examples:%=%.exe) @@ -29,4 +29,4 @@ 	@echo Have a look at Fib.s if you like to see clever code.  clean:-	rm -f $(examples) *.o *.hi *.s *.bc Fib *.exe *.exe.manifest+	rm -f $(examples) *.o *.hi *.s *.bc Fib *.exe *.exe.manifest *~

@@ -0,0 +1,40 @@+{-# LANGUAGE ForeignFunctionInterface, TypeOperators, ScopedTypeVariables #-}+module Struct (main) where++import Data.Word+import Data.TypeLevel(d0, d1, d2, D10)++import LLVM.Core+import LLVM.Util.File+import LLVM.ExecutionEngine++foreign import ccall structCheck :: Word32 -> Ptr S -> Int++-- Watch out for double!  Alignment differs between platforms.+-- struct S { uint32 x0; float x1; uint32 x2[10] };+type S = Struct (Word32 :& Float :& Array D10 Word32 :& ())++-- S *s = malloc(sizeof *s); s->x0 = a; s->x1 = 1.2; s->x2[5] = a+1; return s;+mStruct :: CodeGenModule (Function (Word32 -> IO (Ptr S)))+mStruct = do+    createFunction ExternalLinkage $ \ x -> do+      p  :: Value (Ptr S)+         <- malloc+      p0 <- getElementPtr0 p (d0 & ())+      store x (p0 :: Value (Ptr Word32))+      p1 <- getElementPtr0 p (d1 & ())+      store (valueOf 1.5) p1+      x' <- add x (1 :: Word32)+      p2 <- getElementPtr0 p (d2 & (5::Word32) & ())+      store x' p2+      ret p++main :: IO ()+main = do+    initializeNativeTarget+    writeCodeGenModule "Struct.bc" mStruct+    struct <- simpleFunction mStruct+    let a = 10+    p <- struct a+    putStrLn $ if structCheck a p /= 0 then "OK" else "failed"+    return ()

@@ -0,0 +1,36 @@+module Varargs (main) where++import Data.Word++import LLVM.Core+import LLVM.ExecutionEngine++bldVarargs :: CodeGenModule (Function (Word32 -> IO ()))+bldVarargs = do+    printf <- newNamedFunction ExternalLinkage "printf" :: TFunction (Ptr Word8 -> VarArgs Word32)+    fmt1 <- createStringNul "Hello\n"+    fmt2 <- createStringNul "A number %d\n"+    fmt3 <- createStringNul "Two numbers %d %d\n"+    func <- createFunction ExternalLinkage $ \ x -> do++      tmp1 <- getElementPtr0 fmt1 (0::Word32, ())+      let p1 = castVarArgs printf :: Function (Ptr Word8 -> IO Word32)+      _ <- call p1 tmp1++      tmp2 <- getElementPtr0 fmt2 (0::Word32, ())+      let p2 = castVarArgs printf :: Function (Ptr Word8 -> Word32 -> IO Word32)+      _ <- call p2 tmp2 x++      tmp3 <- getElementPtr0 fmt3 (0::Word32, ())+      let p3 = castVarArgs printf :: Function (Ptr Word8 -> Word32 -> Word32 -> IO Word32)+      _ <- call p3 tmp3 x x++      ret ()+    return func++main :: IO ()+main = do+    initializeNativeTarget+    varargs <- simpleFunction bldVarargs+    varargs 42+    return ()

@@ -70,6 +70,8 @@ -- XXX With a working pass manager it wouldn't be necessary to go via a file. main :: IO () main = do+    -- Initialize jitter+    initializeNativeTarget     -- First run standard code.     m <- newModule     iovec <- defineModule m cgvec

@@ -0,0 +1,9 @@+#include <stdint.h>++struct S { uint32_t x0; float x1; uint32_t x2[10]; };++int+structCheck(uint32_t a, struct S *s)+{+  return s->x0 == a && s->x1 == 1.5 && s->x2[5] == a+1;+}

@@ -1,4 +1,4 @@-ghc-options: @llvm_cppflags@ -pgml @CXX@-ld-options: @llvm_ldflags@ @llvm_engine_libs@ -lstdc+++cpp-options: @llvm_cppflags@ -DTARGET=@llvm_target@+ghc-options: -pgml @CXX@+ld-options: @llvm_ldflags@ @llvm_all_libs@ -lstdc++ include-dirs: @llvm_includedir@-extra-libraries: LLVMAnalysis LLVMBitWriter LLVMBitReader LLVMCore LLVMTarget LLVMSupport LLVMSystem

@@ -1,4 +1,4 @@-ghc-options: -I@llvm_path@/include  -D_DEBUG  -D_GNU_SOURCE -D__STDC_LIMIT_MACROS -pgml g++-ld-options: -L@llvm_path@/lib @llvm_path@/lib/LLVMX86AsmPrinter.o -lLLVMAsmPrinter @llvm_path@/lib/LLVMX86CodeGen.o -lLLVMSelectionDAG @llvm_path@/lib/LLVMExecutionEngine.o @llvm_path@/lib/LLVMInterpreter.o @llvm_path@/lib/LLVMJIT.o -lLLVMCodeGen -lLLVMipo -lLLVMScalarOpts -lLLVMTransformUtils -lLLVMipa -lLLVMAnalysis -lLLVMTarget -lLLVMCore -lLLVMSupport -lLLVMSystem -lpsapi -limagehlp -lstdc++ -lmingwex+cpp-options: -D_DEBUG -D_GNU_SOURCE -D__STDC_CONSTANT_MACROS -DTARGET=X86+ghc-options: -I@llvm_path@/include -pgml g+++ld-options: -L@llvm_path@/lib -lLLVMXCoreAsmPrinter -lLLVMXCoreCodeGen -lLLVMXCoreInfo -lLLVMSystemZAsmPrinter -lLLVMSystemZCodeGen -lLLVMSystemZInfo -lLLVMSparcAsmPrinter -lLLVMSparcCodeGen -lLLVMSparcInfo -lLLVMPowerPCAsmPrinter -lLLVMPowerPCCodeGen -lLLVMPowerPCInfo -lLLVMPIC16AsmPrinter -lLLVMPIC16CodeGen -lLLVMPIC16Info -lLLVMMSP430AsmPrinter -lLLVMMSP430CodeGen -lLLVMMSP430Info -lLLVMMSIL -lLLVMMSILInfo -lLLVMMipsAsmPrinter -lLLVMMipsCodeGen -lLLVMMipsInfo -lLLVMLinker -lLLVMipo -lLLVMInterpreter -lLLVMInstrumentation -lLLVMJIT -lLLVMExecutionEngine -lLLVMDebugger -lLLVMCppBackend -lLLVMCppBackendInfo -lLLVMCellSPUAsmPrinter -lLLVMCellSPUCodeGen -lLLVMCellSPUInfo -lLLVMCBackend -lLLVMCBackendInfo -lLLVMBlackfinAsmPrinter -lLLVMBlackfinCodeGen -lLLVMBlackfinInfo -lLLVMBitWriter -lLLVMX86AsmParser -lLLVMX86AsmPrinter -lLLVMX86CodeGen -lLLVMX86Info -lLLVMAsmParser -lLLVMARMAsmPrinter -lLLVMARMCodeGen -lLLVMARMInfo -lLLVMArchive -lLLVMBitReader -lLLVMAlphaAsmPrinter -lLLVMAlphaCodeGen -lLLVMSelectionDAG -lLLVMAsmPrinter -lLLVMCodeGen -lLLVMScalarOpts -lLLVMTransformUtils -lLLVMipa -lLLVMAnalysis -lLLVMTarget -lLLVMMC -lLLVMCore -lLLVMAlphaInfo -lLLVMSupport -lLLVMSystem -lpsapi -limagehlp -lstdc++ -lmingwex include-dirs: @llvm_path@/include-extra-libraries: LLVMAnalysis LLVMBitWriter LLVMBitReader LLVMCore LLVMTarget LLVMSupport LLVMSystem

@@ -1,9 +1,10 @@ name: llvm-version: 0.6.8.0+version: 0.7.0.0 license: BSD3 license-file: LICENSE synopsis: Bindings to the LLVM compiler toolkit. description: Bindings to the LLVM compiler toolkit.+             New in 0.7.0.0: Adapted to LLVM 2.6;              New in 0.6.8.0: Add functions to allow freeing function resources;              New in 0.6.7.0: Struct types;              New in 0.6.6.0: Bug fixes;@@ -13,7 +14,7 @@ homepage: http://darcs.serpentine.com/llvm/ stability: experimental category: Compilers/Interpreters, Code Generation-tested-with: GHC == 6.10.2+tested-with: GHC == 6.10.4 cabal-version: >= 1.2.3 build-type: Custom @@ -35,10 +36,14 @@     examples/Vector.hs     examples/Makefile     examples/mainfib.c+    examples/Struct.hs+    examples/structCheck.c+    examples/Varargs.hs     tests/Makefile     tests/TestValue.hs     tools/DiffFFI.hs     tools/FunctionMangler.hs+    tools/FunctionMangulation.hs     tools/IntrinsicMangler.hs     tools/Makefile     llvm.buildinfo.in@@ -68,11 +73,13 @@       LLVM.FFI.Core       LLVM.FFI.ExecutionEngine       LLVM.FFI.Target+      LLVM.FFI.Transforms.IPO       LLVM.FFI.Transforms.Scalar       LLVM.Util.Arithmetic       LLVM.Util.File       LLVM.Util.Foreign       LLVM.Util.Loop+      LLVM.Util.Optimize    other-modules:       LLVM.Core.CodeGen@@ -84,5 +91,21 @@       LLVM.Core.Vector       LLVM.ExecutionEngine.Engine       LLVM.ExecutionEngine.Target+      LLVM.Target.Native+      LLVM.Target.X86+      LLVM.Target.Sparc+      LLVM.Target.PowerPC+      LLVM.Target.Alpha+      LLVM.Target.ARM+      LLVM.Target.Mips+      LLVM.Target.CellSPU+      LLVM.Target.PIC16+      LLVM.Target.XCore+      LLVM.Target.MSP430+      LLVM.Target.SystemZ+      LLVM.Target.Blackfin+      LLVM.Target.CBackend+      LLVM.Target.MSIL+      LLVM.Target.CppBackend    C-Sources: cbits/free.c

@@ -0,0 +1,65 @@+module FunctionMangulation+    (+      pattern+    , rewrite+    , rewriteFunction+    ) where++import Control.Monad (forM)+import Data.Char (isSpace, toLower)+import Data.List (intercalate, isPrefixOf, isSuffixOf)+import Text.Regex.Posix ((=~), (=~~))++pattern :: String+pattern = "^([A-Za-z0-9_ ]+ ?\\*?)[ \t\n]*" +++          "LLVM([A-Za-z0-9_]+)\\(([a-zA-Z0-9_*, \t\n]+)\\);"++dropSpace :: String -> String+dropSpace = dropWhile isSpace++renameType :: String -> String+renameType t | "LLVM" `isPrefixOf` t = rename' (drop 4 t)+             | otherwise = rename' t+  where rename' "int" = "CInt"+        rename' "unsigned" = "CUInt"+        rename' "long long" = "CLLong"+        rename' "unsigned long long" = "CULLong"+        rename' "void" = "()"+        rename' "const char *" = "CString"+        rename' "char *" = "CString"+        rename' s | "*" `isSuffixOf` s = pointer s+                  | otherwise = strip s+        pointer p = case reverse p of+                      ('*':ps) -> "(Ptr " ++ rename' (reverse ps) ++ ")"+                      _ -> p++split :: (a -> Bool) -> [a] -> [[a]]+split p xs = case break p xs of+               (h,(_:t)) -> h : split p t+               (s,_) -> [s]++strip :: String -> String+strip = reverse . dropWhile isSpace . reverse . dropSpace++dropName :: String -> String+dropName s =+    case s =~ "^((const )?[A-Za-z0-9_]+( \\*+)?) ?[A-Za-z0-9]*$" of+      ((_:typ:_):_) -> typ+      _ -> "{- oops! -} " ++ s++rewriteFunction :: String -> String -> String -> String+rewriteFunction cret cname cparams =+    let ret = "IO " ++ renameType (strip cret)+        params = map renameParam . split (==',') $ cparams+	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+    forM matches $ \(_:cret:cname:cparams:_) ->+         return (rewriteFunction cret cname cparams)

@@ -8,4 +8,4 @@ 	$(ghc) $(ghcflags) --make -o $@ -main-is $(basename $<).main $<  clean:-	-rm -f *.o *.hi $(tools)+	-rm -f *.o *.hi $(tools) *.exe