diff --git a/INSTALL.txt b/INSTALL.txt new file mode 100644 --- /dev/null +++ b/INSTALL.txt @@ -0,0 +1,58 @@ +Build and installation instructions +----------------------------------- + +Please don't think of these as canonical build instructions yet, as +this work is rather early along. Let me tell you what's working for +*me*, and hopefully this information will be enough to get you going. + + +Prerequisites +------------- + +Firstly, you'll need to have LLVM. I recommend installing LLVM +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, +or use this: + + cd llvm + ./configure --prefix=$SOMEWHERE + make + make install + +It's a good idea to have $SOMEWHERE/bin is in your path. + +Installing from source on Windows requires MinGW. + + +Building +-------- +It's normal cabal package, but using a configure script as well to +configure LLVM. Do A or B. + +A) If you have cabal-install just do + cabal install --configure-option --with-llvm-prefix=$SOMEWHERE + +B) If you don't have cabal-install: + +Configure the package. + runhaskell Setup configure --configure-option --with-llvm-prefix=$SOMEWHERE + +Build. + runhaskell Setup build + +Install. + runhaskell Setup install + + +Building examples +----------------- + +In the examples directory are a few example programs. There's a GNU +Make Makefile in there, so running "make" in that directory will build +the examples, as will "make examples" in the top-level directory. +Doing "make run" will build and run the examples. + +Note: On MacOS X you get a lot of "atom sorting error" warnings. They +seem to be harmless. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,69 @@ +====================================================================== +Haskell LLVM Bindings Release License +====================================================================== +University of Illinois/NCSA +Open Source License + +Copyright (c) 2007-2009 Bryan O'Sullivan +All rights reserved. + +Developed by: + + Bryan O'Sullivan + http://www.serpentine.com/blog/ + + Lennart Augustsson + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal with the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimers. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimers in the documentation and/or other materials provided + with the distribution. + + * Neither the names of Bryan O'Sullivan, University of Illinois at + Urbana-Champaign, nor the names of its contributors may be used + to endorse or promote products derived from this Software + without specific prior written permission. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR +ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF +CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE SOFTWARE. + +====================================================================== +Copyrights and Licenses for Third Party Software Distributed with +Haskell LLVM Bindings: +====================================================================== + +The Haskell LLVM Bindings software may contain code written by third +parties. Any such software will have its own individual license file +in the directory in which it appears. This file will describe the +copyrights, license, and restrictions which apply to that code. + +The disclaimer of warranty in the University of Illinois Open Source +License applies to all code in the Haskell LLVM Bindings Distribution, +and nothing in any of the other licenses gives permission to use the +name of Bryan O'Sullivan or the University of Illinois to endorse or +promote products derived from this Software. + +The following pieces of software have additional or alternate +copyrights, licenses, and/or restrictions: + +Program Directory +------- --------- +configure . + + diff --git a/LLVM/Core.hs b/LLVM/Core.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core.hs @@ -0,0 +1,111 @@ +-- |The LLVM (Low Level Virtual Machine) is virtual machine at a machine code level. +-- It supports both stand alone code generation and JITing. +-- The Haskell llvm package is a (relatively) high level interface to the LLVM. +-- The high level interface makes it easy to construct LLVM code. +-- There is also an interface to the raw low level LLVM API as exposed by the LLVM C interface. +-- +-- LLVM code is organized into modules (type 'Module'). +-- Each module contains a number of global variables and functions (type 'Function'). +-- Each functions has a number of basic blocks (type 'BasicBlock'). +-- Each basic block has a number instructions, where each instruction produces +-- a value (type 'Value'). +-- +-- Unlike assembly code for a real processor the assembly code for LLVM is +-- in SSA (Static Single Assignment) form. This means that each instruction generates +-- a new bound variable which may not be assigned again. +-- A consequence of this is that where control flow joins from several execution +-- paths there has to be a phi pseudo instruction if you want different variables +-- to be joined into one. +-- +-- The definition of several of the LLVM entities ('Module', 'Function', and 'BasicBlock') +-- follow the same pattern. First the entity has to be created using @newX@ (where @X@ +-- is one of @Module@, @Function@, or @BasicBlock@), then at some later point it has to +-- given its definition using @defineX@. The reason for splitting the creation and +-- definition is that you often need to be able to refer to an entity before giving +-- it's body, e.g., in two mutually recursive functions. +-- The the @newX@ and @defineX@ function can also be done at the same time by using +-- @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, + PassManager, createPassManager, createFunctionPassManager, + writeBitcodeToFile, readBitcodeFromFile, + getModuleValues, ModuleValue, castModuleValue, + -- * Instructions + module LLVM.Core.Instructions, + -- * Types classification + module LLVM.Core.Type, + -- * Extra types + module LLVM.Core.Data, + -- * Values and constants + Value, ConstValue, valueOf, constOf, value, + zero, allOnes, undef, + createString, createStringNul, + --constString, constStringNul, + constVector, constArray, + constStruct, constPackedStruct, + toVector, fromVector, vector, + -- * Code generation + CodeGenFunction, CodeGenModule, + -- * Functions + Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, + TFunction, + ValueTuple, buildTuple, + Undefined, undefTuple, + MakeValueTuple, valueTupleOf, + -- * Global variable creation + Global, newGlobal, newNamedGlobal, defineGlobal, createGlobal, createNamedGlobal, + externFunction, staticFunction, + GlobalMappings, getGlobalMappings, + TGlobal, + -- * Globals + Linkage(..), + -- * Basic blocks + BasicBlock, newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, getCurrentBasicBlock, + fromLabel, toLabel, + -- * Misc + addAttributes, Attribute(..), + castVarArgs, + -- * Debugging + dumpValue, dumpType, getValueName + ) where +import qualified LLVM.FFI.Core as FFI +import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, constStruct, getModuleValues, valueHasType) +import LLVM.Core.CodeGen +import LLVM.Core.CodeGenMonad(CodeGenFunction, CodeGenModule, GlobalMappings, getGlobalMappings) +import LLVM.Core.Data hiding (Vector, Array) +import LLVM.Core.Data(Vector, Array) +import LLVM.Core.Instructions +import LLVM.Core.Type +import LLVM.Core.Vector +import LLVM.Target.Native + +-- |Print a value. +dumpValue :: Value a -> IO () +dumpValue (Value v) = FFI.dumpValue v + +-- |Print a type. +dumpType :: Value a -> IO () +dumpType (Value v) = showTypeOf v >>= putStrLn + +-- |Get the name of a 'Value'. +getValueName :: Value a -> IO String +getValueName (Value a) = getValueNameU a + +-- |Convert a varargs function to a regular function. +castVarArgs :: (CastVarArgs a b) => Function a -> Function b +castVarArgs (Value a) = Value a + +-- TODO for types: +-- Enforce free is only called on malloc memory. (Enforce only one free?) +-- Enforce phi nodes a accessor of variables outside the bb +-- Enforce bb terminator +-- Enforce phi first +-- +-- TODO: +-- Add Struct, PackedStruct types +-- Get alignment from code gen diff --git a/LLVM/Core/CodeGen.hs b/LLVM/Core/CodeGen.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core/CodeGen.hs @@ -0,0 +1,575 @@ +{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances, UndecidableInstances, FlexibleContexts, ScopedTypeVariables, DeriveDataTypeable, TypeOperators #-} +module LLVM.Core.CodeGen( + -- * Module creation + newModule, newNamedModule, defineModule, createModule, + getModuleValues, ModuleValue, castModuleValue, + -- * Globals + Linkage(..), + Visibility(..), + -- * Function creation + Function, newFunction, newNamedFunction, + defineFunction, createFunction, createNamedFunction, + ValueTuple, buildTuple, + Undefined, undefTuple, + MakeValueTuple, valueTupleOf, + addAttributes, + FFI.Attribute(..), + externFunction, staticFunction, + FunctionArgs, FunctionRet, + TFunction, + -- * Global variable creation + Global, newGlobal, newNamedGlobal, defineGlobal, createGlobal, createNamedGlobal, TGlobal, + -- * Values + Value(..), ConstValue(..), + IsConst(..), valueOf, value, + zero, allOnes, undef, + createString, createStringNul, + constVector, constArray, constStruct, constPackedStruct, + -- * Basic blocks + BasicBlock(..), newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, getCurrentBasicBlock, + fromLabel, toLabel, + -- * Misc + withCurrentBuilder + ) where +import Data.Typeable +import Control.Monad(liftM, liftM2, liftM3, when) +import Control.Monad.State (State, runState, get, put, ) +import Data.Int +import Data.Word +import Foreign.StablePtr (StablePtr, castStablePtrToPtr, ) +import Foreign.Ptr(minusPtr, nullPtr, FunPtr, castFunPtrToPtr, ) +import Foreign.Storable(sizeOf) +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 + +-------------------------------------- + +-- | Create a new module. +newModule :: IO U.Module +newModule = newNamedModule "_module" -- XXX should generate a name + +-- | Create a new explicitely named module. +newNamedModule :: String -- ^ module name + -> IO U.Module +newNamedModule = U.createModule + +-- | Give the body for a module. +defineModule :: U.Module -- ^ module that is defined + -> CodeGenModule a -- ^ module body + -> IO a +defineModule = runCodeGenModule + +-- | Create a new module with the given body. +createModule :: CodeGenModule a -- ^ module body + -> IO a +createModule cgm = newModule >>= \ m -> defineModule m cgm + +-------------------------------------- + +newtype ModuleValue = ModuleValue FFI.ValueRef + deriving (Show, Typeable) + +getModuleValues :: U.Module -> IO [(String, ModuleValue)] +getModuleValues = liftM (map (\ (s,p) -> (s, ModuleValue p))) . U.getModuleValues + +castModuleValue :: forall a . (IsType a) => ModuleValue -> Maybe (Value a) +castModuleValue (ModuleValue f) = + if U.valueHasType f (typeRef (undefined :: a)) then Just (Value f) else Nothing + +-------------------------------------- + +newtype Value a = Value { unValue :: FFI.ValueRef } + deriving (Show, Typeable) + +newtype ConstValue a = ConstValue { unConstValue :: FFI.ValueRef } + deriving (Show, Typeable) + +-- XXX merge with IsArithmetic? +class IsConst a where + constOf :: a -> ConstValue a + +instance IsConst Bool where constOf = constEnum (typeRef True) +--instance IsConst Char where constOf = constEnum (typeRef (0::Word8)) -- XXX Unicode +instance IsConst Word8 where constOf = constI +instance IsConst Word16 where constOf = constI +instance IsConst Word32 where constOf = constI +instance IsConst Word64 where constOf = constI +instance IsConst Int8 where constOf = constI +instance IsConst Int16 where constOf = constI +instance IsConst Int32 where constOf = constI +instance IsConst Int64 where constOf = constI +instance IsConst Float where constOf = constF +instance IsConst Double where constOf = constF +--instance IsConst FP128 where constOf = constF + +-- This instance doesn't belong here, but mutually recursive modules are painful. +instance (IsType a) => IsConst (Ptr a) where + constOf p = + let ip = p `minusPtr` nullPtr + inttoptrC (ConstValue v) = ConstValue $ FFI.constIntToPtr v (typeRef (undefined :: Ptr a)) + in if sizeOf p == 4 then + inttoptrC $ constOf (fromIntegral ip :: Word32) + else if sizeOf p == 8 then + inttoptrC $ constOf (fromIntegral ip :: Word64) + else + error "constOf Ptr: pointer size not 4 or 8" + +instance IsConst (StablePtr a) where + constOf p = + let ip = castStablePtrToPtr p `minusPtr` nullPtr + inttoptrC (ConstValue v) = ConstValue $ FFI.constIntToPtr v (typeRef (undefined :: StablePtr a)) + in if sizeOf p == 4 then + inttoptrC $ constOf (fromIntegral ip :: Word32) + else if sizeOf p == 8 then + inttoptrC $ constOf (fromIntegral ip :: Word64) + else + error "constOf Ptr: pointer size not 4 or 8" + +instance (IsPrimitive a, IsConst a, IsPowerOf2 n) => IsConst (Vector n a) where + constOf (Vector xs) = constVector (map constOf xs) + +instance (IsConst a, IsSized a s, Nat n) => IsConst (Array n a) where + constOf (Array xs) = constArray (map constOf xs) + +instance (IsConstFields a) => IsConst (Struct a) where + constOf (Struct a) = ConstValue $ U.constStruct (constFieldsOf a) False +instance (IsConstFields a) => IsConst (PackedStruct a) where + constOf (PackedStruct a) = ConstValue $ U.constStruct (constFieldsOf a) True + +class IsConstFields a where + constFieldsOf :: a -> [FFI.ValueRef] + +instance (IsConst a, IsConstFields as) => IsConstFields (a, as) where + constFieldsOf (a, as) = unConstValue (constOf a) : constFieldsOf as +instance IsConstFields () where + constFieldsOf _ = [] + +constEnum :: (Enum a) => FFI.TypeRef -> a -> ConstValue a +constEnum t i = ConstValue $ FFI.constInt t (fromIntegral $ fromEnum i) 0 + +constI :: (IsInteger a, Integral a) => a -> ConstValue a +constI i = ConstValue $ FFI.constInt (typeRef i) (fromIntegral i) (fromIntegral $ fromEnum $ isSigned i) + +constF :: (IsFloating a, Real a) => a -> ConstValue a +constF i = ConstValue $ FFI.constReal (typeRef i) (realToFrac i) + +valueOf :: (IsConst a) => a -> Value a +valueOf = value . constOf + +value :: ConstValue a -> Value a +value (ConstValue a) = Value a + +zero :: forall a . (IsType a) => ConstValue a +zero = ConstValue $ FFI.constNull $ typeRef (undefined :: a) + +allOnes :: forall a . (IsInteger a) => ConstValue a +allOnes = ConstValue $ FFI.constAllOnes $ typeRef (undefined :: a) + +undef :: forall a . (IsType a) => ConstValue a +undef = ConstValue $ FFI.getUndef $ typeRef (undefined :: a) + +{- +createString :: String -> ConstValue (DynamicArray Word8) +createString = ConstValue . U.constString + +constStringNul :: String -> ConstValue (DynamicArray Word8) +constStringNul = ConstValue . U.constStringNul +-} + +-------------------------------------- + +type FunctionRef = FFI.ValueRef + +-- |A function is simply a pointer to the function. +type Function a = Value (Ptr a) + +-- | Create a new named function. +newNamedFunction :: forall a . (IsFunction a) + => Linkage + -> String -- ^ Function name + -> CodeGenModule (Function a) +newNamedFunction linkage name = do + modul <- getModule + let typ = typeRef (undefined :: a) + 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. +newFunction :: forall a . (IsFunction a) + => Linkage + -> CodeGenModule (Function a) +newFunction linkage = genMSym "fun" >>= newNamedFunction linkage + +-- | Define a function body. The basic block returned by the function is the function entry point. +defineFunction :: forall f g r . (FunctionArgs f g (CodeGenFunction r ())) + => Function f -- ^ Function to define (created by 'newFunction'). + -> g -- ^ Function body. + -> CodeGenModule () +defineFunction (Value fn) body = do + bld <- liftIO $ U.createBuilder + let body' = do + l <- newBasicBlock + defineBasicBlock l + applyArgs fn body :: CodeGenFunction r () + runCodeGenFunction bld fn body' + return () + +-- | Create a new function with the given body. +createFunction :: (IsFunction f, FunctionArgs f g (CodeGenFunction r ())) + => Linkage + -> g -- ^ Function body. + -> CodeGenModule (Function f) +createFunction linkage body = do + f <- newFunction linkage + defineFunction f body + return f + +-- | Create a new function with the given body. +createNamedFunction :: (IsFunction f, FunctionArgs f g (CodeGenFunction r ())) + => Linkage + -> String + -> g -- ^ Function body. + -> CodeGenModule (Function f) +createNamedFunction linkage name body = do + f <- newNamedFunction linkage name + defineFunction f body + return f + +-- | Add attributes to a value. Beware, what attributes are allowed depends on +-- what kind of value it is. +addAttributes :: Value a -> Int -> [FFI.Attribute] -> CodeGenFunction r () +addAttributes (Value f) i as = do + liftIO $ FFI.addInstrAttribute f (fromIntegral i) (sum $ map FFI.fromAttribute as) + +-- XXX This is ugly, it must be possible to make it simpler +-- Convert a function of type f = t1->t2->...-> IO r to +-- g = Value t1 -> Value t2 -> ... CodeGenFunction r () +class FunctionArgs f g r | f -> g r, g r -> f where + apArgs :: Int -> FunctionRef -> g -> r + +applyArgs :: (FunctionArgs f g r) => FunctionRef -> g -> r +applyArgs = apArgs 0 + +instance (FunctionArgs b b' r) => FunctionArgs (a -> b) (Value a -> b') r where + apArgs n f g = apArgs (n+1) f (g $ Value $ U.getParam f n) + +instance (MakeValueTuple a a', FunctionArgs b b' r) => FunctionArgs (a :+-> b) (a' :+-> b') r where + apArgs n f g = + let (x,m) = runState (buildTuple f) n + in apArgs m f (g $+ asTypeOf x (valueTupleOf (undefined::a))) + +-- XXX instances for all IsFirstClass functions, +-- because Haskell can't deal with the context and the FD +type FA a = CodeGenFunction a () +instance FunctionArgs (IO Float) (FA Float) (FA Float) where apArgs _ _ g = g +instance FunctionArgs (IO Double) (FA Double) (FA Double) where apArgs _ _ g = g +instance FunctionArgs (IO FP128) (FA FP128) (FA FP128) where apArgs _ _ g = g +instance (Pos n) => + FunctionArgs (IO (IntN n)) (FA (IntN n)) (FA (IntN n)) where apArgs _ _ g = g +instance (Pos n) => + FunctionArgs (IO (WordN n)) (FA (WordN n)) (FA (WordN n)) where apArgs _ _ g = g +instance FunctionArgs (IO Bool) (FA Bool) (FA Bool) where apArgs _ _ g = g +instance FunctionArgs (IO Int8) (FA Int8) (FA Int8) where apArgs _ _ g = g +instance FunctionArgs (IO Int16) (FA Int16) (FA Int16) where apArgs _ _ g = g +instance FunctionArgs (IO Int32) (FA Int32) (FA Int32) where apArgs _ _ g = g +instance FunctionArgs (IO Int64) (FA Int64) (FA Int64) where apArgs _ _ g = g +instance FunctionArgs (IO Word8) (FA Word8) (FA Word8) where apArgs _ _ g = g +instance FunctionArgs (IO Word16) (FA Word16) (FA Word16) where apArgs _ _ g = g +instance FunctionArgs (IO Word32) (FA Word32) (FA Word32) where apArgs _ _ g = g +instance FunctionArgs (IO Word64) (FA Word64) (FA Word64) where apArgs _ _ g = g +instance FunctionArgs (IO ()) (FA ()) (FA ()) where apArgs _ _ g = g +instance (Pos n, IsPrimitive a) => + FunctionArgs (IO (Vector n a)) (FA (Vector n a)) (FA (Vector n a)) where apArgs _ _ g = g +instance (IsType a) => + FunctionArgs (IO (Ptr a)) (FA (Ptr a)) (FA (Ptr a)) where apArgs _ _ g = g +instance FunctionArgs (IO (StablePtr a)) (FA (StablePtr a)) (FA (StablePtr a)) where apArgs _ _ g = g + +-- |This class is just to simplify contexts. +class (FunctionArgs (IO a) (CodeGenFunction a ()) (CodeGenFunction a ())) => FunctionRet a +instance (FunctionArgs (IO a) (CodeGenFunction a ()) (CodeGenFunction a ())) => FunctionRet a + +-------------------------------------- + +class Undefined a => ValueTuple a where + buildTuple :: FunctionRef -> State Int a + +buildAtom :: FunctionRef -> State Int (Value a) +buildAtom f = + do n <- get + put (n+1) + return (Value (U.getParam f n)) + +instance ValueTuple () where + buildTuple _ = return () + +instance (ValueTuple a, ValueTuple b) => + ValueTuple (a,b) where + buildTuple f = + liftM2 (,) (buildTuple f) (buildTuple f) + +instance (ValueTuple a, ValueTuple b, ValueTuple c) => + ValueTuple (a,b,c) where + buildTuple f = + liftM3 (,,) (buildTuple f) (buildTuple f) (buildTuple f) + +instance IsFirstClass a => ValueTuple (Value a) where + buildTuple = buildAtom + + + +class Undefined a where + undefTuple :: a + +instance Undefined () where + undefTuple = () + +instance (IsFirstClass a) => Undefined (Value a) where + undefTuple = value undef + +instance (Undefined a, Undefined b) => Undefined (a, b) where + undefTuple = (undefTuple, undefTuple) + +instance (Undefined a, Undefined b, Undefined c) => Undefined (a, b, c) where + undefTuple = (undefTuple, undefTuple, undefTuple) + + + +{- +ToDo: flip type parameter order in order to match good style +-} +class (IsTuple haskellValue, ValueTuple llvmValue) => + MakeValueTuple haskellValue llvmValue | haskellValue -> llvmValue where + valueTupleOf :: haskellValue -> llvmValue + +instance (MakeValueTuple ah al, MakeValueTuple bh bl) => + MakeValueTuple (ah,bh) (al,bl) where + valueTupleOf ~(a,b) = (valueTupleOf a, valueTupleOf b) + +instance (MakeValueTuple ah al, MakeValueTuple bh bl, MakeValueTuple ch cl) => + MakeValueTuple (ah,bh,ch) (al,bl,cl) where + valueTupleOf ~(a,b,c) = (valueTupleOf a, valueTupleOf b, valueTupleOf c) + +instance MakeValueTuple Float (Value Float) where valueTupleOf = valueOf +instance MakeValueTuple Double (Value Double) where valueTupleOf = valueOf +-- instance MakeValueTuple FP128 (Value FP128) where valueTupleOf = valueOf +instance MakeValueTuple Bool (Value Bool) where valueTupleOf = valueOf +instance MakeValueTuple Int8 (Value Int8) where valueTupleOf = valueOf +instance MakeValueTuple Int16 (Value Int16) where valueTupleOf = valueOf +instance MakeValueTuple Int32 (Value Int32) where valueTupleOf = valueOf +instance MakeValueTuple Int64 (Value Int64) where valueTupleOf = valueOf +instance MakeValueTuple Word8 (Value Word8) where valueTupleOf = valueOf +instance MakeValueTuple Word16 (Value Word16) where valueTupleOf = valueOf +instance MakeValueTuple Word32 (Value Word32) where valueTupleOf = valueOf +instance MakeValueTuple Word64 (Value Word64) where valueTupleOf = valueOf +instance MakeValueTuple () () where valueTupleOf = id + +{- +I'm not sure about this instance. +Maybe it is better to convert the pointer target type +according to a class that maps Haskell tuples to LLVM structs. +-} +instance IsType a => + MakeValueTuple (Ptr a) (Value (Ptr a)) where valueTupleOf = valueOf +instance MakeValueTuple (StablePtr a) (Value (StablePtr a)) where valueTupleOf = valueOf + +{- +instance (MakeValueTuple haskellValue llvmValue, Memory llvmValue llvmStruct) => + MakeValueTuple (Ptr haskellValue) (Value (Ptr llvmStruct)) where + valueTupleOf = valueOf . castStorablePtr +instance (Pos n) => + MakeValueTuple (IntN n) (Value (IntN n)) where +instance (Pos n) => + MakeValueTuple (WordN n) (Value (WordN n)) where +-} +instance (IsPowerOf2 n, IsPrimitive a, IsConst a) => + MakeValueTuple (Vector n a) (Value (Vector n a)) where valueTupleOf = valueOf + + +-------------------------------------- + +-- |A basic block is a sequence of non-branching instructions, terminated by a control flow instruction. +newtype BasicBlock = BasicBlock FFI.BasicBlockRef + deriving (Show, Typeable) + +createBasicBlock :: CodeGenFunction r BasicBlock +createBasicBlock = do + b <- newBasicBlock + defineBasicBlock b + return b + +newBasicBlock :: CodeGenFunction r BasicBlock +newBasicBlock = genFSym >>= newNamedBasicBlock + +newNamedBasicBlock :: String -> CodeGenFunction r BasicBlock +newNamedBasicBlock name = do + fn <- getFunction + liftIO $ liftM BasicBlock $ U.appendBasicBlock fn name + +defineBasicBlock :: BasicBlock -> CodeGenFunction r () +defineBasicBlock (BasicBlock l) = do + bld <- getBuilder + liftIO $ U.positionAtEnd bld l + +getCurrentBasicBlock :: CodeGenFunction r BasicBlock +getCurrentBasicBlock = do + bld <- getBuilder + liftIO $ liftM BasicBlock $ U.getInsertBlock bld + +toLabel :: BasicBlock -> Value Label +toLabel (BasicBlock ptr) = Value (FFI.basicBlockAsValue ptr) + +fromLabel :: Value Label -> BasicBlock +fromLabel (Value ptr) = BasicBlock (FFI.valueAsBasicBlock ptr) + +-------------------------------------- + +-- | Create a reference to an external function while code generating for a function. +-- If LLVM cannot resolve its name, then you may try 'staticFunction'. +externFunction :: forall a r . (IsFunction a) => String -> CodeGenFunction r (Function a) +externFunction name = do + es <- getExterns + case lookup name es of + Just f -> return $ Value f + Nothing -> do + let linkage = ExternalLinkage + modul <- getFunctionModule + let typ = typeRef (undefined :: a) + f <- liftIO $ U.addFunction modul linkage name typ + putExterns ((name, f) : es) + return $ Value f + +{- | +Make an external C function with a fixed address callable from LLVM code. +This callback function can also be a Haskell function, +that was imported like + +> foreign import ccall "&nextElement" +> nextElementFunPtr :: FunPtr (StablePtr (IORef [Word32]) -> IO Word32) + +See @examples\/List.hs@. + +When you only use 'externFunction', then LLVM cannot resolve the name. +(However, I do not know why.) +Thus 'staticFunction' manages a list of static functions. +This list is automatically installed by 'ExecutionEngine.simpleFunction' +and can be manually obtained by 'getGlobalMappings' +and installed by 'ExecutionEngine.addGlobalMappings'. +\"Installing\" means calling LLVM's @addGlobalMapping@ according to +. +-} +staticFunction :: (IsFunction f) => FunPtr f -> CodeGenFunction r (Function f) +staticFunction func = do + modul <- getFunctionModule + let typ :: IsType a => FunPtr a -> a -> FFI.TypeRef + typ _ x = typeRef x + val <- liftIO $ U.addFunction modul ExternalLinkage + "" (typ func undefined) + addGlobalMapping val (castFunPtrToPtr func) + return $ Value val + +-------------------------------------- + +withCurrentBuilder :: (FFI.BuilderRef -> IO a) -> CodeGenFunction r a +withCurrentBuilder body = do + bld <- getBuilder + liftIO $ U.withBuilder bld body + +-------------------------------------- + +-- Mark all block terminating instructions. Not used yet. +--data Terminate = Terminate + +-------------------------------------- + +type Global a = Value (Ptr a) + +-- | Create a new named global variable. +newNamedGlobal :: forall a . (IsType a) + => Bool -- ^Constant? + -> Linkage -- ^Visibility + -> String -- ^Name + -> TGlobal a +newNamedGlobal isConst linkage name = do + modul <- getModule + let typ = typeRef (undefined :: a) + liftIO $ liftM Value $ do g <- U.addGlobal modul linkage name typ + when isConst $ FFI.setGlobalConstant g 1 + return g + +-- | Create a new global variable. +newGlobal :: forall a . (IsType a) => Bool -> Linkage -> TGlobal a +newGlobal isConst linkage = genMSym "glb" >>= newNamedGlobal isConst linkage + +-- | Give a global variable a (constant) value. +defineGlobal :: Global a -> ConstValue a -> CodeGenModule () +defineGlobal (Value g) (ConstValue v) = + liftIO $ FFI.setInitializer g v + +-- | Create and define a global variable. +createGlobal :: (IsType a) => Bool -> Linkage -> ConstValue a -> TGlobal a +createGlobal isConst linkage con = do + g <- newGlobal isConst linkage + defineGlobal g con + return g + +-- | Create and define a named global variable. +createNamedGlobal :: (IsType a) => Bool -> Linkage -> String -> ConstValue a -> TGlobal a +createNamedGlobal isConst linkage name con = do + g <- newNamedGlobal isConst linkage name + defineGlobal g con + return g + +type TFunction a = CodeGenModule (Function a) +type TGlobal a = CodeGenModule (Global a) + +-- Special string creators +createString :: String -> TGlobal (Array n Word8) +createString s = string (length s) (U.constString s) + +createStringNul :: String -> TGlobal (Array n Word8) +createStringNul s = string (length s + 1) (U.constStringNul s) + +string :: Int -> FFI.ValueRef -> TGlobal (Array n Word8) +string n s = do + modul <- getModule + name <- genMSym "str" + let typ = FFI.arrayType (typeRef (undefined :: Word8)) (fromIntegral n) + liftIO $ liftM Value $ do g <- U.addGlobal modul InternalLinkage name typ + FFI.setGlobalConstant g 1 + FFI.setInitializer g s + return g + +-------------------------------------- + +-- |Make a constant vector. Replicates or truncates the list to get length /n/. +constVector :: forall a n . (Pos n) => [ConstValue a] -> ConstValue (Vector n a) +constVector xs = + ConstValue $ U.constVector (toNum (undefined :: n)) [ v | ConstValue v <- xs ] + +-- |Make a constant array. Replicates or truncates the list to get length /n/. +constArray :: forall a n s . (IsSized a s, Nat n) => [ConstValue a] -> ConstValue (Array n a) +constArray xs = + ConstValue $ U.constArray (typeRef (undefined :: a)) (toNum (undefined :: n)) [ v | ConstValue v <- xs ] + +-- |Make a constant struct. +constStruct :: (IsConstStruct c a) => c -> ConstValue (Struct a) +constStruct struct = + ConstValue $ U.constStruct (constValueFieldsOf struct) False + +-- |Make a constant packed struct. +constPackedStruct :: (IsConstStruct c a) => c -> ConstValue (PackedStruct a) +constPackedStruct struct = + ConstValue $ U.constStruct (constValueFieldsOf struct) True + +class IsConstStruct c a | a -> c, c -> a where + constValueFieldsOf :: c -> [FFI.ValueRef] + +instance (IsConst a, IsConstStruct cs as) => IsConstStruct (ConstValue a, cs) (a, as) where + constValueFieldsOf (a, as) = unConstValue a : constValueFieldsOf as +instance IsConstStruct () () where + constValueFieldsOf _ = [] diff --git a/LLVM/Core/CodeGenMonad.hs b/LLVM/Core/CodeGenMonad.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core/CodeGenMonad.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} +module LLVM.Core.CodeGenMonad( + -- * Module code generation + CodeGenModule, runCodeGenModule, genMSym, getModule, + GlobalMappings(..), addGlobalMapping, getGlobalMappings, + -- * Function code generation + CodeGenFunction, runCodeGenFunction, genFSym, getFunction, getBuilder, getFunctionModule, getExterns, putExterns, + -- * Reexport + liftIO + ) where +import Data.Typeable +import Control.Monad.State + +import Foreign.Ptr (Ptr, ) + +import LLVM.Core.Util(Module, Builder, Function) + +-------------------------------------- + +data CGMState = CGMState { + cgm_module :: Module, + cgm_externs :: [(String, Function)], + cgm_global_mappings :: [(Function, Ptr ())], + cgm_next :: !Int + } + deriving (Show, Typeable) +newtype CodeGenModule a = CGM (StateT CGMState IO a) + deriving (Functor, Monad, MonadState CGMState, MonadIO, Typeable) + +genMSym :: String -> CodeGenModule String +genMSym prefix = do + s <- get + let n = cgm_next s + put (s { cgm_next = n + 1 }) + return $ "_" ++ prefix ++ show n + +getModule :: CodeGenModule Module +getModule = gets cgm_module + +runCodeGenModule :: Module -> CodeGenModule a -> IO a +runCodeGenModule m (CGM body) = do + let cgm = CGMState { cgm_module = m, cgm_next = 1, cgm_externs = [], cgm_global_mappings = [] } + evalStateT body cgm + +-------------------------------------- + +data CGFState r = CGFState { + cgf_module :: CGMState, + cgf_builder :: Builder, + cgf_function :: Function, + cgf_next :: !Int + } + deriving (Show, Typeable) +newtype CodeGenFunction r a = CGF (StateT (CGFState r) IO a) + deriving (Functor, Monad, MonadState (CGFState r), MonadIO, Typeable) + +genFSym :: CodeGenFunction a String +genFSym = do + s <- get + let n = cgf_next s + put (s { cgf_next = n + 1 }) + return $ "_L" ++ show n + +getFunction :: CodeGenFunction a Function +getFunction = gets cgf_function + +getBuilder :: CodeGenFunction a Builder +getBuilder = gets cgf_builder + +getFunctionModule :: CodeGenFunction a Module +getFunctionModule = gets (cgm_module . cgf_module) + +getExterns :: CodeGenFunction a [(String, Function)] +getExterns = gets (cgm_externs . cgf_module) + +putExterns :: [(String, Function)] -> CodeGenFunction a () +putExterns es = do + cgf <- get + let cgm' = (cgf_module cgf) { cgm_externs = es } + put (cgf { cgf_module = cgm' }) + +addGlobalMapping :: + Function -> Ptr () -> CodeGenFunction r () +addGlobalMapping value func = + -- could be written in a nicer way using Data.Accessor + modify $ \cgf -> + let cgm = cgf_module cgf + in cgf { cgf_module = + cgm { cgm_global_mappings = + (value,func) : cgm_global_mappings cgm } } + +newtype GlobalMappings = + GlobalMappings [(Function, Ptr ())] + +{- | +Get a list created by calls to 'staticFunction' +that must be passed to the execution engine +via 'LLVM.ExecutionEngine.addGlobalMappings'. +-} +getGlobalMappings :: + CodeGenModule GlobalMappings +getGlobalMappings = + gets (GlobalMappings . cgm_global_mappings) + +runCodeGenFunction :: Builder -> Function -> CodeGenFunction r a -> CodeGenModule a +runCodeGenFunction bld fn (CGF body) = do + cgm <- get + let cgf = CGFState { cgf_module = cgm, + cgf_builder = bld, + cgf_function = fn, + cgf_next = 1 } + (a, cgf') <- liftIO $ runStateT body cgf + put (cgf_module cgf') + return a diff --git a/LLVM/Core/Data.hs b/LLVM/Core/Data.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core/Data.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE EmptyDataDecls, DeriveDataTypeable #-} +module LLVM.Core.Data(IntN(..), WordN(..), FP128(..), + Array(..), Vector(..), Ptr, Label, Struct(..), PackedStruct(..)) where +import Data.Typeable +import Foreign.Ptr(Ptr) +import Data.TypeLevel + +-- TODO: +-- Make instances IntN, WordN to actually do the right thing. +-- Make FP128 do the right thing +-- Make Array functions. + +-- |Variable sized signed integer. +-- The /n/ parameter should belong to @PosI@. +newtype (Pos n) => IntN n = IntN Integer + deriving (Show, Typeable) + +-- |Variable sized unsigned integer. +-- The /n/ parameter should belong to @PosI@. +newtype (Pos n) => WordN n = WordN Integer + deriving (Show, Typeable) + +-- |128 bit floating point. +newtype FP128 = FP128 Rational + deriving (Show, Typeable) + +-- |Fixed sized arrays, the array size is encoded in the /n/ parameter. +newtype (Nat n) => Array n a = Array [a] + deriving (Show, Typeable) + +-- |Fixed sized vector, the array size is encoded in the /n/ parameter. +newtype Vector n a = Vector [a] + deriving (Show, Typeable) + +-- |Label type, produced by a basic block. +data Label + deriving (Typeable) + +-- |Struct types; a list (nested tuple) of component types. +newtype Struct a = Struct a + deriving (Show, Typeable) +newtype PackedStruct a = PackedStruct a + deriving (Show, Typeable) + diff --git a/LLVM/Core/Instructions.hs b/LLVM/Core/Instructions.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core/Instructions.hs @@ -0,0 +1,757 @@ +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, TypeSynonymInstances, ScopedTypeVariables, OverlappingInstances, FlexibleContexts, TypeOperators, DeriveDataTypeable #-} +module LLVM.Core.Instructions( + -- * Terminator instructions + ret, + condBr, + br, + switch, + invoke, + unwind, + unreachable, + -- * Arithmetic binary operations + -- | 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. + shl, lshr, ashr, and, or, xor, inv, + -- * Vector operations + extractelement, + insertelement, + shufflevector, + -- * Aggregate operations + extractvalue, + insertvalue, + -- * Memory access + malloc, arrayMalloc, + alloca, arrayAlloca, + free, + load, + store, + getElementPtr, getElementPtr0, + -- * Conversions + trunc, zext, sext, + fptrunc, fpext, + fptoui, fptosi, + uitofp, sitofp, + ptrtoint, inttoptr, + bitcast, bitcastUnify, + -- * Comparison + IntPredicate(..), FPPredicate(..), + CmpRet, + icmp, fcmp, + select, + -- * Other + phi, addPhiInputs, + call, + -- * Classes and types + Terminate, + Ret, CallArgs, ABinOp, CmpOp, FunctionArgs, FunctionRet, IsConst, + AllocArg, + GetElementPtr, IsIndexArg, GetValue + ) where +import Prelude hiding (and, or) +import Data.Typeable +import Control.Monad(liftM) +import Data.Int +import Data.Word +import Foreign.C(CInt, CUInt) +import Data.TypeLevel((:<:), (:>:), (:==:), D0, toNum, Succ, Nat) +import qualified LLVM.FFI.Core as FFI +import LLVM.Core.Data +import LLVM.Core.Type +import LLVM.Core.CodeGenMonad +import LLVM.Core.CodeGen +import qualified LLVM.Core.Util as U + +-- TODO: +-- Add vector version of arithmetic +-- Add rest of instructions +-- Use Terminate to ensure bb termination (how?) +-- more intrinsics are needed to, e.g., create an empty vector + +type Terminate = () +terminate :: Terminate +terminate = () + +-------------------------------------- + +-- |Acceptable arguments to the 'ret' instruction. +class Ret a r where + ret' :: a -> CodeGenFunction r Terminate + +-- | Return from the current function with the given value. Use () as the return value for what would be a void function is C. +ret :: (Ret a r) => a -> CodeGenFunction r Terminate +ret = ret' + +instance (IsFirstClass a, IsConst a) => Ret a a where + ret' = ret . valueOf + +instance Ret (Value a) a where + ret' (Value a) = do + withCurrentBuilder $ \ bldPtr -> FFI.buildRet bldPtr a + return terminate + +instance Ret () () where + ret' _ = do + withCurrentBuilder $ FFI.buildRetVoid + return terminate + +-------------------------------------- + +-- | Branch to the first basic block if the boolean is true, otherwise to the second basic block. +condBr :: Value Bool -- ^ Boolean to branch upon. + -> BasicBlock -- ^ Target for true. + -> BasicBlock -- ^ Target for false. + -> CodeGenFunction r Terminate +condBr (Value b) (BasicBlock t1) (BasicBlock t2) = do + withCurrentBuilder $ \ bldPtr -> FFI.buildCondBr bldPtr b t1 t2 + return terminate + +-------------------------------------- + +-- | Unconditionally branch to the given basic block. +br :: BasicBlock -- ^ Branch target. + -> CodeGenFunction r Terminate +br (BasicBlock t) = do + withCurrentBuilder $ \ bldPtr -> FFI.buildBr bldPtr t + return terminate + +-------------------------------------- + +-- | Branch table instruction. +switch :: (IsInteger a) + => Value a -- ^ Value to branch upon. + -> BasicBlock -- ^ Default branch target. + -> [(ConstValue a, BasicBlock)] -- ^ Labels and corresponding branch targets. + -> CodeGenFunction r Terminate +switch (Value val) (BasicBlock dflt) arms = do + withCurrentBuilder $ \ bldPtr -> do + inst <- FFI.buildSwitch bldPtr val dflt (fromIntegral $ length arms) + sequence_ [ FFI.addCase inst c b | (ConstValue c, BasicBlock b) <- arms ] + return terminate + +-------------------------------------- + +-- |Unwind the call stack until a function call performed with 'invoke' is reached. +-- I.e., throw a non-local exception. +unwind :: CodeGenFunction r Terminate +unwind = do + withCurrentBuilder FFI.buildUnwind + return terminate + +-- |Inform the code generator that this code can never be reached. +unreachable :: CodeGenFunction r Terminate +unreachable = do + withCurrentBuilder FFI.buildUnreachable + return terminate + +-------------------------------------- + +type FFIBinOp = FFI.BuilderRef -> FFI.ValueRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef +type FFIConstBinOp = FFI.ValueRef -> FFI.ValueRef -> FFI.ValueRef + +-- |Acceptable arguments to arithmetic binary instructions. +class ABinOp a b c | a b -> c where + abinop :: FFIConstBinOp -> FFIBinOp -> a -> b -> CodeGenFunction r c + +add :: ({-IsInteger-} IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +add = abinop FFI.constAdd FFI.buildAdd +sub :: ({-IsInteger-} IsArithmetic c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +sub = abinop FFI.constSub FFI.buildSub +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) +udiv = abinop FFI.constUDiv FFI.buildUDiv +sdiv :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +sdiv = abinop FFI.constSDiv FFI.buildSDiv +urem :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +urem = abinop FFI.constURem FFI.buildURem +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 +-- | Floating point remainder. +frem :: (IsFloating c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +frem = abinop FFI.constFRem FFI.buildFRem + +shl :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +shl = abinop FFI.constShl FFI.buildShl +lshr :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +lshr = abinop FFI.constLShr FFI.buildLShr +ashr :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +ashr = abinop FFI.constAShr FFI.buildAShr +and :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +and = abinop FFI.constAnd FFI.buildAnd +or :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +or = abinop FFI.constOr FFI.buildOr +xor :: (IsInteger c, ABinOp a b (v c)) => a -> b -> CodeGenFunction r (v c) +xor = abinop FFI.constXor FFI.buildXor + +instance ABinOp (Value a) (Value a) (Value a) where + abinop _ op (Value a1) (Value a2) = buildBinOp op a1 a2 + +instance ABinOp (ConstValue a) (Value a) (Value a) where + abinop _ op (ConstValue a1) (Value a2) = buildBinOp op a1 a2 + +instance ABinOp (Value a) (ConstValue a) (Value a) where + abinop _ op (Value a1) (ConstValue a2) = buildBinOp op a1 a2 + +instance ABinOp (ConstValue a) (ConstValue a) (ConstValue a) where + abinop cop _ (ConstValue a1) (ConstValue a2) = + return $ ConstValue $ cop a1 a2 + +instance (IsConst a) => ABinOp (Value a) a (Value a) where + abinop cop op a1 a2 = abinop cop op a1 (constOf a2) + +instance (IsConst a) => ABinOp a (Value a) (Value a) where + abinop cop op a1 a2 = abinop cop op (constOf a1) a2 + +--instance (IsConst a) => ABinOp a a (ConstValue a) where +-- abinop cop op a1 a2 = abinop cop op (constOf a1) (constOf a2) + +buildBinOp :: FFIBinOp -> FFI.ValueRef -> FFI.ValueRef -> CodeGenFunction r (Value a) +buildBinOp op a1 a2 = + liftM Value $ + withCurrentBuilder $ \ bld -> + U.withEmptyCString $ op bld a1 a2 + +type FFIUnOp = FFI.BuilderRef -> FFI.ValueRef -> U.CString -> IO FFI.ValueRef + +buildUnOp :: FFIUnOp -> FFI.ValueRef -> CodeGenFunction r (Value a) +buildUnOp op a = + liftM Value $ + withCurrentBuilder $ \ bld -> + U.withEmptyCString $ op bld a + +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 + +-------------------------------------- + +-- | Get a value from a vector. +extractelement :: Value (Vector n a) -- ^ Vector + -> Value Word32 -- ^ Index into the vector + -> CodeGenFunction r (Value a) +extractelement (Value vec) (Value i) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildExtractElement bldPtr vec i + +-- | Insert a value into a vector, nondestructive. +insertelement :: Value (Vector n a) -- ^ Vector + -> Value a -- ^ Value to insert + -> Value Word32 -- ^ Index into the vector + -> CodeGenFunction r (Value (Vector n a)) +insertelement (Value vec) (Value e) (Value i) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildInsertElement bldPtr vec e i + +-- XXX The documentation say the mask and result can different length from +-- the two first operand, but the C++ code doesn't do that. +-- | Permute vector. +shufflevector :: Value (Vector n a) + -> Value (Vector n a) + -> ConstValue (Vector n Word32) + -> CodeGenFunction r (Value (Vector n a)) +shufflevector (Value a) (Value b) (ConstValue mask) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildShuffleVector bldPtr a b mask + + +-- |Acceptable arguments to 'extractvalue' and 'insertvalue'. +class GetValue agg ix el | agg ix -> el where + getIx :: agg -> ix -> CUInt + +instance (GetField as i a, Nat i) => GetValue (Struct as) i a where + getIx _ n = toNum n + +instance (IsFirstClass a, Nat n) => GetValue (Array n a) Word32 a where + getIx _ n = fromIntegral n + +instance (IsFirstClass a, Nat n) => GetValue (Array n a) Word64 a where + getIx _ n = fromIntegral n + +-- | Get a value from an aggregate. +extractvalue :: forall r agg i a. + GetValue agg i a + => Value agg -- ^ Aggregate + -> i -- ^ Index into the aggregate + -> CodeGenFunction r (Value a) +extractvalue (Value agg) i = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildExtractValue bldPtr agg (getIx (undefined::agg) i) + +-- | Insert a value into an aggregate, nondestructive. +insertvalue :: forall r agg i a. + GetValue agg i a + => Value agg -- ^ Aggregate + -> Value a -- ^ Value to insert + -> i -- ^ Index into the aggregate + -> CodeGenFunction r (Value agg) +insertvalue (Value agg) (Value e) i = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildInsertValue bldPtr agg e (getIx (undefined::agg) i) + + +-------------------------------------- + +-- XXX should allows constants + +-- | Truncate a value to a shorter bit width. +trunc :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :>: sb) + => Value a -> CodeGenFunction r (Value b) +trunc = convert FFI.buildTrunc + +-- | Zero extend a value to a wider width. +zext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb) + => Value a -> CodeGenFunction r (Value b) +zext = convert FFI.buildZExt + +-- | Sign extend a value to wider width. +sext :: (IsInteger a, IsInteger b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb) + => Value a -> CodeGenFunction r (Value b) +sext = convert FFI.buildSExt + +-- | Truncate a floating point value. +fptrunc :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :>: sb) + => Value a -> CodeGenFunction r (Value b) +fptrunc = convert FFI.buildFPTrunc + +-- | Extend a floating point value. +fpext :: (IsFloating a, IsFloating b, IsPrimitive a, IsPrimitive b, IsSized a sa, IsSized b sb, sa :<: sb) + => Value a -> CodeGenFunction r (Value b) +fpext = convert FFI.buildFPExt + +-- | Convert a floating point value to an unsigned integer. +fptoui :: (IsFloating a, IsInteger b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b) +fptoui = convert FFI.buildFPToUI + +-- | Convert a floating point value to a signed integer. +fptosi :: (IsFloating a, IsInteger b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b) +fptosi = convert FFI.buildFPToSI + +-- | Convert an unsigned integer to a floating point value. +uitofp :: (IsInteger a, IsFloating b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b) +uitofp = convert FFI.buildUIToFP + +-- | Convert a signed integer to a floating point value. +sitofp :: (IsInteger a, IsFloating b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b) +sitofp = convert FFI.buildSIToFP + +-- | Convert a pointer to an integer. +ptrtoint :: (IsInteger b, IsPrimitive b) => Value (Ptr a) -> CodeGenFunction r (Value b) +ptrtoint = convert FFI.buildPtrToInt + +-- | Convert an integer to a pointer. +inttoptr :: (IsInteger a, IsType b) => Value a -> CodeGenFunction r (Value (Ptr b)) +inttoptr = convert FFI.buildIntToPtr + +-- | Convert between to values of the same size by just copying the bit pattern. +bitcast :: (IsFirstClass a, IsFirstClass b, IsSized a sa, IsSized b sb, sa :==: sb) + => Value a -> CodeGenFunction r (Value b) +bitcast = convert FFI.buildBitCast + +-- | Same as bitcast but instead of the '(:==:)' type class it uses type unification. +-- This way, properties like reflexivity, symmetry and transitivity +-- are obvious to the Haskell compiler. +bitcastUnify :: (IsFirstClass a, IsFirstClass b, IsSized a s, IsSized b s) + => Value a -> CodeGenFunction r (Value b) +bitcastUnify = convert FFI.buildBitCast + +type FFIConvert = FFI.BuilderRef -> FFI.ValueRef -> FFI.TypeRef -> U.CString -> IO FFI.ValueRef + +convert :: forall a b r . (IsType b) => FFIConvert -> Value a -> CodeGenFunction r (Value b) +convert conv (Value a) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ conv bldPtr a (typeRef (undefined :: b)) + +-------------------------------------- + +data IntPredicate = + IntEQ -- ^ equal + | IntNE -- ^ not equal + | IntUGT -- ^ unsigned greater than + | IntUGE -- ^ unsigned greater or equal + | IntULT -- ^ unsigned less than + | IntULE -- ^ unsigned less or equal + | IntSGT -- ^ signed greater than + | IntSGE -- ^ signed greater or equal + | IntSLT -- ^ signed less than + | IntSLE -- ^ signed less or equal + deriving (Eq, Ord, Enum, Show, Typeable) + +fromIntPredicate :: IntPredicate -> CInt +fromIntPredicate p = fromIntegral (fromEnum p + 32) + +data FPPredicate = + FPFalse -- ^ Always false (always folded) + | FPOEQ -- ^ True if ordered and equal + | FPOGT -- ^ True if ordered and greater than + | FPOGE -- ^ True if ordered and greater than or equal + | FPOLT -- ^ True if ordered and less than + | FPOLE -- ^ True if ordered and less than or equal + | FPONE -- ^ True if ordered and operands are unequal + | FPORD -- ^ True if ordered (no nans) + | FPUNO -- ^ True if unordered: isnan(X) | isnan(Y) + | FPUEQ -- ^ True if unordered or equal + | FPUGT -- ^ True if unordered or greater than + | FPUGE -- ^ True if unordered, greater than, or equal + | FPULT -- ^ True if unordered or less than + | FPULE -- ^ True if unordered, less than, or equal + | FPUNE -- ^ True if unordered or not equal + | FPT -- ^ Always true (always folded) + deriving (Eq, Ord, Enum, Show, Typeable) + +fromFPPredicate :: FPPredicate -> CInt +fromFPPredicate p = fromIntegral (fromEnum p) + +-- |Acceptable operands to comparison instructions. +class CmpOp a b c d | a b -> c where + cmpop :: FFIBinOp -> a -> b -> CodeGenFunction r (Value d) + +instance CmpOp (Value a) (Value a) a d where + cmpop op (Value a1) (Value a2) = buildBinOp op a1 a2 + +instance (IsConst a) => CmpOp a (Value a) a d where + cmpop op a1 a2 = cmpop op (valueOf a1) a2 + +instance (IsConst a) => CmpOp (Value a) a a d where + cmpop op a1 a2 = cmpop op a1 (valueOf a2) + +class CmpRet a b | a -> b +instance CmpRet Float Bool +instance CmpRet Double Bool +instance CmpRet FP128 Bool +instance CmpRet Bool Bool +instance CmpRet Word8 Bool +instance CmpRet Word16 Bool +instance CmpRet Word32 Bool +instance CmpRet Word64 Bool +instance CmpRet Int8 Bool +instance CmpRet Int16 Bool +instance CmpRet Int32 Bool +instance CmpRet Int64 Bool +instance CmpRet (Ptr a) Bool +instance CmpRet (Vector n a) (Vector n Bool) + +-- | Compare integers. +icmp :: (IsIntegerOrPointer c, CmpOp a b c d, CmpRet c d) => + IntPredicate -> a -> b -> CodeGenFunction r (Value d) +icmp p = cmpop (flip FFI.buildICmp (fromIntPredicate p)) + +-- | Compare floating point values. +fcmp :: (IsFloating c, CmpOp a b c d, CmpRet c d) => + FPPredicate -> a -> b -> CodeGenFunction r (Value d) +fcmp p = cmpop (flip FFI.buildFCmp (fromFPPredicate p)) + +-------------------------------------- + +-- XXX could do const song and dance +-- | Select between two values depending on a boolean. +select :: (IsFirstClass a, CmpRet a b) => Value b -> Value a -> Value a -> CodeGenFunction r (Value a) +select (Value cnd) (Value thn) (Value els) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildSelect bldPtr cnd thn els + +-------------------------------------- + +type Caller = FFI.BuilderRef -> [FFI.ValueRef] -> IO FFI.ValueRef + +-- |Acceptable arguments to 'call'. +class CallArgs f g | f -> g, g -> f where + doCall :: Caller -> [FFI.ValueRef] -> f -> g + +instance (CallArgs b b') => CallArgs (a -> b) (Value a -> b') where + doCall mkCall args f (Value arg) = doCall mkCall (arg : args) (f (undefined :: a)) + +--instance (CallArgs b b') => CallArgs (a -> b) (ConstValue a -> b') where +-- doCall mkCall args f (ConstValue arg) = doCall mkCall (arg : args) (f (undefined :: a)) + +instance CallArgs (IO a) (CodeGenFunction r (Value a)) where + doCall = doCallDef + +doCallDef :: Caller -> [FFI.ValueRef] -> b -> CodeGenFunction r (Value a) +doCallDef mkCall args _ = + withCurrentBuilder $ \ bld -> + liftM Value $ mkCall bld (reverse args) + +-- | Call a function with the given arguments. The 'call' instruction is variadic, i.e., the number of arguments +-- it takes depends on the type of /f/. +call :: (CallArgs f g) => Function f -> g +call (Value f) = doCall (U.makeCall f) [] (undefined :: f) + +-- | Call a function with exception handling. +invoke :: (CallArgs f g) + => BasicBlock -- ^Normal return point. + -> BasicBlock -- ^Exception return point. + -> Function f -- ^Function to call. + -> g +invoke (BasicBlock norm) (BasicBlock expt) (Value f) = + doCall (U.makeInvoke norm expt f) [] (undefined :: f) + +-------------------------------------- + +-- XXX could do const song and dance +-- |Join several variables (virtual registers) from different basic blocks into one. +-- All of the variables in the list are joined. See also 'addPhiInputs'. +phi :: forall a r . (IsFirstClass a) => [(Value a, BasicBlock)] -> CodeGenFunction r (Value a) +phi incoming = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> do + inst <- U.buildEmptyPhi bldPtr (typeRef (undefined :: a)) + U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ] + return inst + +-- |Add additional inputs to an existing phi node. +-- The reason for this instruction is that sometimes the structure of the code +-- makes it impossible to have all variables in scope at the point where you need the phi node. +addPhiInputs :: forall a r . (IsFirstClass a) + => Value a -- ^Must be a variable from a call to 'phi'. + -> [(Value a, BasicBlock)] -- ^Variables to add. + -> CodeGenFunction r () +addPhiInputs (Value inst) incoming = + liftIO $ U.addPhiIns inst [ (v, b) | (Value v, BasicBlock b) <- incoming ] + + +-------------------------------------- + +-- | Acceptable argument to array memory allocation. +class AllocArg a where + getAllocArg :: a -> FFI.ValueRef +instance AllocArg (Value Word32) where + getAllocArg (Value v) = v +instance AllocArg (ConstValue Word32) where + getAllocArg = unConst +instance AllocArg Word32 where + getAllocArg = unConst . constOf + +-- XXX What's the type returned by malloc +-- | Allocate heap memory. +malloc :: forall a r s . (IsSized a s) => CodeGenFunction r (Value (Ptr a)) +malloc = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildMalloc bldPtr (typeRef (undefined :: a)) + +-- XXX What's the type returned by arrayMalloc? +-- | Allocate heap (array) memory. +arrayMalloc :: forall a n r s . (IsSized a n, AllocArg s) => + s -> CodeGenFunction r (Value (Ptr a)) -- XXX +arrayMalloc s = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildArrayMalloc bldPtr (typeRef (undefined :: a)) (getAllocArg s) + +-- XXX What's the type returned by malloc +-- | Allocate stack memory. +alloca :: forall a r s . (IsSized a s) => CodeGenFunction r (Value (Ptr a)) +alloca = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildAlloca bldPtr (typeRef (undefined :: a)) + +-- XXX What's the type returned by arrayAlloca? +-- | Allocate stack (array) memory. +arrayAlloca :: forall a n r s . (IsSized a n, AllocArg s) => + s -> CodeGenFunction r (Value (Ptr a)) +arrayAlloca s = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ + FFI.buildArrayAlloca bldPtr (typeRef (undefined :: a)) (getAllocArg s) + +-- XXX What's the type of free? +-- | Free heap memory. +free :: Value (Ptr a) -> CodeGenFunction r (Value ()) +free (Value a) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> FFI.buildFree bldPtr a + +-- | Load a value from memory. +load :: Value (Ptr a) -- ^ Address to load from. + -> CodeGenFunction r (Value a) +load (Value p) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withEmptyCString $ FFI.buildLoad bldPtr p + +-- | Store a value in memory +store :: Value a -- ^ Value to store. + -> Value (Ptr a) -- ^ Address to store to. + -> CodeGenFunction r (Value ()) +store (Value v) (Value p) = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + FFI.buildStore bldPtr v p + +{- +-- XXX type is wrong +-- | Address arithmetic. See LLVM description. +-- (The type isn't as accurate as it should be.) +getElementPtr :: (IsInteger i) => + Value (Ptr a) -> [Value i] -> CodeGenFunction r (Value (Ptr b)) +getElementPtr (Value ptr) ixs = + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withArrayLen [ v | Value v <- ixs ] $ \ idxLen idxPtr -> + U.withEmptyCString $ + FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen) +-} + +-- |Acceptable arguments to 'getElementPointer'. +class GetElementPtr optr ixs nptr | optr ixs -> nptr {-, ixs nptr -> optr, nptr optr -> ixs-} where + getIxList :: optr -> ixs -> [FFI.ValueRef] + +-- |Acceptable single index to 'getElementPointer'. +class IsIndexArg a where + getArg :: a -> FFI.ValueRef + +instance IsIndexArg (Value Word32) where + getArg (Value v) = v + +instance IsIndexArg (Value Word64) where + getArg (Value v) = v + +instance IsIndexArg (Value Int32) where + getArg (Value v) = v + +instance IsIndexArg (Value Int64) where + getArg (Value v) = v + +instance IsIndexArg (ConstValue Word32) where + getArg = unConst + +instance IsIndexArg (ConstValue Word64) where + getArg = unConst + +instance IsIndexArg (ConstValue Int32) where + getArg = unConst + +instance IsIndexArg (ConstValue Int64) where + getArg = unConst + +instance IsIndexArg Word32 where + getArg = unConst . constOf + +instance IsIndexArg Word64 where + getArg = unConst . constOf + +instance IsIndexArg Int32 where + getArg = unConst . constOf + +instance IsIndexArg Int64 where + getArg = unConst . constOf + +unConst :: ConstValue a -> FFI.ValueRef +unConst (ConstValue v) = v + +-- End of indexing +instance GetElementPtr a () a where + getIxList _ () = [] + +-- Index in Array +instance (GetElementPtr o i n, IsIndexArg a) => GetElementPtr (Array k o) (a, i) n where + getIxList _ (v, i) = getArg v : getIxList (undefined :: o) i + +-- Index in Vector +instance (GetElementPtr o i n, IsIndexArg a) => GetElementPtr (Vector k o) (a, i) n where + getIxList _ (v, i) = getArg v : getIxList (undefined :: o) i + +-- Index in Struct and PackedStruct. +-- The index has to be a type level integer to statically determine the record field type +instance (GetElementPtr o i n, GetField fs a o, Nat a) => GetElementPtr (Struct fs) (a, i) n where + getIxList _ (v, i) = unConst (constOf (toNum v :: Word32)) : getIxList (undefined :: o) i +instance (GetElementPtr o i n, GetField fs a o, Nat a) => GetElementPtr (PackedStruct fs) (a, i) n where + getIxList _ (v, i) = unConst (constOf (toNum v :: Word32)) : getIxList (undefined :: o) i + +class GetField as i a | as i -> a +instance GetField (a, as) D0 a +instance (GetField as i b, Succ i i') => GetField (a, as) i' b + +-- | Address arithmetic. See LLVM description. +-- The index is a nested tuple of the form @(i1,(i2,( ... ())))@. +-- (This is without a doubt the most confusing LLVM instruction, but the types help.) +getElementPtr :: forall a o i n r . (GetElementPtr o i n, IsIndexArg a) => + Value (Ptr o) -> (a, i) -> CodeGenFunction r (Value (Ptr n)) +getElementPtr (Value ptr) (a, ixs) = + let ixl = getArg a : getIxList (undefined :: o) ixs in + liftM Value $ + withCurrentBuilder $ \ bldPtr -> + U.withArrayLen ixl $ \ idxLen idxPtr -> + U.withEmptyCString $ + FFI.buildGEP bldPtr ptr idxPtr (fromIntegral idxLen) + +-- | Like getElementPtr, but with an initial index that is 0. +-- This is useful since any pointer first need to be indexed off the pointer, and then into +-- its actual value. This first indexing is often with 0. +getElementPtr0 :: (GetElementPtr o i n) => + Value (Ptr o) -> i -> CodeGenFunction r (Value (Ptr n)) +getElementPtr0 p i = getElementPtr p (0::Word32, i) + +-------------------------------------- +{- +instance (IsConst a) => Show (ConstValue a) -- XXX +instance (IsConst a) => Eq (ConstValue a) + +{- +instance (IsConst a) => Eq (ConstValue a) where + ConstValue x == ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOEQ) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntEQ) x y) + ConstValue x /= ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPONE) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntNE) x y) + +instance (IsConst a) => Ord (ConstValue a) where + ConstValue x < ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOLT) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntLT) x y) + ConstValue x <= ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOLE) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntLE) x y) + ConstValue x > ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOGT) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntGT) x y) + ConstValue x >= ConstValue y = + if isFloating x then ConstValue (FFI.constFCmp (fromFPPredicate FPOGE) x y) + else ConstValue (FFI.constICmp (fromIntPredicate IntGE) x y) +-} + +instance (Num a, IsConst a) => Num (ConstValue a) where + ConstValue x + ConstValue y = ConstValue (FFI.constAdd x y) + ConstValue x - ConstValue y = ConstValue (FFI.constSub x y) + ConstValue x * ConstValue y = ConstValue (FFI.constMul x y) + negate (ConstValue x) = ConstValue (FFI.constNeg x) + fromInteger x = constOf (fromInteger x :: a) +-} diff --git a/LLVM/Core/Type.hs b/LLVM/Core/Type.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core/Type.hs @@ -0,0 +1,499 @@ +{-# LANGUAGE ScopedTypeVariables, EmptyDataDecls, FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, IncoherentInstances, TypeOperators, DeriveDataTypeable #-} +-- |The LLVM type system is captured with a number of Haskell type classes. +-- In general, an LLVM type @T@ is represented as @Value T@, where @T@ is some Haskell type. +-- The various types @T@ are classified by various type classes, e.g., 'IsFirstClass' for +-- those types that are LLVM first class types (passable as arguments etc). +-- All valid LLVM types belong to the 'IsType' class. +module LLVM.Core.Type( + -- * Type classifier + IsType(..), + -- ** Special type classifiers + IsArithmetic, + IsInteger, + IsIntegerOrPointer, + IsFloating, + IsPrimitive, + IsFirstClass, + IsSized, + IsFunction, + UnknownSize, -- needed for arrays of structs + -- ** Others + IsPowerOf2, + NumberOfElements, + -- ** Structs + (:&), (&), + -- ** Functions of tuples + (:+->), ($+), + IsTuple(tupleDesc), + withTuple, + -- ** Type tests + TypeDesc(..), + isFloating, + isSigned, + typeRef, + typeName, + VarArgs, CastVarArgs, + ) where +import Data.Typeable +import Data.List(intercalate) +import Data.Int +import Data.Word +import Data.TypeLevel hiding (Bool, Eq) +import Foreign.StablePtr (StablePtr, ) +import LLVM.Core.Util(functionType, structType) +import LLVM.Core.Data +import qualified LLVM.FFI.Core as FFI + +-- Usage: vector precondition +class (Pos n) => IsPowerOf2 n +instance (LogBase D2 n l, ExpBase D2 l n) => IsPowerOf2 n + +-- TODO: +-- Move IntN, WordN to a special module that implements those types +-- properly in Haskell. +-- Also more Array and Vector to a Haskell module to implement them. +-- Add Label? +-- Add structures (using tuples, maybe nested). + +-- |The 'IsType' class classifies all types that have an LLVM representation. +class IsType a where + typeDesc :: a -> TypeDesc + +typeRef :: (IsType a) => a -> FFI.TypeRef -- ^The argument is never evaluated +typeRef = code . typeDesc + where code TDFloat = FFI.floatType + code TDDouble = FFI.doubleType + code TDFP128 = FFI.fp128Type + code TDVoid = FFI.voidType + code (TDInt _ n) = FFI.integerType (fromInteger n) + code (TDArray n a) = FFI.arrayType (code a) (fromInteger n) + code (TDVector n a) = FFI.vectorType (code a) (fromInteger n) + code (TDPtr a) = FFI.pointerType (code a) 0 + code (TDFunction va as b) = functionType va (code b) (map code as) + code TDLabel = FFI.labelType + code (TDStruct ts packed) = structType (map code ts) packed + +typeName :: (IsType a) => a -> String +typeName = code . typeDesc + where code TDFloat = "f32" + code TDDouble = "f64" + code TDFP128 = "f128" + code TDVoid = "void" + code (TDInt _ n) = "i" ++ show n + code (TDArray n a) = "[" ++ show n ++ " x " ++ code a ++ "]" + code (TDVector n a) = "<" ++ show n ++ " x " ++ code a ++ ">" + code (TDPtr a) = code a ++ "*" + code (TDFunction _ as b) = code b ++ "(" ++ intercalate "," (map code as) ++ ")" + code TDLabel = "label" + code (TDStruct as packed) = (if packed then "<{" else "{") ++ + intercalate "," (map code as) ++ + (if packed then "}>" else "}") + +-- |Type descriptor, used to convey type information through the LLVM API. +data TypeDesc = TDFloat | TDDouble | TDFP128 | TDVoid | TDInt Bool Integer + | TDArray Integer TypeDesc | TDVector Integer TypeDesc + | TDPtr TypeDesc | TDFunction Bool [TypeDesc] TypeDesc | TDLabel + | TDStruct [TypeDesc] Bool + deriving (Eq, Ord, Show, Typeable) + +-- XXX isFloating and typeName could be extracted from typeRef +-- Usage: +-- superclass of IsConst +-- add, sub, mul, neg context +-- used to get type name to call intrinsic +-- |Arithmetic types, i.e., integral and floating types. +class IsFirstClass a => IsArithmetic a + +-- Usage: +-- constI, allOnes +-- many instructions. XXX some need vector +-- used to find signedness in Arithmetic +-- |Integral types. +class (IsArithmetic a, IsIntegerOrPointer a) => IsInteger a + +-- Usage: +-- icmp +-- |Integral or pointer type. +class IsIntegerOrPointer a + +isSigned :: (IsInteger a) => a -> Bool +isSigned = is . typeDesc + where is (TDInt s _) = s + is (TDVector _ a) = is a + is _ = error "isSigned got impossible input" + +-- Usage: +-- constF +-- many instructions +-- |Floating types. +class IsArithmetic a => IsFloating a + +isFloating :: (IsArithmetic a) => a -> Bool +isFloating = is . typeDesc + where is TDFloat = True + is TDDouble = True + is TDFP128 = True + is (TDVector _ a) = is a + is _ = False + +-- Usage: +-- Precondition for Vector +-- |Primitive types. +class (NumberOfElements D1 a) => IsPrimitive a + +-- |Number of elements for instructions that handle both primitive and vector types +class (IsType a) => NumberOfElements n a | a -> n + + +-- Usage: +-- Precondition for function args and result. +-- Used by some instructions, like ret and phi. +-- XXX IsSized as precondition? +-- |First class types, i.e., the types that can be passed as arguments, etc. +class IsType a => IsFirstClass a + +-- Usage: +-- Context for Array being a type +-- thus, allocation instructions +-- |Types with a fixed size. +class (IsType a, Pos s) => IsSized a s | a -> s + +data FunctionType = FunctionType Bool [TypeDesc] TypeDesc + +mapFuncTypeArgs :: ([TypeDesc] -> [TypeDesc]) -> FunctionType -> FunctionType +mapFuncTypeArgs f ~(FunctionType vararg args result) = + (FunctionType vararg (f args) result) + +-- |Function type. +class (IsType a) => IsFunction a where + funcTypeRec :: a -> FunctionType + +funcType :: IsFunction a => a -> TypeDesc +funcType f = + case funcTypeRec f of + FunctionType vararg args result -> + TDFunction vararg args result + +-- Only make instances for types that make sense in Haskell +-- (i.e., some floating types are excluded). + +-- Floating point types. +instance IsType Float where typeDesc _ = TDFloat +instance IsType Double where typeDesc _ = TDDouble +instance IsType FP128 where typeDesc _ = TDFP128 + +-- Void type +instance IsType () where typeDesc _ = TDVoid + +-- Label type +instance IsType Label where typeDesc _ = TDLabel + +-- Variable size integer types +instance (Pos n) => IsType (IntN n) + where typeDesc _ = TDInt True (toNum (undefined :: n)) + +instance (Pos n) => IsType (WordN n) + where typeDesc _ = TDInt False (toNum (undefined :: n)) + +-- Fixed size integer types. +instance IsType Bool where typeDesc _ = TDInt False 1 +instance IsType Word8 where typeDesc _ = TDInt False 8 +instance IsType Word16 where typeDesc _ = TDInt False 16 +instance IsType Word32 where typeDesc _ = TDInt False 32 +instance IsType Word64 where typeDesc _ = TDInt False 64 +instance IsType Int8 where typeDesc _ = TDInt True 8 +instance IsType Int16 where typeDesc _ = TDInt True 16 +instance IsType Int32 where typeDesc _ = TDInt True 32 +instance IsType Int64 where typeDesc _ = TDInt True 64 + +-- Sequence types +instance (Nat n, IsSized a s) => IsType (Array n a) + where typeDesc _ = TDArray (toNum (undefined :: n)) + (typeDesc (undefined :: a)) +instance (IsPowerOf2 n, IsPrimitive a) => IsType (Vector n a) + where typeDesc _ = TDVector (toNum (undefined :: n)) + (typeDesc (undefined :: a)) + +-- Pointer type. +instance (IsType a) => IsType (Ptr a) where + typeDesc _ = TDPtr (typeDesc (undefined :: a)) + +instance IsType (StablePtr a) where + typeDesc _ = TDPtr (typeDesc (undefined :: Int8)) +{- + typeDesc _ = TDPtr TDVoid + +List: Type.cpp:1311: static llvm::PointerType* llvm::PointerType::get(const llvm::Type*, unsigned int): Assertion `ValueType != Type::VoidTy && "Pointer to void is not valid, use sbyte* instead!"' failed. +-} + + +-- Functions. +instance (IsFirstClass a, IsFunction b) => IsType (a->b) where + typeDesc = funcType + +-- Function base type, always IO. +instance (IsFirstClass a) => IsType (IO a) where + typeDesc = funcType + +-- Struct types, basically a list of component types. +instance (StructFields a) => IsType (Struct a) where + typeDesc ~(Struct a) = TDStruct (fieldTypes a) False + +instance (StructFields a) => IsType (PackedStruct a) where + typeDesc ~(PackedStruct a) = TDStruct (fieldTypes a) True + +-- Use a nested tuples for struct fields. +class StructFields as where + fieldTypes :: as -> [TypeDesc] + +instance (IsSized a sa, StructFields as) => StructFields (a :& as) where + fieldTypes ~(a, as) = typeDesc a : fieldTypes as +instance StructFields () where + fieldTypes _ = [] + +-- An alias for pairs to make structs look nicer +infixr :& +type (:&) a as = (a, as) +infixr & +(&) :: a -> as -> a :& as +a & as = (a, as) + +--- Instances to classify types +instance IsArithmetic Float +instance IsArithmetic Double +instance IsArithmetic FP128 +instance (Pos n) => IsArithmetic (IntN n) +instance (Pos n) => IsArithmetic (WordN n) +instance IsArithmetic Bool +instance IsArithmetic Int8 +instance IsArithmetic Int16 +instance IsArithmetic Int32 +instance IsArithmetic Int64 +instance IsArithmetic Word8 +instance IsArithmetic Word16 +instance IsArithmetic Word32 +instance IsArithmetic Word64 +instance (IsPowerOf2 n, IsPrimitive a, IsArithmetic a) => IsArithmetic (Vector n a) + +instance IsFloating Float +instance IsFloating Double +instance IsFloating FP128 +instance (IsPowerOf2 n, IsPrimitive a, IsFloating a) => IsFloating (Vector n a) + +instance (Pos n) => IsInteger (IntN n) +instance (Pos n) => IsInteger (WordN n) +instance IsInteger Bool +instance IsInteger Int8 +instance IsInteger Int16 +instance IsInteger Int32 +instance IsInteger Int64 +instance IsInteger Word8 +instance IsInteger Word16 +instance IsInteger Word32 +instance IsInteger Word64 +instance (IsPowerOf2 n, IsPrimitive a, IsInteger a) => IsInteger (Vector n a) + +instance (Pos n) => IsIntegerOrPointer (IntN n) +instance (Pos n) => IsIntegerOrPointer (WordN n) +instance IsIntegerOrPointer Bool +instance IsIntegerOrPointer Int8 +instance IsIntegerOrPointer Int16 +instance IsIntegerOrPointer Int32 +instance IsIntegerOrPointer Int64 +instance IsIntegerOrPointer Word8 +instance IsIntegerOrPointer Word16 +instance IsIntegerOrPointer Word32 +instance IsIntegerOrPointer Word64 +instance (IsPowerOf2 n, IsPrimitive a, IsInteger a) => IsIntegerOrPointer (Vector n a) +instance (IsType a) => IsIntegerOrPointer (Ptr a) + +instance IsFirstClass Float +instance IsFirstClass Double +instance IsFirstClass FP128 +instance (Pos n) => IsFirstClass (IntN n) +instance (Pos n) => IsFirstClass (WordN n) +instance IsFirstClass Bool +instance IsFirstClass Int8 +instance IsFirstClass Int16 +instance IsFirstClass Int32 +instance IsFirstClass Int64 +instance IsFirstClass Word8 +instance IsFirstClass Word16 +instance IsFirstClass Word32 +instance IsFirstClass Word64 +instance (IsPowerOf2 n, IsPrimitive a) => IsFirstClass (Vector n a) +instance (Nat n, IsType a, IsSized a s) => IsFirstClass (Array n a) +instance (IsType a) => IsFirstClass (Ptr a) +instance IsFirstClass (StablePtr a) +instance IsFirstClass Label +instance IsFirstClass () -- XXX This isn't right, but () can be returned +instance (StructFields as) => IsFirstClass (Struct as) + +instance IsSized Float D32 +instance IsSized Double D64 +instance IsSized FP128 D128 +instance (Pos n) => IsSized (IntN n) n +instance (Pos n) => IsSized (WordN n) n +instance IsSized Bool D1 +instance IsSized Int8 D8 +instance IsSized Int16 D16 +instance IsSized Int32 D32 +instance IsSized Int64 D64 +instance IsSized Word8 D8 +instance IsSized Word16 D16 +instance IsSized Word32 D32 +instance IsSized Word64 D64 +instance (Nat n, IsSized a s, Mul n s ns, Pos ns) => IsSized (Array n a) ns +instance (IsPowerOf2 n, IsPrimitive a, IsSized a s, Mul n s ns, Pos ns) => IsSized (Vector n a) ns +instance (IsType a) => IsSized (Ptr a) PtrSize +instance IsSized (StablePtr a) PtrSize +-- instance IsSized Label PtrSize -- labels are not quite first classed +-- We cannot compute the sizes statically :( +instance (StructFields as) => IsSized (Struct as) UnknownSize +instance (StructFields as) => IsSized (PackedStruct as) UnknownSize + +type UnknownSize = D99 -- XXX this is wrong! +type PtrSize = D32 -- XXX this is wrong! + +instance IsPrimitive Float +instance IsPrimitive Double +instance IsPrimitive FP128 +instance (Pos n) => IsPrimitive (IntN n) +instance (Pos n) => IsPrimitive (WordN n) +instance IsPrimitive Bool +instance IsPrimitive Int8 +instance IsPrimitive Int16 +instance IsPrimitive Int32 +instance IsPrimitive Int64 +instance IsPrimitive Word8 +instance IsPrimitive Word16 +instance IsPrimitive Word32 +instance IsPrimitive Word64 +instance IsPrimitive Label +instance IsPrimitive () + + +instance NumberOfElements D1 Float +instance NumberOfElements D1 Double +instance NumberOfElements D1 FP128 +instance (Pos n) => NumberOfElements D1 (IntN n) +instance (Pos n) => NumberOfElements D1 (WordN n) +instance NumberOfElements D1 Bool +instance NumberOfElements D1 Int8 +instance NumberOfElements D1 Int16 +instance NumberOfElements D1 Int32 +instance NumberOfElements D1 Int64 +instance NumberOfElements D1 Word8 +instance NumberOfElements D1 Word16 +instance NumberOfElements D1 Word32 +instance NumberOfElements D1 Word64 +instance NumberOfElements D1 Label +instance NumberOfElements D1 () + +instance (IsPowerOf2 n, IsPrimitive a) => + NumberOfElements n (Vector n a) + + +-- Functions. +instance (IsFirstClass a, IsFunction b) => IsFunction (a->b) where + funcTypeRec _ = + mapFuncTypeArgs (typeDesc (undefined :: a) :) $ + funcTypeRec (undefined :: b) +instance (IsFirstClass a) => IsFunction (IO a) where + funcTypeRec _ = FunctionType False [] (typeDesc (undefined :: a)) +instance (IsFirstClass a) => IsFunction (VarArgs a) where + funcTypeRec _ = FunctionType True [] (typeDesc (undefined :: a)) + + +{- | +TupleFunction is used for distinction of tuple and atomic arguments. +The a function of type @a -> b :+-> c -> d@ +has atomic arguments of type @a@ and @c@ +and an argument of a type @b@ that can be a tuple. +If @a = (Word8,Int16)@ then the corresponding LLVM value is of type @Value (Word8,Int16)@. +However, I do not know of a LLVM function that accepts values of this type. +If @b = (Word8,Int16)@ then the corresponding LLVM value is of type @(Value Word8, Value Int16)@. +-} +newtype (:+->) a b = TupleFunction (a -> b) + +infixr 0 :+-> + +infixl 9 $+ + +($+) :: (a :+-> b) -> (a -> b) +($+) (TupleFunction f) = f + +withTuple :: (a -> b) -> (a :+-> b) +withTuple = TupleFunction + + +class IsTuple a where + tupleDesc :: a -> [TypeDesc] + +atomDesc :: IsType a => a -> [TypeDesc] +atomDesc x = [typeDesc x] + +instance IsTuple () where + tupleDesc _ = [] + +instance (IsTuple a, IsTuple b) => + IsTuple (a,b) where + tupleDesc ~(a,b) = + tupleDesc a ++ tupleDesc b + +instance (IsTuple a, IsTuple b, IsTuple c) => + IsTuple (a,b,c) where + tupleDesc ~(a,b,c) = + tupleDesc a ++ tupleDesc b ++ tupleDesc c + +instance IsTuple (Float) where tupleDesc = atomDesc +instance IsTuple (Double) where tupleDesc = atomDesc +instance IsTuple (FP128) where tupleDesc = atomDesc +instance (Pos n) => + IsTuple ((IntN n)) where tupleDesc = atomDesc +instance (Pos n) => + IsTuple ((WordN n)) where tupleDesc = atomDesc +instance IsTuple (Bool) where tupleDesc = atomDesc +instance IsTuple (Int8) where tupleDesc = atomDesc +instance IsTuple (Int16) where tupleDesc = atomDesc +instance IsTuple (Int32) where tupleDesc = atomDesc +instance IsTuple (Int64) where tupleDesc = atomDesc +instance IsTuple (Word8) where tupleDesc = atomDesc +instance IsTuple (Word16) where tupleDesc = atomDesc +instance IsTuple (Word32) where tupleDesc = atomDesc +instance IsTuple (Word64) where tupleDesc = atomDesc +instance (IsPowerOf2 n, IsPrimitive a) => + IsTuple ((Vector n a)) where tupleDesc = atomDesc +instance (IsType a) => + IsTuple ((Ptr a)) where tupleDesc = atomDesc +instance IsTuple ((StablePtr a)) where tupleDesc = atomDesc + + +instance (IsTuple a, IsFunction b) => IsType (a:+->b) where + typeDesc = funcType + +instance (IsTuple a, IsFunction b) => IsFunction (a:+->b) where + funcTypeRec _ = + mapFuncTypeArgs (tupleDesc (undefined :: a) ++ ) $ + funcTypeRec (undefined :: b) + + + +-- |The 'VarArgs' type is a placeholder for the real 'IO' type that +-- can be obtained with 'castVarArgs'. +data VarArgs a + deriving (Typeable) +instance IsType (VarArgs a) where + typeDesc _ = error "typeDesc: Dummy type VarArgs used incorrectly" + +-- |Define what vararg types are permissible. +class CastVarArgs a b +instance (CastVarArgs b c) => CastVarArgs (a -> b) (a -> c) +instance CastVarArgs (VarArgs a) (IO a) +instance (IsFirstClass a, CastVarArgs (VarArgs b) c) => CastVarArgs (VarArgs b) (a -> c) + + + + +-- XXX Structures not implemented. Tuples is probably an easy way. + diff --git a/LLVM/Core/Util.hs b/LLVM/Core/Util.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core/Util.hs @@ -0,0 +1,412 @@ +{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, DeriveDataTypeable #-} +module LLVM.Core.Util( + -- * Module handling + Module(..), withModule, createModule, destroyModule, writeBitcodeToFile, readBitcodeFromFile, + getModuleValues, valueHasType, + -- * Module provider handling + ModuleProvider(..), withModuleProvider, createModuleProviderForExistingModule, + -- * Pass manager handling + PassManager(..), withPassManager, createPassManager, createFunctionPassManager, + runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager, + -- * Instruction builder + Builder(..), withBuilder, createBuilder, positionAtEnd, getInsertBlock, + -- * Basic blocks + BasicBlock, + appendBasicBlock, + -- * Functions + Function, + addFunction, getParam, + -- * Structs + structType, + -- * Globals + addGlobal, + constString, constStringNul, constVector, constArray, constStruct, + -- * Instructions + makeCall, makeInvoke, + -- * Misc + CString, withArrayLen, + withEmptyCString, + functionType, buildEmptyPhi, addPhiIns, + showTypeOf, getValueNameU, + -- * Transformation passes + addCFGSimplificationPass, addConstantPropagationPass, addDemoteMemoryToRegisterPass, + addGVNPass, addInstructionCombiningPass, addPromoteMemoryToRegisterPass, addReassociatePass, + addTargetData + ) where +import Data.Typeable +import Data.List(intercalate) +import Control.Monad(liftM, when) +import Foreign.C.String (withCString, withCStringLen, CString, peekCString) +import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, newForeignPtr_, withForeignPtr) +import Foreign.Ptr (nullPtr) +import Foreign.Marshal.Array (withArrayLen, withArray, allocaArray, peekArray) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Storable (Storable(..)) +import Foreign.Marshal.Utils (fromBool) +import System.IO.Unsafe (unsafePerformIO) + +import qualified LLVM.FFI.Core as FFI +import qualified LLVM.FFI.Target as FFI +import qualified LLVM.FFI.BitWriter as FFI +import qualified LLVM.FFI.BitReader as FFI +import qualified LLVM.FFI.Transforms.Scalar as FFI + +type Type = FFI.TypeRef + +-- unsafePerformIO just to wrap the non-effecting withArrayLen call +functionType :: Bool -> Type -> [Type] -> Type +functionType varargs retType paramTypes = unsafePerformIO $ + withArrayLen paramTypes $ \ len ptr -> + return $ FFI.functionType retType ptr (fromIntegral len) + (fromBool varargs) + +-- unsafePerformIO just to wrap the non-effecting withArrayLen call +structType :: [Type] -> Bool -> Type +structType types packed = unsafePerformIO $ + withArrayLen types $ \ len ptr -> + return $ FFI.structType ptr (fromIntegral len) (if packed then 1 else 0) + +-------------------------------------- +-- Handle modules + +-- Don't use a finalizer for the module, but instead provide an +-- explicit destructor. This is because handing a module to +-- a module provider changes ownership of the module to the provider, +-- and we don't want to free it by mistake. + +-- | Type of top level modules. +newtype Module = Module { + fromModule :: FFI.ModuleRef + } + deriving (Show, Typeable) + +withModule :: Module -> (FFI.ModuleRef -> IO a) -> IO a +withModule modul f = f (fromModule modul) + +createModule :: String -> IO Module +createModule name = + withCString name $ \ namePtr -> do + liftM Module $ FFI.moduleCreateWithName namePtr + +-- | Free all storage related to a module. *Note*, this is a dangerous call, since referring +-- to the module after this call is an error. The reason for the explicit call to free +-- the module instead of an automatic lifetime management is that modules have a +-- somewhat complicated ownership. Handing a module to a module provider changes +-- the ownership of the module, and the module provider will free the module when necessary. +destroyModule :: Module -> IO () +destroyModule = FFI.disposeModule . fromModule + +-- |Write a module to a file. +writeBitcodeToFile :: String -> Module -> IO () +writeBitcodeToFile name mdl = + withCString name $ \ namePtr -> + withModule mdl $ \ mdlPtr -> do + rc <- FFI.writeBitcodeToFile mdlPtr namePtr + when (rc /= 0) $ + ioError $ userError $ "writeBitcodeToFile: return code " ++ show rc + return () + +-- |Read a module from a file. +readBitcodeFromFile :: String -> IO Module +readBitcodeFromFile name = + withCString name $ \ namePtr -> + alloca $ \ bufPtr -> + alloca $ \ modPtr -> + alloca $ \ errStr -> do + rrc <- FFI.createMemoryBufferWithContentsOfFile namePtr bufPtr errStr + if rrc /= 0 then do + msg <- peek errStr >>= peekCString + ioError $ userError $ "readBitcodeFromFile: read return code " ++ show rrc ++ ", " ++ msg + else do + buf <- peek bufPtr + prc <- FFI.parseBitcode buf modPtr errStr + if prc /= 0 then do + msg <- peek errStr >>= peekCString + ioError $ userError $ "readBitcodeFromFile: parse return code " ++ show prc ++ ", " ++ msg + else do + ptr <- peek modPtr + return $ Module ptr +{- + liftM Module $ newForeignPtr FFI.ptrDisposeModule ptr +-} + +getModuleValues :: Module -> IO [(String, Value)] +getModuleValues mdl = do + withModule mdl $ \ mdlPtr -> do + ffst <- FFI.getFirstFunction mdlPtr + let floop p = if p == nullPtr then return [] else do + n <- FFI.getNextFunction p + ps <- floop n + sptr <- FFI.getValueName p + s <- peekCString sptr + return ((s, p) : ps) + fs <- floop ffst + gfst <- FFI.getFirstGlobal mdlPtr + let gloop p = if p == nullPtr then return [] else do + n <- FFI.getNextGlobal p + ps <- gloop n + sptr <- FFI.getValueName p + s <- peekCString sptr + return ((s, p) : ps) + gs <- gloop gfst + return (fs ++ gs) + +-- This is safe because we just ask for the type of a value. +valueHasType :: Value -> Type -> Bool +valueHasType v t = unsafePerformIO $ do + vt <- FFI.typeOf v + return $ vt == t -- LLVM uses hash consing for types, so pointer equality works. + +showTypeOf :: Value -> IO String +showTypeOf v = FFI.typeOf v >>= showType' + +showType' :: Type -> IO String +showType' p = do + pk <- FFI.getTypeKind p + case pk of + FFI.VoidTypeKind -> return "()" + FFI.FloatTypeKind -> return "Float" + FFI.DoubleTypeKind -> return "Double" + FFI.X86_FP80TypeKind -> return "X86_FP80" + FFI.FP128TypeKind -> return "FP128" + FFI.PPC_FP128TypeKind -> return "PPC_FP128" + FFI.LabelTypeKind -> return "Label" + FFI.IntegerTypeKind -> do w <- FFI.getIntTypeWidth p; return $ "(IntN " ++ show w ++ ")" + FFI.FunctionTypeKind -> do + r <- FFI.getReturnType p + c <- FFI.countParamTypes p + let n = fromIntegral c + as <- allocaArray n $ \ args -> do + FFI.getParamTypes p args + peekArray n args + ts <- mapM showType' (as ++ [r]) + return $ "(" ++ intercalate " -> " ts ++ ")" + FFI.StructTypeKind -> return "(Struct ...)" + FFI.ArrayTypeKind -> do n <- FFI.getArrayLength p; t <- FFI.getElementType p >>= showType'; return $ "(Array " ++ show n ++ " " ++ t ++ ")" + FFI.PointerTypeKind -> do t <- FFI.getElementType p >>= showType'; return $ "(Ptr " ++ t ++ ")" + FFI.OpaqueTypeKind -> return "Opaque" + FFI.VectorTypeKind -> do n <- FFI.getVectorSize p; t <- FFI.getElementType p >>= showType'; return $ "(Vector " ++ show n ++ " " ++ t ++ ")" + +-------------------------------------- +-- Handle module providers + +-- | A module provider is used by the code generator to get access to a module. +newtype ModuleProvider = ModuleProvider { + fromModuleProvider :: ForeignPtr FFI.ModuleProvider + } + deriving (Show, Typeable) + +withModuleProvider :: ModuleProvider -> (FFI.ModuleProviderRef -> IO a) + -> IO a +withModuleProvider = withForeignPtr . fromModuleProvider + +-- | Turn a module into a module provider. +createModuleProviderForExistingModule :: Module -> IO ModuleProvider +createModuleProviderForExistingModule modul = + withModule modul $ \modulPtr -> do + ptr <- FFI.createModuleProviderForExistingModule modulPtr + -- MPs given to the EE get taken over, so we should not GC them. + liftM ModuleProvider $ newForeignPtr_ {-FFI.ptrDisposeModuleProvider-} ptr + + +-------------------------------------- +-- Handle instruction builders + +newtype Builder = Builder { + fromBuilder :: ForeignPtr FFI.Builder + } + deriving (Show, Typeable) + +withBuilder :: Builder -> (FFI.BuilderRef -> IO a) -> IO a +withBuilder = withForeignPtr . fromBuilder + +createBuilder :: IO Builder +createBuilder = do + ptr <- FFI.createBuilder + liftM Builder $ newForeignPtr FFI.ptrDisposeBuilder ptr + +positionAtEnd :: Builder -> FFI.BasicBlockRef -> IO () +positionAtEnd bld bblk = + withBuilder bld $ \ bldPtr -> + FFI.positionAtEnd bldPtr bblk + +getInsertBlock :: Builder -> IO FFI.BasicBlockRef +getInsertBlock bld = + withBuilder bld $ \ bldPtr -> + FFI.getInsertBlock bldPtr + +-------------------------------------- + +type BasicBlock = FFI.BasicBlockRef + +appendBasicBlock :: Function -> String -> IO BasicBlock +appendBasicBlock func name = + withCString name $ \ namePtr -> + FFI.appendBasicBlock func namePtr + +-------------------------------------- + +type Function = FFI.ValueRef + +addFunction :: Module -> FFI.Linkage -> String -> Type -> IO Function +addFunction modul linkage name typ = + withModule modul $ \ modulPtr -> + withCString name $ \ namePtr -> do + f <- FFI.addFunction modulPtr namePtr typ + FFI.setLinkage f (FFI.fromLinkage linkage) + return f + +getParam :: Function -> Int -> Value +getParam f = FFI.getParam f . fromIntegral + +-------------------------------------- + +addGlobal :: Module -> FFI.Linkage -> String -> Type -> IO Value +addGlobal modul linkage name typ = + withModule modul $ \ modulPtr -> + withCString name $ \ namePtr -> do + v <- FFI.addGlobal modulPtr typ namePtr + FFI.setLinkage v (FFI.fromLinkage linkage) + return v + +-- unsafePerformIO is safe because it's only used for the withCStringLen conversion +constStringInternal :: Bool -> String -> Value +constStringInternal nulTerm s = unsafePerformIO $ + withCStringLen s $ \(sPtr, sLen) -> + return $ FFI.constString sPtr (fromIntegral sLen) (fromBool (not nulTerm)) + +constString :: String -> Value +constString = constStringInternal False + +constStringNul :: String -> Value +constStringNul = constStringInternal True + +-------------------------------------- + +type Value = FFI.ValueRef + +makeCall :: Function -> FFI.BuilderRef -> [Value] -> IO Value +makeCall func bldPtr args = do +{- + print "makeCall" + FFI.dumpValue func + mapM_ FFI.dumpValue args + print "----------------------" +-} + withArrayLen args $ \ argLen argPtr -> + withEmptyCString $ + FFI.buildCall bldPtr func argPtr + (fromIntegral argLen) + +makeInvoke :: BasicBlock -> BasicBlock -> Function -> FFI.BuilderRef -> + [Value] -> IO Value +makeInvoke norm expt func bldPtr args = + withArrayLen args $ \ argLen argPtr -> + withEmptyCString $ + FFI.buildInvoke bldPtr func argPtr (fromIntegral argLen) norm expt + +-------------------------------------- + +buildEmptyPhi :: FFI.BuilderRef -> Type -> IO Value +buildEmptyPhi bldPtr typ = do + withEmptyCString $ FFI.buildPhi bldPtr typ + +withEmptyCString :: (CString -> IO a) -> IO a +withEmptyCString = withCString "" + +addPhiIns :: Value -> [(Value, BasicBlock)] -> IO () +addPhiIns inst incoming = do + let (vals, bblks) = unzip incoming + withArrayLen vals $ \ count valPtr -> + withArray bblks $ \ bblkPtr -> + FFI.addIncoming inst valPtr bblkPtr (fromIntegral count) + +-------------------------------------- + +-- | Manage compile passes. +newtype PassManager = PassManager { + fromPassManager :: ForeignPtr FFI.PassManager + } + deriving (Show, Typeable) + +withPassManager :: PassManager -> (FFI.PassManagerRef -> IO a) + -> IO a +withPassManager = withForeignPtr . fromPassManager + +-- | Create a pass manager. +createPassManager :: IO PassManager +createPassManager = do + ptr <- FFI.createPassManager + liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr + +-- | Create a pass manager for a module. +createFunctionPassManager :: ModuleProvider -> IO PassManager +createFunctionPassManager modul = + withModuleProvider modul $ \modulPtr -> do + ptr <- FFI.createFunctionPassManager modulPtr + liftM PassManager $ newForeignPtr FFI.ptrDisposePassManager ptr + +-- | Add a control flow graph simplification pass to the manager. +addCFGSimplificationPass :: PassManager -> IO () +addCFGSimplificationPass pm = withPassManager pm FFI.addCFGSimplificationPass + +-- | Add a constant propagation pass to the manager. +addConstantPropagationPass :: PassManager -> IO () +addConstantPropagationPass pm = withPassManager pm FFI.addConstantPropagationPass + +addDemoteMemoryToRegisterPass :: PassManager -> IO () +addDemoteMemoryToRegisterPass pm = withPassManager pm FFI.addDemoteMemoryToRegisterPass + +-- | Add a global value numbering pass to the manager. +addGVNPass :: PassManager -> IO () +addGVNPass pm = withPassManager pm FFI.addGVNPass + +addInstructionCombiningPass :: PassManager -> IO () +addInstructionCombiningPass pm = withPassManager pm FFI.addInstructionCombiningPass + +addPromoteMemoryToRegisterPass :: PassManager -> IO () +addPromoteMemoryToRegisterPass pm = withPassManager pm FFI.addPromoteMemoryToRegisterPass + +addReassociatePass :: PassManager -> IO () +addReassociatePass pm = withPassManager pm FFI.addReassociatePass + +addTargetData :: FFI.TargetDataRef -> PassManager -> IO () +addTargetData td pm = withPassManager pm $ FFI.addTargetData td + +runFunctionPassManager :: PassManager -> Function -> IO Int +runFunctionPassManager pm fcn = liftM fromIntegral $ withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn + +initializeFunctionPassManager :: PassManager -> IO Int +initializeFunctionPassManager pm = liftM fromIntegral $ withPassManager pm FFI.initializeFunctionPassManager + +finalizeFunctionPassManager :: PassManager -> IO Int +finalizeFunctionPassManager pm = liftM fromIntegral $ withPassManager pm FFI.finalizeFunctionPassManager + +-------------------------------------- + +-- The unsafePerformIO is just for the non-effecting withArrayLen +constVector :: Int -> [Value] -> Value +constVector n xs = unsafePerformIO $ do + let xs' = take n (cycle xs) + withArrayLen xs' $ \ len ptr -> + return $ FFI.constVector ptr (fromIntegral len) + +-- The unsafePerformIO is just for the non-effecting withArrayLen +constArray :: Type -> Int -> [Value] -> Value +constArray t n xs = unsafePerformIO $ do + let xs' = take n (cycle xs) + withArrayLen xs' $ \ len ptr -> + return $ FFI.constArray t ptr (fromIntegral len) + +-- The unsafePerformIO is just for the non-effecting withArrayLen +constStruct :: [Value] -> Bool -> Value +constStruct xs packed = unsafePerformIO $ do + withArrayLen xs $ \ len ptr -> + return $ FFI.constStruct ptr (fromIntegral len) (if packed then 1 else 0) + +-------------------------------------- + +getValueNameU :: Value -> IO String +getValueNameU a = do + cs <- FFI.getValueName a + peekCString cs diff --git a/LLVM/Core/Vector.hs b/LLVM/Core/Vector.hs new file mode 100644 --- /dev/null +++ b/LLVM/Core/Vector.hs @@ -0,0 +1,140 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, ScopedTypeVariables #-} +module LLVM.Core.Vector(MkVector(..), vector, ) where +import Data.Function +import Data.TypeLevel hiding (Eq, (+), (==), (-), (*), succ, pred, div, mod, divMod, logBase) +import LLVM.Core.Type +import LLVM.Core.Data +import LLVM.ExecutionEngine.Target +import Foreign.Ptr(Ptr, castPtr) +import Foreign.Storable(Storable(..)) +import Foreign.Marshal.Array(peekArray, pokeArray) +import System.IO.Unsafe(unsafePerformIO) + +-- XXX Should these really be here? +class (IsPowerOf2 n, IsPrimitive a) => MkVector va n a | va -> n a, n a -> va where + toVector :: va -> Vector n a + fromVector :: Vector n a -> va + +{- +instance (IsPrimitive a) => MkVector (Value a) D1 (Value a) where + toVector a = Vector [a] +-} + +instance (IsPrimitive a) => MkVector (a, a) D2 a where + toVector (a1, a2) = Vector [a1, a2] + fromVector (Vector [a1, a2]) = (a1, a2) + fromVector _ = error "fromVector: impossible" + +instance (IsPrimitive a) => MkVector (a, a, a, a) D4 a where + toVector (a1, a2, a3, a4) = Vector [a1, a2, a3, a4] + fromVector (Vector [a1, a2, a3, a4]) = (a1, a2, a3, a4) + fromVector _ = error "fromVector: impossible" + +instance (IsPrimitive a) => MkVector (a, a, a, a, a, a, a, a) D8 a where + toVector (a1, a2, a3, a4, a5, a6, a7, a8) = Vector [a1, a2, a3, a4, a5, a6, a7, a8] + fromVector (Vector [a1, a2, a3, a4, a5, a6, a7, a8]) = (a1, a2, a3, a4, a5, a6, a7, a8) + fromVector _ = error "fromVector: impossible" + +instance (Storable a, IsPowerOf2 n, IsPrimitive a) => Storable (Vector n a) where + sizeOf a = storeSizeOfType ourTargetData (typeRef a) + alignment a = aBIAlignmentOfType ourTargetData (typeRef a) + peek p = fmap Vector $ peekArray (toNum (undefined :: n)) (castPtr p :: Ptr a) + poke p (Vector vs) = pokeArray (castPtr p :: Ptr a) vs + +-- XXX The JITer target data. This isn't really right. +ourTargetData :: TargetData +ourTargetData = unsafePerformIO getTargetData + +-------------------------------------- + +unVector :: Vector n a -> [a] +unVector (Vector xs) = xs + +-- |Make a constant vector. Replicates or truncates the list to get length /n/. +-- This behaviour is consistent with that of 'LLVM.Core.CodeGen.constVector'. +vector :: forall a n. (Pos n) => [a] -> Vector n a +vector xs = + Vector (take (toNum (undefined :: n)) (cycle xs)) + + +binop :: (a -> b -> c) -> Vector n a -> Vector n b -> Vector n c +binop op xs ys = Vector $ zipWith op (unVector xs) (unVector ys) + +unop :: (a -> b) -> Vector n a -> Vector n b +unop op = Vector . map op . unVector + +instance (Eq a) => Eq (Vector n a) where + (==) = (==) `on` unVector + +instance (Ord a) => Ord (Vector n a) where + compare = compare `on` unVector + +instance (Num a, Pos n) => Num (Vector n a) where + (+) = binop (+) + (-) = binop (-) + (*) = binop (*) + negate = unop negate + abs = unop abs + signum = unop signum + fromInteger = Vector . replicate (toNum (undefined :: n)) . fromInteger + +instance (Enum a, Pos n) => Enum (Vector n a) where + succ = unop succ + pred = unop pred + fromEnum = error "Vector fromEnum" + toEnum = Vector . map toEnum . replicate (toNum (undefined :: n)) + +instance (Real a, Pos n) => Real (Vector n a) where + toRational = error "Vector toRational" + +instance (Integral a, Pos n) => Integral (Vector n a) where + quot = binop quot + rem = binop rem + div = binop div + mod = binop mod + quotRem (Vector xs) (Vector ys) = (Vector qs, Vector rs) where (qs, rs) = unzip $ zipWith quotRem xs ys + divMod (Vector xs) (Vector ys) = (Vector qs, Vector rs) where (qs, rs) = unzip $ zipWith divMod xs ys + toInteger = error "Vector toInteger" + +instance (Fractional a, Pos n) => Fractional (Vector n a) where + (/) = binop (/) + fromRational = Vector . replicate (toNum (undefined :: n)) . fromRational + +instance (RealFrac a, Pos n) => RealFrac (Vector n a) where + properFraction = error "Vector properFraction" + +instance (Floating a, Pos n) => Floating (Vector n a) where + pi = Vector $ replicate (toNum (undefined :: n)) pi + sqrt = unop sqrt + log = unop log + logBase = binop logBase + (**) = binop (**) + exp = unop exp + sin = unop sin + cos = unop cos + tan = unop tan + asin = unop asin + acos = unop acos + atan = unop atan + sinh = unop sinh + cosh = unop cosh + tanh = unop tanh + asinh = unop asinh + acosh = unop acosh + atanh = unop atanh + +instance (RealFloat a, Pos n) => RealFloat (Vector n a) where + floatRadix = floatRadix . head . unVector + floatDigits = floatDigits . head . unVector + floatRange = floatRange . head . unVector + decodeFloat = error "Vector decodeFloat" + encodeFloat = error "Vector encodeFloat" + exponent _ = 0 + scaleFloat 0 x = x + scaleFloat _ _ = error "Vector scaleFloat" + isNaN = error "Vector isNaN" + isInfinite = error "Vector isInfinite" + isDenormalized = error "Vector isDenormalized" + isNegativeZero = error "Vector isNegativeZero" + isIEEE = isIEEE . head . unVector diff --git a/LLVM/ExecutionEngine.hs b/LLVM/ExecutionEngine.hs new file mode 100644 --- /dev/null +++ b/LLVM/ExecutionEngine.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, FunctionalDependencies, TypeOperators #-} + -- |An 'ExecutionEngine' is JIT compiler that is used to generate code for an LLVM module. +module LLVM.ExecutionEngine( + -- * Execution engine + EngineAccess, + runEngineAccess, + addModuleProvider, + addModule, +{- + runStaticConstructors, + runStaticDestructors, +-} + getPointerToFunction, + addFunctionValue, + addGlobalMappings, + getFreePointers, FreePointers, + -- * Translation + Translatable, Generic, GenericTuple, + generateFunction, + -- * Unsafe type conversion + Unsafe, + unsafePurify, + -- * Simplified interface. + simpleFunction, + unsafeGenerateFunction, + -- * Target information + module LLVM.ExecutionEngine.Target + ) where +import System.IO.Unsafe (unsafePerformIO) + +import LLVM.ExecutionEngine.Engine +import LLVM.FFI.Core(ValueRef) +import LLVM.Core.CodeGen(Value(..)) +import LLVM.Core +import LLVM.ExecutionEngine.Target +--import LLVM.Core.Util(runFunctionPassManager, initializeFunctionPassManager, finalizeFunctionPassManager) +import Control.Monad (liftM2, ) + +-- |Class of LLVM function types that can be translated to the corresponding +-- Haskell type. +class Translatable f where + translate :: (ValueRef -> [GenericValue] -> IO GenericValue) -> [GenericValue] -> ValueRef -> f + +instance (Generic a, Translatable b) => Translatable (a -> b) where + translate run args f = \ arg -> translate run (toGeneric arg : args) f + +instance (GenericTuple a, Translatable b) => Translatable (a :+-> b) where + translate run args f = + -- FIXME: avoid duplicate reverse + withTuple $ \ arg -> + translate run (reverse (toGenericTuple arg) ++ args) f + +instance (Generic a) => Translatable (IO a) where + translate run args f = fmap fromGeneric $ run f $ reverse args + +-- |Generate a Haskell function from an LLVM function. +-- +-- Note that the function is compiled for every call (Just-In-Time compilation). +-- If you want to compile the function once and call it a lot of times +-- then you should better use 'getPointerToFunction'. +generateFunction :: (Translatable f) => + Value (Ptr f) -> EngineAccess f +generateFunction (Value f) = do + run <- getRunFunction + return $ translate run [] f + +class Unsafe a b | a -> b where + unsafePurify :: a -> b -- ^Remove the IO from a function return type. This is unsafe in general. + +instance (Unsafe b b') => Unsafe (a->b) (a->b') where + unsafePurify f = unsafePurify . f + +instance Unsafe (IO a) a where + unsafePurify = unsafePerformIO + +-- |Translate a function to Haskell code. This is a simplified interface to +-- the execution engine and module mechanism. +-- It is based on 'generateFunction', so see there for limitations. +simpleFunction :: (Translatable f) => CodeGenModule (Function f) -> IO f +simpleFunction bld = do + m <- newModule + (func, mappings) <- defineModule m (liftM2 (,) bld getGlobalMappings) + prov <- createModuleProviderForExistingModule m + runEngineAccess $ do + addModuleProvider prov + addGlobalMappings mappings + generateFunction func + +{- + m <- newModule + func <- defineModule m bld +-- dumpValue func + prov <- createModuleProviderForExistingModule m + ee <- createExecutionEngine prov + pm <- createFunctionPassManager prov + td <- getExecutionEngineTargetData ee + addTargetData td pm + addInstructionCombiningPass pm + addReassociatePass pm + addGVNPass pm + addCFGSimplificationPass pm + addPromoteMemoryToRegisterPass pm + initializeFunctionPassManager pm +-- print ("rc1", rc1) + runFunctionPassManager pm (unValue func) +-- print ("rc2", rc2) + finalizeFunctionPassManager pm +-- print ("rc3", rc3) +-- dumpValue func + return $ generateFunction ee func +-} + +-- | Combine 'simpleFunction' and 'unsafePurify'. +unsafeGenerateFunction :: (Unsafe t a, Translatable t) => + CodeGenModule (Function t) -> a +unsafeGenerateFunction bld = unsafePerformIO $ do + fun <- simpleFunction bld + return $ unsafePurify fun diff --git a/LLVM/ExecutionEngine/Engine.hs b/LLVM/ExecutionEngine/Engine.hs new file mode 100644 --- /dev/null +++ b/LLVM/ExecutionEngine/Engine.hs @@ -0,0 +1,406 @@ +{-# LANGUAGE ForeignFunctionInterface, FlexibleInstances, UndecidableInstances, OverlappingInstances, ScopedTypeVariables, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} +module LLVM.ExecutionEngine.Engine( + EngineAccess, + runEngineAccess, +{- + ExecutionEngine, +-} + createExecutionEngine, addModuleProvider, addModule, + {- runStaticConstructors, runStaticDestructors, -} + getExecutionEngineTargetData, + getPointerToFunction, + addFunctionValue, addGlobalMappings, + getFreePointers, FreePointers, + runFunction, getRunFunction, + GenericValue, Generic(..), GenericTuple(..), + ) where +import Control.Monad.State +import Control.Concurrent.MVar +import Data.Typeable +import Data.Int +import Data.Word +import Foreign.Marshal.Alloc (alloca, free) +import Foreign.Marshal.Array (withArrayLen) +import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr) +import Foreign.Marshal.Utils (fromBool) +import Foreign.C.String (peekCString) +import Foreign.Ptr (Ptr, FunPtr, castFunPtrToPtr, ) +import LLVM.Core.CodeGen(Value(..), Function) +import LLVM.Core.CodeGenMonad(GlobalMappings(..)) +import Foreign.Storable (peek) +import Foreign.StablePtr (StablePtr, castStablePtrToPtr, castPtrToStablePtr, ) +import System.IO.Unsafe (unsafePerformIO) + +import LLVM.Core.Util(Module, ModuleProvider, withModuleProvider, createModule, createModuleProviderForExistingModule) +import qualified LLVM.FFI.ExecutionEngine as FFI +import qualified LLVM.FFI.Target as FFI +import qualified LLVM.Core.Util as U +import qualified LLVM.FFI.Core as FFI(ModuleProviderRef, ValueRef) +import LLVM.Core.Type(IsFirstClass, typeRef) + +{- +-- |The type of the JITer. +newtype ExecutionEngine = ExecutionEngine { + fromExecutionEngine :: ForeignPtr FFI.ExecutionEngine + } + +withExecutionEngine :: ExecutionEngine -> (Ptr FFI.ExecutionEngine -> IO a) + -> IO a +withExecutionEngine = withForeignPtr . fromExecutionEngine + +-- |Create an execution engine for a module provider. +-- Warning, do not call this function more than once. +createExecutionEngine :: ModuleProvider -> IO ExecutionEngine +createExecutionEngine prov = + withModuleProvider prov $ \provPtr -> + alloca $ \eePtr -> + alloca $ \errPtr -> do + ret <- FFI.createExecutionEngine eePtr provPtr errPtr + if ret == 1 + then do err <- peek errPtr + errStr <- peekCString err + free err + ioError . userError $ errStr + else do ptr <- peek eePtr + liftM ExecutionEngine $ newForeignPtr FFI.ptrDisposeExecutionEngine ptr + +addModuleProvider :: ExecutionEngine -> ModuleProvider -> IO () +addModuleProvider ee prov = + withExecutionEngine ee $ \ eePtr -> + withModuleProvider prov $ \ provPtr -> + FFI.addModuleProvider eePtr provPtr + +runStaticConstructors :: ExecutionEngine -> IO () +runStaticConstructors ee = withExecutionEngine ee FFI.runStaticConstructors + +runStaticDestructors :: ExecutionEngine -> IO () +runStaticDestructors ee = withExecutionEngine ee FFI.runStaticDestructors + +getExecutionEngineTargetData :: ExecutionEngine -> IO FFI.TargetDataRef +getExecutionEngineTargetData ee = withExecutionEngine ee FFI.getExecutionEngineTargetData + +getPointerToFunction :: ExecutionEngine -> Function f -> IO (FunPtr f) +getPointerToFunction ee (Value f) = + withExecutionEngine ee $ \ eePtr -> + FFI.getPointerToGlobal eePtr f +-} + +-- This global variable holds the one and only execution engine. +-- It may be missing, but it never dies. +-- XXX We could provide a destructor, what about functions obtained by runFunction? +{-# NOINLINE theEngine #-} +theEngine :: MVar (Maybe (Ptr FFI.ExecutionEngine)) +theEngine = unsafePerformIO $ newMVar Nothing + +createExecutionEngine :: ModuleProvider -> IO (Ptr FFI.ExecutionEngine) +createExecutionEngine prov = + withModuleProvider prov $ \provPtr -> + alloca $ \eePtr -> + alloca $ \errPtr -> do + ret <- FFI.createExecutionEngine eePtr provPtr errPtr + if ret == 1 + then do + err <- peek errPtr + errStr <- peekCString err + free err + ioError . userError $ errStr + else + peek eePtr + +getTheEngine :: IO (Ptr FFI.ExecutionEngine) +getTheEngine = do + mee <- takeMVar theEngine + case mee of + Just ee -> do putMVar theEngine mee; return ee + Nothing -> do + m <- createModule "__empty__" + mp <- createModuleProviderForExistingModule m + ee <- createExecutionEngine mp + putMVar theEngine (Just ee) + return ee + +data EAState = EAState { + ea_engine :: Ptr FFI.ExecutionEngine, + ea_providers :: [ModuleProvider] + } + deriving (Show, Typeable) + +newtype EngineAccess a = EA (StateT EAState IO a) + deriving (Functor, Monad, MonadState EAState, MonadIO) + +-- |The LLVM execution engine is encapsulated so it cannot be accessed directly. +-- The reason is that (currently) there must only ever be one engine, +-- so access to it is wrapped in a monad. +runEngineAccess :: EngineAccess a -> IO a +runEngineAccess (EA body) = do + eePtr <- getTheEngine + let ea = EAState { ea_engine = eePtr, ea_providers = [] } + (a, _ea') <- runStateT body ea + -- XXX should remove module providers again + return a + +addModuleProvider :: ModuleProvider -> EngineAccess () +addModuleProvider prov = do + ea <- get + put ea{ ea_providers = prov : ea_providers ea } + liftIO $ withModuleProvider prov $ \ provPtr -> + FFI.addModuleProvider (ea_engine ea) provPtr + +getExecutionEngineTargetData :: EngineAccess FFI.TargetDataRef +getExecutionEngineTargetData = do + eePtr <- gets ea_engine + liftIO $ FFI.getExecutionEngineTargetData eePtr + +{- | +In contrast to 'generateFunction' this compiles a function once. +Thus it is faster for many calls to the same function. +See @examples\/Vector.hs@. + +If the function calls back into Haskell code, +you also have to set the function addresses +using 'addFunctionValue' or 'addGlobalMappings'. +-} +getPointerToFunction :: Function f -> EngineAccess (FunPtr f) +getPointerToFunction (Value f) = do + eePtr <- gets ea_engine + liftIO $ FFI.getPointerToGlobal eePtr f + +{- | +Tell LLVM the address of an external function +if it cannot resolve a name automatically. +Alternatively you may declare the function +with 'staticFunction' instead of 'externFunction'. +-} +addFunctionValue :: Function f -> FunPtr f -> EngineAccess () +addFunctionValue (Value g) f = + addFunctionValueCore g (castFunPtrToPtr f) + +{- | +Pass a list of global mappings to LLVM +that can be obtained from 'LLVM.Core.getGlobalMappings'. +-} +addGlobalMappings :: GlobalMappings -> EngineAccess () +addGlobalMappings (GlobalMappings gms) = + mapM_ (uncurry addFunctionValueCore) gms + +addFunctionValueCore :: U.Function -> Ptr () -> EngineAccess () +addFunctionValueCore g f = do + eePtr <- gets ea_engine + liftIO $ FFI.addGlobalMapping eePtr g f + +addModule :: Module -> EngineAccess () +addModule m = do + mp <- liftIO $ createModuleProviderForExistingModule m + addModuleProvider mp + +-- | Get all the information needed to free a function. +-- Freeing code might have to be done from a (C) finalizer, so it has to done from C. +-- The function c_freeFunctionObject take these pointers as arguments and frees the function. +type FreePointers = (Ptr FFI.ExecutionEngine, FFI.ModuleProviderRef, FFI.ValueRef) +getFreePointers :: Function f -> EngineAccess FreePointers +getFreePointers (Value f) = do + ea <- get + liftIO $ withModuleProvider (head $ ea_providers ea) $ \ mpp -> + return (ea_engine ea, mpp, f) + +-------------------------------------- + +newtype GenericValue = GenericValue { + fromGenericValue :: ForeignPtr FFI.GenericValue + } + +withGenericValue :: GenericValue -> (FFI.GenericValueRef -> IO a) -> IO a +withGenericValue = withForeignPtr . fromGenericValue + +createGenericValueWith :: IO FFI.GenericValueRef -> IO GenericValue +createGenericValueWith f = do + ptr <- f + liftM GenericValue $ newForeignPtr FFI.ptrDisposeGenericValue ptr + +withAll :: [GenericValue] -> (Int -> Ptr FFI.GenericValueRef -> IO a) -> IO a +withAll ps a = go [] ps + where go ptrs (x:xs) = withGenericValue x $ \ptr -> go (ptr:ptrs) xs + go ptrs _ = withArrayLen (reverse ptrs) a + +runFunction :: U.Function -> [GenericValue] -> EngineAccess GenericValue +runFunction func args = do + eePtr <- gets ea_engine + liftIO $ withAll args $ \argLen argPtr -> + createGenericValueWith $ FFI.runFunction eePtr func + (fromIntegral argLen) argPtr +getRunFunction :: EngineAccess (U.Function -> [GenericValue] -> IO GenericValue) +getRunFunction = do + eePtr <- gets ea_engine + return $ \ func args -> + withAll args $ \argLen argPtr -> + createGenericValueWith $ FFI.runFunction eePtr func + (fromIntegral argLen) argPtr + +class Generic a where + toGeneric :: a -> GenericValue + fromGeneric :: GenericValue -> a + +instance Generic () where + toGeneric _ = error "toGeneric ()" + fromGeneric _ = () + +toGenericInt :: (Integral a, IsFirstClass a) => Bool -> a -> GenericValue +toGenericInt signed val = unsafePerformIO $ createGenericValueWith $ + FFI.createGenericValueOfInt (typeRef val) (fromIntegral val) (fromBool signed) + +fromGenericInt :: (Integral a, IsFirstClass a) => Bool -> GenericValue -> a +fromGenericInt signed val = unsafePerformIO $ + withGenericValue val $ \ref -> + return . fromIntegral $ FFI.genericValueToInt ref (fromBool signed) + +--instance Generic Bool where +-- toGeneric = toGenericInt False . fromBool +-- fromGeneric = toBool . fromGenericInt False + +instance Generic Int8 where + toGeneric = toGenericInt True + fromGeneric = fromGenericInt True + +instance Generic Int16 where + toGeneric = toGenericInt True + fromGeneric = fromGenericInt True + +instance Generic Int32 where + toGeneric = toGenericInt True + fromGeneric = fromGenericInt True + +{- +instance Generic Int where + toGeneric = toGenericInt True + fromGeneric = fromGenericInt True +-} + +instance Generic Int64 where + toGeneric = toGenericInt True + fromGeneric = fromGenericInt True + +instance Generic Word8 where + toGeneric = toGenericInt False + fromGeneric = fromGenericInt False + +instance Generic Word16 where + toGeneric = toGenericInt False + fromGeneric = fromGenericInt False + +instance Generic Word32 where + toGeneric = toGenericInt False + fromGeneric = fromGenericInt False + +instance Generic Word64 where + toGeneric = toGenericInt False + fromGeneric = fromGenericInt False + +toGenericReal :: (Real a, IsFirstClass a) => a -> GenericValue +toGenericReal val = unsafePerformIO $ createGenericValueWith $ + FFI.createGenericValueOfFloat (typeRef val) (realToFrac val) + +fromGenericReal :: forall a . (Fractional a, IsFirstClass a) => GenericValue -> a +fromGenericReal val = unsafePerformIO $ + withGenericValue val $ \ ref -> + return . realToFrac $ FFI.genericValueToFloat (typeRef (undefined :: a)) ref + +instance Generic Float where + toGeneric = toGenericReal + fromGeneric = fromGenericReal + +instance Generic Double where + toGeneric = toGenericReal + fromGeneric = fromGenericReal + +instance Generic (Ptr a) where + toGeneric = unsafePerformIO . createGenericValueWith . FFI.createGenericValueOfPointer + fromGeneric val = unsafePerformIO . withGenericValue val $ FFI.genericValueToPointer + +instance Generic (StablePtr a) where + toGeneric = unsafePerformIO . createGenericValueWith . FFI.createGenericValueOfPointer . castStablePtrToPtr + fromGeneric val = unsafePerformIO . fmap castPtrToStablePtr . withGenericValue val $ FFI.genericValueToPointer + + +class GenericTuple a where + toGenericTuple :: a -> [GenericValue] + fromGenericTuple :: State [GenericValue] a + +toGenericAtom :: Generic a => a -> [GenericValue] +toGenericAtom = (:[]) . toGeneric + +fromGenericAtom :: Generic a => State [GenericValue] a +fromGenericAtom = + State $ \gt -> + case gt of + [] -> error "too few generic values for tuple" + g:gs -> (fromGeneric g, gs) + +instance GenericTuple () where + toGenericTuple _ = [] + fromGenericTuple = return () + +instance (GenericTuple a, GenericTuple b) => GenericTuple (a,b) where + toGenericTuple ~(a,b) = toGenericTuple a ++ toGenericTuple b + fromGenericTuple = + liftM2 (,) fromGenericTuple fromGenericTuple + +instance (GenericTuple a, GenericTuple b, GenericTuple c) => + GenericTuple (a,b,c) where + toGenericTuple ~(a,b,c) = toGenericTuple a ++ toGenericTuple b ++ toGenericTuple c + fromGenericTuple = + liftM3 (,,) fromGenericTuple fromGenericTuple fromGenericTuple + + +instance GenericTuple Int8 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Int16 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Int32 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +{- +instance GenericTuple Int where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom +-} + +instance GenericTuple Int64 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Word8 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Word16 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Word32 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Word64 where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Float where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple Double where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple (Ptr a) where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom + +instance GenericTuple (StablePtr a) where + toGenericTuple = toGenericAtom + fromGenericTuple = fromGenericAtom diff --git a/LLVM/ExecutionEngine/Target.hs b/LLVM/ExecutionEngine/Target.hs new file mode 100644 --- /dev/null +++ b/LLVM/ExecutionEngine/Target.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE Rank2Types, DeriveDataTypeable #-} +module LLVM.ExecutionEngine.Target(TargetData(..), getTargetData, targetDataFromString, withIntPtrType) where +import Data.Typeable +import Data.TypeLevel(Nat, reifyIntegral) +import Foreign.C.String +import System.IO.Unsafe(unsafePerformIO) + +import LLVM.Core.Data(WordN) +import LLVM.ExecutionEngine.Engine(runEngineAccess, getExecutionEngineTargetData) + +import qualified LLVM.FFI.Core as FFI +import qualified LLVM.FFI.Target as FFI + +type Type = FFI.TypeRef + +data TargetData = TargetData { + aBIAlignmentOfType :: Type -> Int, + aBISizeOfType :: Type -> Int, + littleEndian :: Bool, + callFrameAlignmentOfType :: Type -> Int, +-- elementAtOffset :: Type -> Word64 -> Int, + intPtrType :: Type, +-- offsetOfElements :: Int -> Word64, + pointerSize :: Int, +-- preferredAlignmentOfGlobal :: Value a -> Int, + preferredAlignmentOfType :: Type -> Int, + sizeOfTypeInBits :: Type -> Int, + storeSizeOfType :: Type -> Int + } + deriving (Typeable) + +withIntPtrType :: (forall n . (Nat n) => WordN n -> a) -> a +withIntPtrType f = reifyIntegral sz (\ n -> f (g n)) + where g :: n -> WordN n + g _ = error "withIntPtrType: argument used" + sz = pointerSize $ unsafePerformIO getTargetData + +-- Gets the target data for the JIT target. +getEngineTargetDataRef :: IO FFI.TargetDataRef +getEngineTargetDataRef = runEngineAccess getExecutionEngineTargetData + +-- Normally the TargetDataRef never changes, so the operation +-- are really pure functions. +makeTargetData :: FFI.TargetDataRef -> TargetData +makeTargetData r = TargetData { + aBIAlignmentOfType = fromIntegral . FFI.aBIAlignmentOfType r, + aBISizeOfType = fromIntegral . FFI.aBISizeOfType r, + littleEndian = FFI.byteOrder r /= 0, + callFrameAlignmentOfType = fromIntegral . FFI.callFrameAlignmentOfType r, + intPtrType = FFI.intPtrType r, + pointerSize = fromIntegral $ FFI.pointerSize r, + preferredAlignmentOfType = fromIntegral . FFI.preferredAlignmentOfType r, + sizeOfTypeInBits = fromIntegral . FFI.sizeOfTypeInBits r, + storeSizeOfType = fromIntegral . FFI.storeSizeOfType r + } + +getTargetData :: IO TargetData +getTargetData = fmap makeTargetData getEngineTargetDataRef + +targetDataFromString :: String -> TargetData +targetDataFromString s = makeTargetData $ unsafePerformIO $ withCString s FFI.createTargetData diff --git a/LLVM/FFI/Analysis.hsc b/LLVM/FFI/Analysis.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/Analysis.hsc @@ -0,0 +1,19 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module LLVM.FFI.Analysis where +import Foreign.C.String(CString) +import Foreign.C.Types(CInt) +import Foreign.Ptr(Ptr) + +import LLVM.FFI.Core + +type VerifierFailureAction = CInt + +foreign import ccall unsafe "LLVMVerifyFunction" verifyFunction + :: ValueRef -> VerifierFailureAction -> IO CInt +foreign import ccall unsafe "LLVMVerifyModule" verifyModule + :: ModuleRef -> VerifierFailureAction -> (Ptr CString) -> IO CInt +foreign import ccall unsafe "LLVMViewFunctionCFG" viewFunctionCFG + :: ValueRef -> IO () +foreign import ccall unsafe "LLVMViewFunctionCFGOnly" viewFunctionCFGOnly + :: ValueRef -> IO () diff --git a/LLVM/FFI/BitReader.hsc b/LLVM/FFI/BitReader.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/BitReader.hsc @@ -0,0 +1,17 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module LLVM.FFI.BitReader where +import Foreign.C.String(CString) +import Foreign.C.Types(CInt) +import Foreign.Ptr(Ptr) + +import LLVM.FFI.Core + +foreign import ccall unsafe "LLVMGetBitcodeModuleProvider" getBitcodeModuleProvider + :: 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 diff --git a/LLVM/FFI/BitWriter.hsc b/LLVM/FFI/BitWriter.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/BitWriter.hsc @@ -0,0 +1,12 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module LLVM.FFI.BitWriter where +import Foreign.C.String(CString) +import Foreign.C.Types(CInt) + +import LLVM.FFI.Core + +foreign import ccall unsafe "LLVMWriteBitcodeToFile" writeBitcodeToFile + :: ModuleRef -> CString -> IO CInt +foreign import ccall unsafe "LLVMWriteBitcodeToFileHandle" writeBitcodeToFileHandle + :: ModuleRef -> CInt -> IO CInt diff --git a/LLVM/FFI/Core.hsc b/LLVM/FFI/Core.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/Core.hsc @@ -0,0 +1,1476 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, DeriveDataTypeable #-} + +-- | +-- Module: LLVM.FFI.Core +-- Copyright: Bryan O'Sullivan 2007, 2008 +-- License: BSD-style (see the file LICENSE) +-- +-- Maintainer: bos@serpentine.com +-- Stability: experimental +-- Portability: requires GHC 6.8, LLVM +-- +-- This module provides direct access to the LLVM C bindings. + +module LLVM.FFI.Core + ( + -- * Modules + Module + , ModuleRef + , moduleCreateWithName + , disposeModule + , ptrDisposeModule + + , getDataLayout + , setDataLayout + + , getTarget + , setTarget + + -- * Module providers + , ModuleProvider + , ModuleProviderRef + , createModuleProviderForExistingModule + , ptrDisposeModuleProvider + + -- * Types + , Type + , TypeRef + , addTypeName + , deleteTypeName + + , getTypeKind + , TypeKind(..) + + -- ** Integer types + , int1Type + , int8Type + , int16Type + , int32Type + , int64Type + , integerType + , getIntTypeWidth + + -- ** Real types + , floatType + , doubleType + , x86FP80Type + , fp128Type + , ppcFP128Type + + -- ** Function types + , functionType + , isFunctionVarArg + , getReturnType + , countParamTypes + , getParamTypes + + -- ** Other types + , voidType + , labelType + , opaqueType + + -- ** Array, pointer, and vector types + , arrayType + , pointerType + , vectorType + , getElementType + , getArrayLength + , getPointerAddressSpace + , getVectorSize + + -- ** Struct types + , structType + , countStructElementTypes + , getStructElementTypes + , isPackedStruct + + -- * Type handles + , createTypeHandle + , refineType + , resolveTypeHandle + , disposeTypeHandle + + -- * Values + , Value + , ValueRef + , typeOf + , getValueName + , setValueName + , dumpValue + + -- ** Constants + , constNull + , constAllOnes + , getUndef + , isConstant + , isNull + , isUndef + + -- ** Global variables, functions, and aliases (globals) + , Linkage(..) + , fromLinkage + , toLinkage + , getLinkage + , setLinkage + + , Visibility(..) + , fromVisibility + , toVisibility + , getVisibility + , setVisibility + + , isDeclaration + , getSection + , setSection + , getAlignment + , setAlignment + + -- ** Global variables + , addGlobal + , getNamedGlobal + , deleteGlobal + , getInitializer + , setInitializer + , isThreadLocal + , setThreadLocal + , isGlobalConstant + , setGlobalConstant + , getFirstGlobal + , getNextGlobal + , getPreviousGlobal + , getLastGlobal + , getGlobalParent + + -- ** Functions + , addFunction + , getNamedFunction + , deleteFunction + , countParams + , getParams + , getParam + , getIntrinsicID + , getGC + , setGC + , getFirstFunction + , getNextFunction + , getPreviousFunction + , getLastFunction + , getFirstParam + , getNextParam + , getPreviousParam + , getLastParam + , getParamParent + , isTailCall + , setTailCall + + -- ** Phi nodes + , addIncoming + , countIncoming + , getIncomingValue + , getIncomingBlock + + -- ** Calling conventions + , CallingConvention(..) + , fromCallingConvention + , toCallingConvention + , getFunctionCallConv + , setFunctionCallConv + , getInstructionCallConv + , setInstructionCallConv + + -- * Constants + + -- ** Scalar constants + , constInt + , constReal + + -- ** Composite constants + , constArray + , constString + , constStruct + , constVector + + -- ** Constant expressions + , sizeOf + , constNeg + , constNot + , constAdd + , constSub + , constMul + , constExactSDiv + , constFAdd + , constFMul + , constFNeg + , constFPCast + , constFSub + , constUDiv + , constSDiv + , constFDiv + , constURem + , constSRem + , constFRem + , constAnd + , constOr + , constXor + , constICmp + , constFCmp + , constShl + , constLShr + , constAShr + , constGEP + , constTrunc + , constSExt + , constZExt + , constFPTrunc + , constFPExt + , constUIToFP + , constSIToFP + , constFPToUI + , constFPToSI + , constPtrToInt + , constIntToPtr + , constBitCast + , constSelect + , constExtractElement + , constInsertElement + , constShuffleVector + , constExtractValue + , constInsertValue + , constRealOfString + + -- * Basic blocks + , BasicBlock + , BasicBlockRef + , basicBlockAsValue + , valueIsBasicBlock + , valueAsBasicBlock + , countBasicBlocks + , getBasicBlocks + , getEntryBasicBlock + , appendBasicBlock + , insertBasicBlock + , deleteBasicBlock + , getFirstBasicBlock + , getNextBasicBlock + , getPreviousBasicBlock + , getLastBasicBlock + , getInsertBlock + , getBasicBlockParent + + -- * Instruction building + , Builder + , BuilderRef + , createBuilder + , ptrDisposeBuilder + , positionBuilder + , positionBefore + , positionAtEnd + , getFirstInstruction + , getNextInstruction + , getPreviousInstruction + , getLastInstruction + , getInstructionParent + + -- ** Terminators + , buildRetVoid + , buildRet + , buildBr + , buildCondBr + , buildSwitch + , buildInvoke + , buildUnwind + , buildUnreachable + + -- ** Arithmetic + , buildAdd + , buildSub + , buildMul + , buildFAdd + , buildFMul + , buildFPCast + , buildFSub + , buildUDiv + , buildSDiv + , buildExactSDiv + , buildFDiv + , buildURem + , buildSRem + , buildFRem + , buildShl + , buildLShr + , buildAShr + , buildAnd + , buildOr + , buildXor + , buildNeg + , buildNot + + -- ** Memory + , buildMalloc + , buildArrayMalloc + , buildAlloca + , buildArrayAlloca + , buildFree + , buildLoad + , buildStore + , buildGEP + + -- ** Casts + , buildTrunc + , buildZExt + , buildSExt + , buildFPToUI + , buildFPToSI + , buildUIToFP + , buildSIToFP + , buildFPTrunc + , buildFPExt + , buildPtrToInt + , buildIntToPtr + , buildBitCast + , buildPointerCast + , buildTruncOrBitCast + , buildZExtOrBitCast + , buildSExtOrBitCast + + , buildPtrDiff + + -- * Misc + , buildAggregateRet + , buildGlobalString + , buildGlobalStringPtr + , buildInBoundsGEP + , buildIntCast + , buildIsNotNull + , buildIsNull + , buildNSWAdd + , buildStructGEP + + -- ** Comparisons + , buildICmp + , buildFCmp + + -- ** Miscellaneous instructions + , buildPhi + , buildCall + , buildSelect + , buildVAArg + , buildExtractElement + , buildInsertElement + , buildShuffleVector + , buildExtractValue + , buildInsertValue + + -- ** Other helpers + , addCase + + -- * Memory buffers + , MemoryBuffer + , MemoryBufferRef + , createMemoryBufferWithContentsOfFile + , createMemoryBufferWithSTDIN + , disposeMemoryBuffer + + -- * Error handling + , disposeMessage + + -- * Parameter passing + , addAttribute + , setInstrParamAlignment + , setParamAlignment + , Attribute(..) + , fromAttribute + , toAttribute + , addInstrAttribute + , removeFunctionAttr + , removeAttribute + , removeInstrAttribute + , addFunctionAttr + + -- * Pass manager + , PassManager + , PassManagerRef + , createFunctionPassManager + , createPassManager + , ptrDisposePassManager + , finalizeFunctionPassManager + , initializeFunctionPassManager + , 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) +import Foreign.C.Types (CDouble, CInt, CUInt, CULLong) +import Foreign.Ptr (Ptr, FunPtr) + +#include + +data Module + deriving (Typeable) +type ModuleRef = Ptr Module + +foreign import ccall unsafe "LLVMModuleCreateWithName" moduleCreateWithName + :: CString -> IO ModuleRef + +foreign import ccall unsafe "LLVMDisposeModule" disposeModule + :: ModuleRef -> IO () + +foreign import ccall unsafe "&LLVMDisposeModule" ptrDisposeModule + :: FunPtr (ModuleRef -> IO ()) + +foreign import ccall unsafe "LLVMGetDataLayout" getDataLayout + :: ModuleRef -> IO CString + +foreign import ccall unsafe "LLVMSetDataLayout" setDataLayout + :: ModuleRef -> CString -> IO () + + +data ModuleProvider + deriving (Typeable) +type ModuleProviderRef = Ptr ModuleProvider + +foreign import ccall unsafe "LLVMCreateModuleProviderForExistingModule" + createModuleProviderForExistingModule + :: ModuleRef -> IO ModuleProviderRef + +foreign import ccall unsafe "&LLVMDisposeModuleProvider" ptrDisposeModuleProvider + :: FunPtr (ModuleProviderRef -> IO ()) + + +data Type + deriving (Typeable) +type TypeRef = Ptr Type + +foreign import ccall unsafe "LLVMInt1Type" int1Type :: TypeRef + +foreign import ccall unsafe "LLVMInt8Type" int8Type :: TypeRef + +foreign import ccall unsafe "LLVMInt16Type" int16Type :: TypeRef + +foreign import ccall unsafe "LLVMInt32Type" int32Type :: TypeRef + +foreign import ccall unsafe "LLVMInt64Type" int64Type :: TypeRef + +-- | An integer type of the given width. +foreign import ccall unsafe "LLVMIntType" integerType + :: CUInt -- ^ width in bits + -> TypeRef + +foreign import ccall unsafe "LLVMFloatType" floatType :: TypeRef + +foreign import ccall unsafe "LLVMDoubleType" doubleType :: TypeRef + +foreign import ccall unsafe "LLVMX86FP80Type" x86FP80Type :: TypeRef + +foreign import ccall unsafe "LLVMFP128Type" fp128Type :: TypeRef + +foreign import ccall unsafe "LLVMPPCFP128Type" ppcFP128Type :: TypeRef + +foreign import ccall unsafe "LLVMVoidType" voidType :: TypeRef + +-- | Create a function type. +foreign import ccall unsafe "LLVMFunctionType" functionType + :: TypeRef -- ^ return type + -> Ptr TypeRef -- ^ array of argument types + -> CUInt -- ^ number of elements in array + -> CInt -- ^ non-zero if function is varargs + -> TypeRef + +-- | Indicate whether a function takes varargs. +foreign import ccall unsafe "LLVMIsFunctionVarArg" isFunctionVarArg + :: TypeRef -> IO CInt + +-- | Give a function's return type. +foreign import ccall unsafe "LLVMGetReturnType" getReturnType + :: TypeRef -> IO TypeRef + +-- | Give the number of fixed parameters that a function takes. +foreign import ccall unsafe "LLVMCountParamTypes" countParamTypes + :: TypeRef -> IO CUInt + +-- | Fill out an array with the types of a function's fixed +-- parameters. +foreign import ccall unsafe "LLVMGetParamTypes" getParamTypes + :: TypeRef -> Ptr TypeRef -> IO () + +foreign import ccall unsafe "LLVMArrayType" arrayType + :: TypeRef -- ^ element type + -> CUInt -- ^ element count + -> TypeRef + +foreign import ccall unsafe "LLVMPointerType" pointerType + :: TypeRef -- ^ pointed-to type + -> CUInt -- ^ address space + -> TypeRef + +foreign import ccall unsafe "LLVMVectorType" vectorType + :: TypeRef -- ^ element type + -> CUInt -- ^ element count + -> TypeRef + +foreign import ccall unsafe "LLVMAddTypeName" addTypeName + :: ModuleRef -> CString -> TypeRef -> IO CInt + +foreign import ccall unsafe "LLVMDeleteTypeName" deleteTypeName + :: ModuleRef -> CString -> IO () + +-- | Get the type of a sequential type's elements. +foreign import ccall unsafe "LLVMGetElementType" getElementType + :: TypeRef -> IO TypeRef + + +data Value + deriving (Typeable) +type ValueRef = Ptr Value + +foreign import ccall unsafe "LLVMAddGlobal" addGlobal + :: ModuleRef -> TypeRef -> CString -> IO ValueRef + +foreign import ccall unsafe "LLVMDeleteGlobal" deleteGlobal + :: ValueRef -> IO () + +foreign import ccall unsafe "LLVMSetInitializer" setInitializer + :: ValueRef -> ValueRef -> IO () + +foreign import ccall unsafe "LLVMGetNamedGlobal" getNamedGlobal + :: ModuleRef -> CString -> IO ValueRef + +foreign import ccall unsafe "LLVMGetInitializer" getInitializer + :: ValueRef -> IO ValueRef + +foreign import ccall unsafe "LLVMIsThreadLocal" isThreadLocal + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMSetThreadLocal" setThreadLocal + :: ValueRef -> CInt -> IO () + +foreign import ccall unsafe "LLVMIsGlobalConstant" isGlobalConstant + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMSetGlobalConstant" setGlobalConstant + :: ValueRef -> CInt -> IO () + +foreign import ccall unsafe "LLVMTypeOf" typeOf + :: ValueRef -> IO TypeRef + +foreign import ccall unsafe "LLVMGetValueName" getValueName + :: ValueRef -> IO CString + +foreign import ccall unsafe "LLVMSetValueName" setValueName + :: ValueRef -> CString -> IO () + +foreign import ccall unsafe "LLVMDumpValue" dumpValue + :: ValueRef -> IO () + +foreign import ccall unsafe "LLVMConstAllOnes" constAllOnes + :: TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstArray" constArray + :: TypeRef -> Ptr ValueRef -> CUInt -> ValueRef + +foreign import ccall unsafe "LLVMConstNull" constNull + :: TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMIsConstant" isConstant + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMGetUndef" getUndef + :: TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMIsNull" isNull + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMIsUndef" isUndef + :: ValueRef -> IO CInt + +foreign import ccall unsafe "LLVMGetNamedFunction" getNamedFunction + :: ModuleRef -- ^ module + -> CString -- ^ name + -> IO ValueRef -- ^ function (@nullPtr@ if not found) + +foreign import ccall unsafe "LLVMAddFunction" addFunction + :: ModuleRef -- ^ module + -> CString -- ^ name + -> TypeRef -- ^ type + -> IO ValueRef + +foreign import ccall unsafe "LLVMDeleteFunction" deleteFunction + :: ValueRef -- ^ function + -> IO () + +foreign import ccall unsafe "LLVMCountParams" countParams + :: ValueRef -- ^ function + -> CUInt + +foreign import ccall unsafe "LLVMGetParam" getParam + :: ValueRef -- ^ function + -> CUInt -- ^ offset into array + -> ValueRef + +foreign import ccall unsafe "LLVMGetParams" getParams + :: ValueRef -- ^ function + -> Ptr ValueRef -- ^ array to fill out + -> IO () + +foreign import ccall unsafe "LLVMGetIntrinsicID" getIntrinsicID + :: ValueRef -- ^ function + -> CUInt + +data CallingConvention = C + | Fast + | Cold + | X86StdCall + | X86FastCall + deriving (Show, Eq, Ord, Enum, Bounded, Typeable) + +fromCallingConvention :: CallingConvention -> CUInt +fromCallingConvention C = (#const LLVMCCallConv) +fromCallingConvention Fast = (#const LLVMFastCallConv) +fromCallingConvention Cold = (#const LLVMColdCallConv) +fromCallingConvention X86StdCall = (#const LLVMX86FastcallCallConv) +fromCallingConvention X86FastCall = (#const LLVMX86StdcallCallConv) + +toCallingConvention :: CUInt -> CallingConvention +toCallingConvention c | c == (#const LLVMCCallConv) = C +toCallingConvention c | c == (#const LLVMFastCallConv) = Fast +toCallingConvention c | c == (#const LLVMColdCallConv) = Cold +toCallingConvention c | c == (#const LLVMX86StdcallCallConv) = X86StdCall +toCallingConvention c | c == (#const LLVMX86FastcallCallConv) = X86FastCall +toCallingConvention c = error $ "LLVM.Core.FFI.toCallingConvention: " ++ + "unsupported calling convention" ++ show c + +foreign import ccall unsafe "LLVMGetFunctionCallConv" getFunctionCallConv + :: ValueRef -- ^ function + -> IO CUInt + +foreign import ccall unsafe "LLVMSetFunctionCallConv" setFunctionCallConv + :: ValueRef -- ^ function + -> CUInt + -> IO () + +foreign import ccall unsafe "LLVMGetGC" getGC + :: ValueRef -> IO CString + +foreign import ccall unsafe "LLVMSetGC" setGC + :: ValueRef -> CString -> IO () + +foreign import ccall unsafe "LLVMIsDeclaration" isDeclaration + :: ValueRef -> IO CInt + +-- |An enumeration for the kinds of linkage for global values. +data Linkage + = ExternalLinkage -- ^Externally visible function + | AvailableExternallyLinkage + | LinkOnceAnyLinkage -- ^Keep one copy of function when linking (inline) + | LinkOnceODRLinkage -- ^Same, but only replaced by something equivalent. + | WeakAnyLinkage -- ^Keep one copy of named function when linking (weak) + | WeakODRLinkage -- ^Same, but only replaced by something equivalent. + | AppendingLinkage -- ^Special purpose, only applies to global arrays + | InternalLinkage -- ^Rename collisions when linking (static functions) + | PrivateLinkage -- ^Like Internal, but omit from symbol table + | DLLImportLinkage -- ^Function to be imported from DLL + | DLLExportLinkage -- ^Function to be accessible from DLL + | ExternalWeakLinkage -- ^ExternalWeak linkage description + | GhostLinkage -- ^Stand-in functions for streaming fns from BC files + | CommonLinkage -- ^Tentative definitions + | LinkerPrivateLinkage -- ^Like Private, but linker removes. + deriving (Show, Eq, Ord, Enum, Typeable) + +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 CUInt + +foreign import ccall unsafe "LLVMSetLinkage" setLinkage + :: ValueRef -> CUInt -> IO () + +foreign import ccall unsafe "LLVMGetSection" getSection + :: ValueRef -> IO CString + +foreign import ccall unsafe "LLVMSetSection" setSection + :: ValueRef -> CString -> IO () + +-- |An enumeration for the kinds of visibility of global values. +data Visibility + = DefaultVisibility -- ^The GV is visible + | HiddenVisibility -- ^The GV is hidden + | ProtectedVisibility -- ^The GV is protected + deriving (Show, Eq, Ord, Enum) + +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 CUInt + +foreign import ccall unsafe "LLVMSetVisibility" setVisibility + :: ValueRef -> CUInt -> IO () + +foreign import ccall unsafe "LLVMGetAlignment" getAlignment + :: ValueRef -> IO CUInt + +foreign import ccall unsafe "LLVMSetAlignment" setAlignment + :: ValueRef -> CUInt -> IO () + + +foreign import ccall unsafe "LLVMConstInt" constInt + :: TypeRef -> CULLong -> CInt -> ValueRef + +foreign import ccall unsafe "LLVMConstReal" constReal + :: TypeRef -> CDouble -> ValueRef + +foreign import ccall unsafe "LLVMConstString" constString + :: CString -> CUInt -> CInt -> ValueRef + +foreign import ccall unsafe "LLVMConstStruct" constStruct + :: Ptr ValueRef -> CUInt -> CInt -> ValueRef + +foreign import ccall unsafe "LLVMConstVector" constVector + :: Ptr ValueRef -> CUInt -> ValueRef + +foreign import ccall unsafe "LLVMConstNeg" constNeg + :: ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstNot" constNot + :: ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstAdd" constAdd + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstSub" constSub + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstMul" constMul + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstUDiv" constUDiv + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstSDiv" constSDiv + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstFDiv" constFDiv + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstURem" constURem + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstSRem" constSRem + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstFRem" constFRem + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstAnd" constAnd + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstOr" constOr + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstXor" constXor + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstICmp" constICmp + :: CInt -> ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstFCmp" constFCmp + :: CInt -> ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstShl" constShl + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstLShr" constLShr + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstAShr" constAShr + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstGEP" constGEP + :: ValueRef -> Ptr ValueRef -> CUInt -> ValueRef + +foreign import ccall unsafe "LLVMConstTrunc" constTrunc + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstSExt" constSExt + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstZExt" constZExt + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstFPTrunc" constFPTrunc + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstFPExt" constFPExt + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstUIToFP" constUIToFP + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstSIToFP" constSIToFP + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstFPToUI" constFPToUI + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstFPToSI" constFPToSI + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstPtrToInt" constPtrToInt + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstIntToPtr" constIntToPtr + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstBitCast" constBitCast + :: ValueRef -> TypeRef -> ValueRef + +foreign import ccall unsafe "LLVMConstSelect" constSelect + :: ValueRef -> ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstExtractElement" constExtractElement + :: ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstInsertElement" constInsertElement + :: ValueRef -> ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstShuffleVector" constShuffleVector + :: ValueRef -> ValueRef -> ValueRef -> ValueRef + +foreign import ccall unsafe "LLVMConstExtractValue" constExtractValue + :: ValueRef -> Ptr ValueRef -> CUInt -> ValueRef + +foreign import ccall unsafe "LLVMConstInsertValue" constInsertValue + :: ValueRef -> ValueRef -> Ptr ValueRef -> CUInt -> ValueRef + +type BasicBlock = Value +type BasicBlockRef = Ptr BasicBlock + +foreign import ccall unsafe "LLVMBasicBlockAsValue" basicBlockAsValue + :: BasicBlockRef -> ValueRef + +foreign import ccall unsafe "LLVMValueIsBasicBlock" valueIsBasicBlock + :: ValueRef -> Bool + +foreign import ccall unsafe "LLVMValueAsBasicBlock" valueAsBasicBlock + :: ValueRef -- ^ basic block + -> BasicBlockRef + +foreign import ccall unsafe "LLVMCountBasicBlocks" countBasicBlocks + :: ValueRef -- ^ function + -> IO CUInt + +foreign import ccall unsafe "LLVMGetBasicBlocks" getBasicBlocks + :: ValueRef -- ^ function + -> Ptr BasicBlockRef -- ^ array to fill out + -> IO () + +foreign import ccall unsafe "LLVMGetEntryBasicBlock" getEntryBasicBlock + :: ValueRef -- ^ function + -> IO BasicBlockRef + +foreign import ccall unsafe "LLVMAppendBasicBlock" appendBasicBlock + :: ValueRef -- ^ function + -> CString -- ^ name for label + -> IO BasicBlockRef + +foreign import ccall unsafe "LLVMInsertBasicBlock" insertBasicBlock + :: BasicBlockRef -- ^ insert before this one + -> CString -- ^ name for label + -> IO BasicBlockRef + +foreign import ccall unsafe "LLVMDeleteBasicBlock" deleteBasicBlock + :: BasicBlockRef -> IO () + +data Builder + deriving (Typeable) +type BuilderRef = Ptr Builder + +foreign import ccall unsafe "LLVMCreateBuilder" createBuilder + :: IO BuilderRef + +foreign import ccall unsafe "&LLVMDisposeBuilder" ptrDisposeBuilder + :: FunPtr (BuilderRef -> IO ()) + +foreign import ccall unsafe "LLVMPositionBuilderBefore" positionBefore + :: BuilderRef -> ValueRef -> IO () + +foreign import ccall unsafe "LLVMPositionBuilderAtEnd" positionAtEnd + :: BuilderRef -> BasicBlockRef -> IO () + +foreign import ccall unsafe "LLVMBuildRetVoid" buildRetVoid + :: BuilderRef -> IO ValueRef +foreign import ccall unsafe "LLVMBuildRet" buildRet + :: BuilderRef -> ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMBuildBr" buildBr + :: BuilderRef -> BasicBlockRef -> IO ValueRef +foreign import ccall unsafe "LLVMBuildCondBr" buildCondBr + :: BuilderRef -> ValueRef -> BasicBlockRef -> BasicBlockRef -> IO ValueRef +foreign import ccall unsafe "LLVMBuildSwitch" buildSwitch + :: BuilderRef -> ValueRef -> BasicBlockRef -> CUInt -> IO ValueRef +foreign import ccall unsafe "LLVMBuildInvoke" buildInvoke + :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt + -> BasicBlockRef -> BasicBlockRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildUnwind" buildUnwind + :: BuilderRef -> IO ValueRef +foreign import ccall unsafe "LLVMBuildUnreachable" buildUnreachable + :: BuilderRef -> IO ValueRef + +foreign import ccall unsafe "LLVMBuildAdd" buildAdd + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildSub" buildSub + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildMul" buildMul + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildUDiv" buildUDiv + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildSDiv" buildSDiv + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFDiv" buildFDiv + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildURem" buildURem + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildSRem" buildSRem + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFRem" buildFRem + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildShl" buildShl + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildLShr" buildLShr + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildAShr" buildAShr + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildAnd" buildAnd + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildOr" buildOr + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildXor" buildXor + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildNeg" buildNeg + :: BuilderRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildNot" buildNot + :: BuilderRef -> ValueRef -> CString -> IO ValueRef + +-- Memory +foreign import ccall unsafe "LLVMBuildMalloc" buildMalloc + :: BuilderRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildArrayMalloc" buildArrayMalloc + :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildAlloca" buildAlloca + :: BuilderRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildArrayAlloca" buildArrayAlloca + :: BuilderRef -> TypeRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFree" buildFree + :: BuilderRef -> ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMBuildLoad" buildLoad + :: BuilderRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildStore" buildStore + :: BuilderRef -> ValueRef -> ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMBuildGEP" buildGEP + :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString + -> IO ValueRef + +-- Casts +foreign import ccall unsafe "LLVMBuildTrunc" buildTrunc + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildZExt" buildZExt + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildSExt" buildSExt + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFPToUI" buildFPToUI + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFPToSI" buildFPToSI + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildUIToFP" buildUIToFP + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildSIToFP" buildSIToFP + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFPTrunc" buildFPTrunc + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFPExt" buildFPExt + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildPtrToInt" buildPtrToInt + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildIntToPtr" buildIntToPtr + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildBitCast" buildBitCast + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef + +-- Comparisons +foreign import ccall unsafe "LLVMBuildICmp" buildICmp + :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildFCmp" buildFCmp + :: BuilderRef -> CInt -> ValueRef -> ValueRef -> CString -> IO ValueRef + +-- Miscellaneous instructions +foreign import ccall unsafe "LLVMBuildPhi" buildPhi + :: BuilderRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildCall" buildCall + :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildSelect" buildSelect + :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildVAArg" buildVAArg + :: BuilderRef -> ValueRef -> TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildExtractElement" buildExtractElement + :: BuilderRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildInsertElement" buildInsertElement + :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildShuffleVector" buildShuffleVector + :: BuilderRef -> ValueRef -> ValueRef -> ValueRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildExtractValue" buildExtractValue + :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMBuildInsertValue" buildInsertValue + :: BuilderRef -> ValueRef -> ValueRef -> CUInt -> CString -> IO ValueRef + +foreign import ccall unsafe "LLVMAddCase" addCase + :: ValueRef -> ValueRef -> BasicBlockRef -> IO () + +foreign import ccall unsafe "LLVMCountIncoming" countIncoming + :: ValueRef -> IO CUInt +foreign import ccall unsafe "LLVMAddIncoming" addIncoming + :: ValueRef -> Ptr ValueRef -> Ptr ValueRef -> CUInt -> IO () +foreign import ccall unsafe "LLVMGetIncomingValue" getIncomingValue + :: 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 -> 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 -> CInt + +data MemoryBuffer + deriving (Typeable) +type MemoryBufferRef = Ptr MemoryBuffer + +data TypeHandle + deriving (Typeable) +type TypeHandleRef = Ptr TypeHandle + +data TypeKind + = VoidTypeKind + | FloatTypeKind + | DoubleTypeKind + | X86_FP80TypeKind + | FP128TypeKind + | PPC_FP128TypeKind + | LabelTypeKind + | IntegerTypeKind + | FunctionTypeKind + | StructTypeKind + | ArrayTypeKind + | PointerTypeKind + | OpaqueTypeKind + | VectorTypeKind + deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable) + +getTypeKind :: TypeRef -> IO TypeKind +getTypeKind = fmap (toEnum . fromIntegral) . getTypeKindCUInt + +foreign import ccall unsafe "LLVMCreateMemoryBufferWithContentsOfFile" createMemoryBufferWithContentsOfFile + :: CString -> Ptr MemoryBufferRef -> Ptr CString -> IO CInt +foreign import ccall unsafe "LLVMCreateMemoryBufferWithSTDIN" createMemoryBufferWithSTDIN + :: Ptr MemoryBufferRef -> Ptr CString -> IO CInt +foreign import ccall unsafe "LLVMCreateTypeHandle" createTypeHandle + :: TypeRef -> IO TypeHandleRef +foreign import ccall unsafe "LLVMDisposeMemoryBuffer" disposeMemoryBuffer + :: MemoryBufferRef -> IO () +foreign import ccall unsafe "LLVMDisposeMessage" disposeMessage + :: CString -> IO () +foreign import ccall unsafe "LLVMDisposeTypeHandle" disposeTypeHandle + :: TypeHandleRef -> IO () +foreign import ccall unsafe "LLVMGetArrayLength" getArrayLength + :: TypeRef -> IO CUInt +foreign import ccall unsafe "LLVMGetIntTypeWidth" getIntTypeWidth + :: TypeRef -> IO CUInt +foreign import ccall unsafe "LLVMGetPointerAddressSpace" getPointerAddressSpace + :: TypeRef -> IO CUInt +foreign import ccall unsafe "LLVMGetTarget" getTarget + :: ModuleRef -> IO CString +foreign import ccall unsafe "LLVMGetTypeKind" getTypeKindCUInt + :: TypeRef -> IO CUInt +foreign import ccall unsafe "LLVMGetVectorSize" getVectorSize + :: TypeRef -> IO CUInt +foreign import ccall unsafe "LLVMRefineType" refineType + :: TypeRef -> TypeRef -> IO () +foreign import ccall unsafe "LLVMResolveTypeHandle" resolveTypeHandle + :: TypeHandleRef -> IO TypeRef +foreign import ccall unsafe "LLVMSetTarget" setTarget + :: ModuleRef -> CString -> IO () +foreign import ccall unsafe "LLVMSizeOf" sizeOf + :: TypeRef -> IO ValueRef + +data Attribute + = ZExtAttribute + | SExtAttribute + | NoReturnAttribute + | InRegAttribute + | StructRetAttribute + | NoUnwindAttribute + | NoAliasAttribute + | ByValAttribute + | NestAttribute + | ReadNoneAttribute + | ReadOnlyAttribute + deriving (Show, Eq, Ord, Enum, Bounded, Typeable) + +fromAttribute :: Attribute -> CAttribute +fromAttribute ZExtAttribute = (#const LLVMZExtAttribute) +fromAttribute SExtAttribute = (#const LLVMSExtAttribute) +fromAttribute NoReturnAttribute = (#const LLVMNoReturnAttribute) +fromAttribute InRegAttribute = (#const LLVMInRegAttribute) +fromAttribute StructRetAttribute = (#const LLVMStructRetAttribute) +fromAttribute NoUnwindAttribute = (#const LLVMNoUnwindAttribute) +fromAttribute NoAliasAttribute = (#const LLVMNoAliasAttribute) +fromAttribute ByValAttribute = (#const LLVMByValAttribute) +fromAttribute NestAttribute = (#const LLVMNestAttribute) +fromAttribute ReadNoneAttribute = (#const LLVMReadNoneAttribute) +fromAttribute ReadOnlyAttribute = (#const LLVMReadOnlyAttribute) + +toAttribute :: CAttribute -> Attribute +toAttribute c | c == (#const LLVMZExtAttribute) = ZExtAttribute +toAttribute c | c == (#const LLVMSExtAttribute) = SExtAttribute +toAttribute c | c == (#const LLVMNoReturnAttribute) = NoReturnAttribute +toAttribute c | c == (#const LLVMInRegAttribute) = InRegAttribute +toAttribute c | c == (#const LLVMStructRetAttribute) = StructRetAttribute +toAttribute c | c == (#const LLVMNoUnwindAttribute) = NoUnwindAttribute +toAttribute c | c == (#const LLVMNoAliasAttribute) = NoAliasAttribute +toAttribute c | c == (#const LLVMByValAttribute) = ByValAttribute +toAttribute c | c == (#const LLVMNestAttribute) = NestAttribute +toAttribute c | c == (#const LLVMReadNoneAttribute) = ReadNoneAttribute +toAttribute c | c == (#const LLVMReadOnlyAttribute) = ReadOnlyAttribute +toAttribute _ = error "toAttribute: bad value" + +type CAttribute = CInt + +data PassManager + deriving (Typeable) +type PassManagerRef = Ptr PassManager + +foreign import ccall unsafe "LLVMConstRealOfString" constRealOfString + :: TypeRef -> CString -> IO ValueRef +foreign import ccall unsafe "LLVMCreateFunctionPassManager" createFunctionPassManager + :: ModuleProviderRef -> IO PassManagerRef +foreign import ccall unsafe "LLVMCreatePassManager" createPassManager + :: IO PassManagerRef +foreign import ccall unsafe "&LLVMDisposePassManager" ptrDisposePassManager + :: FunPtr (PassManagerRef -> IO ()) +foreign import ccall unsafe "LLVMDumpModule" dumpModule + :: ModuleRef -> IO () +foreign import ccall unsafe "LLVMFinalizeFunctionPassManager" finalizeFunctionPassManager + :: PassManagerRef -> IO CInt +foreign import ccall unsafe "LLVMGetBasicBlockParent" getBasicBlockParent + :: BasicBlockRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetFirstBasicBlock" getFirstBasicBlock + :: ValueRef -> IO BasicBlockRef +foreign import ccall unsafe "LLVMGetFirstFunction" getFirstFunction + :: ModuleRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetFirstGlobal" getFirstGlobal + :: ModuleRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetFirstInstruction" getFirstInstruction + :: BasicBlockRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetFirstParam" getFirstParam + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetGlobalParent" getGlobalParent + :: ValueRef -> IO ModuleRef +foreign import ccall unsafe "LLVMGetInsertBlock" getInsertBlock + :: BuilderRef -> IO BasicBlockRef +foreign import ccall unsafe "LLVMGetInstructionParent" getInstructionParent + :: ValueRef -> IO BasicBlockRef +foreign import ccall unsafe "LLVMGetLastBasicBlock" getLastBasicBlock + :: ValueRef -> IO BasicBlockRef +foreign import ccall unsafe "LLVMGetLastFunction" getLastFunction + :: ModuleRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetLastGlobal" getLastGlobal + :: ModuleRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetLastInstruction" getLastInstruction + :: BasicBlockRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetLastParam" getLastParam + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetNextBasicBlock" getNextBasicBlock + :: BasicBlockRef -> IO BasicBlockRef +foreign import ccall unsafe "LLVMGetNextFunction" getNextFunction + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetNextGlobal" getNextGlobal + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetNextInstruction" getNextInstruction + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetNextParam" getNextParam + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetParamParent" getParamParent + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetPreviousBasicBlock" getPreviousBasicBlock + :: BasicBlockRef -> IO BasicBlockRef +foreign import ccall unsafe "LLVMGetPreviousFunction" getPreviousFunction + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetPreviousGlobal" getPreviousGlobal + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetPreviousInstruction" getPreviousInstruction + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMGetPreviousParam" getPreviousParam + :: ValueRef -> IO ValueRef +foreign import ccall unsafe "LLVMInitializeFunctionPassManager" initializeFunctionPassManager + :: PassManagerRef -> IO CInt +foreign import ccall unsafe "LLVMLabelType" labelType + :: TypeRef +foreign import ccall unsafe "LLVMOpaqueType" opaqueType + :: TypeRef +foreign import ccall unsafe "LLVMPositionBuilder" positionBuilder + :: BuilderRef -> BasicBlockRef -> ValueRef -> IO () +foreign import ccall unsafe "LLVMRunFunctionPassManager" runFunctionPassManager + :: PassManagerRef -> ValueRef -> IO CInt +foreign import ccall unsafe "LLVMRunPassManager" runPassManager + :: PassManagerRef -> ModuleRef -> IO CInt +foreign import ccall unsafe "LLVMSetInstrParamAlignment" setInstrParamAlignment + :: 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 + :: ValueRef -> CUInt -> CAttribute -> IO () +foreign import ccall unsafe "LLVMIsTailCall" isTailCall + :: 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 -> CInt -> IO () +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 "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 diff --git a/LLVM/FFI/ExecutionEngine.hsc b/LLVM/FFI/ExecutionEngine.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/ExecutionEngine.hsc @@ -0,0 +1,138 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, DeriveDataTypeable #-} + +module LLVM.FFI.ExecutionEngine + ( + -- * Execution engines + ExecutionEngine + , createExecutionEngine + , ptrDisposeExecutionEngine + , createInterpreter + , createJITCompiler + , addModuleProvider + , removeModuleProvider + , findFunction + , freeMachineCodeForFunction + , runStaticConstructors + , runStaticDestructors + , runFunction + , runFunctionAsMain + , getExecutionEngineTargetData + , addGlobalMapping + , getPointerToGlobal + + -- * Generic values + , GenericValue + , GenericValueRef + , createGenericValueOfInt + , genericValueToInt + , genericValueIntWidth + , createGenericValueOfFloat + , genericValueToFloat + , createGenericValueOfPointer + , genericValueToPointer + , ptrDisposeGenericValue + + -- * Linking +-- , linkInInterpreter + , linkInJIT + ) where +import Data.Typeable +import Foreign.C.String (CString) +import Foreign.C.Types (CDouble, CInt, CUInt, CULLong) +import Foreign.Ptr (Ptr, FunPtr) + +import LLVM.FFI.Core (ModuleRef, ModuleProviderRef, TypeRef, ValueRef) +import LLVM.FFI.Target(TargetDataRef) + +data ExecutionEngine + deriving (Typeable) +type ExecutionEngineRef = Ptr ExecutionEngine + +foreign import ccall unsafe "LLVMCreateExecutionEngine" createExecutionEngine + :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString + -> IO CInt + +foreign import ccall unsafe "&LLVMDisposeExecutionEngine" ptrDisposeExecutionEngine + :: FunPtr (ExecutionEngineRef -> IO ()) + +foreign import ccall unsafe "LLVMRunStaticConstructors" runStaticConstructors + :: ExecutionEngineRef -> IO () + +foreign import ccall unsafe "LLVMRunStaticDestructors" runStaticDestructors + :: ExecutionEngineRef -> IO () + + +data GenericValue + deriving (Typeable) +type GenericValueRef = Ptr GenericValue + +foreign import ccall unsafe "LLVMCreateGenericValueOfInt" + createGenericValueOfInt :: TypeRef -> CULLong -> CInt + -> IO GenericValueRef + +foreign import ccall unsafe "LLVMGenericValueToInt" genericValueToInt + :: GenericValueRef -> CInt -> CULLong + +foreign import ccall unsafe "LLVMCreateGenericValueOfFloat" + createGenericValueOfFloat :: TypeRef -> CDouble -> IO GenericValueRef + +foreign import ccall unsafe "LLVMGenericValueToFloat" genericValueToFloat + :: TypeRef -> GenericValueRef -> CDouble + +foreign import ccall unsafe "&LLVMDisposeGenericValue" ptrDisposeGenericValue + :: FunPtr (GenericValueRef -> IO ()) + +{- +safe call is important, since the running LLVM code may call back into Haskell code + +See +http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-130003.3 says: + +"Optionally, an import declaration can specify, +after the calling convention, +the safety level that should be used when invoking an external entity. +..." +-} +foreign import ccall safe "LLVMRunFunction" runFunction + :: ExecutionEngineRef -> ValueRef -> CUInt + -> Ptr GenericValueRef -> IO GenericValueRef + +foreign import ccall unsafe "LLVMAddModuleProvider" addModuleProvider + :: ExecutionEngineRef -> ModuleProviderRef -> IO () +foreign import ccall unsafe "LLVMCreateGenericValueOfPointer" + createGenericValueOfPointer :: Ptr a -> IO GenericValueRef +foreign import ccall unsafe "LLVMCreateInterpreter" createInterpreter + :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString -> IO CInt +foreign import ccall unsafe "LLVMCreateJITCompiler" createJITCompiler + :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString -> IO CInt +foreign import ccall unsafe "LLVMFindFunction" findFunction + :: ExecutionEngineRef -> CString -> Ptr ValueRef -> IO CInt +foreign import ccall unsafe "LLVMFreeMachineCodeForFunction" + freeMachineCodeForFunction :: ExecutionEngineRef -> ValueRef -> IO () +foreign import ccall unsafe "LLVMGenericValueIntWidth" genericValueIntWidth + :: GenericValueRef -> IO CUInt +foreign import ccall unsafe "LLVMGenericValueToPointer" genericValueToPointer + :: GenericValueRef -> IO (Ptr a) +foreign import ccall unsafe "LLVMRemoveModuleProvider" removeModuleProvider + :: ExecutionEngineRef -> ModuleProviderRef -> Ptr ModuleRef -> Ptr CString + -> IO CInt +foreign import ccall safe "LLVMRunFunctionAsMain" runFunctionAsMain + :: ExecutionEngineRef -> ValueRef -> CUInt + -> Ptr CString -- ^ argv + -> Ptr CString -- ^ envp + -> IO CInt + +foreign import ccall unsafe "LLVMGetExecutionEngineTargetData" getExecutionEngineTargetData + :: ExecutionEngineRef -> IO TargetDataRef +foreign import ccall unsafe "LLVMAddGlobalMapping" addGlobalMapping + :: ExecutionEngineRef -> ValueRef -> Ptr () -> IO () + +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 () diff --git a/LLVM/FFI/Target.hsc b/LLVM/FFI/Target.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/Target.hsc @@ -0,0 +1,52 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, DeriveDataTypeable #-} + +module LLVM.FFI.Target where +import Data.Typeable +import Foreign.C.String (CString) +import Foreign.C.Types (CInt, CUInt, CULLong) +import Foreign.Ptr (Ptr) + +import LLVM.FFI.Core + +-- enum { LLVMBigEndian, LLVMLittleEndian }; +type ByteOrdering = CInt + +data TargetData + deriving (Typeable) +type TargetDataRef = Ptr TargetData + +foreign import ccall unsafe "LLVMABIAlignmentOfType" aBIAlignmentOfType + :: TargetDataRef -> TypeRef -> CUInt +foreign import ccall unsafe "LLVMABISizeOfType" aBISizeOfType + :: TargetDataRef -> TypeRef -> CULLong +foreign import ccall unsafe "LLVMAddTargetData" addTargetData + :: TargetDataRef -> PassManagerRef -> IO () +foreign import ccall unsafe "LLVMByteOrder" byteOrder + :: TargetDataRef -> ByteOrdering +foreign import ccall unsafe "LLVMCallFrameAlignmentOfType" callFrameAlignmentOfType + :: TargetDataRef -> TypeRef -> CUInt +foreign import ccall unsafe "LLVMCopyStringRepOfTargetData" copyStringRepOfTargetData + :: TargetDataRef -> IO CString +foreign import ccall unsafe "LLVMCreateTargetData" createTargetData + :: CString -> IO TargetDataRef +foreign import ccall unsafe "LLVMDisposeTargetData" disposeTargetData + :: TargetDataRef -> IO () +foreign import ccall unsafe "LLVMElementAtOffset" elementAtOffset + :: TargetDataRef -> TypeRef -> CULLong -> CUInt +foreign import ccall unsafe "LLVMIntPtrType" intPtrType + :: TargetDataRef -> TypeRef +foreign import ccall unsafe "LLVMInvalidateStructLayout" invalidateStructLayout + :: TargetDataRef -> TypeRef -> IO () +foreign import ccall unsafe "LLVMOffsetOfElement" offsetOfElement + :: TargetDataRef -> TypeRef -> CUInt -> CULLong +foreign import ccall unsafe "LLVMPointerSize" pointerSize + :: TargetDataRef -> CUInt +foreign import ccall unsafe "LLVMPreferredAlignmentOfGlobal" preferredAlignmentOfGlobal + :: TargetDataRef -> ValueRef -> CUInt +foreign import ccall unsafe "LLVMPreferredAlignmentOfType" preferredAlignmentOfType + :: TargetDataRef -> TypeRef -> CUInt +foreign import ccall unsafe "LLVMSizeOfTypeInBits" sizeOfTypeInBits + :: TargetDataRef -> TypeRef -> CULLong +foreign import ccall unsafe "LLVMStoreSizeOfType" storeSizeOfType + :: TargetDataRef -> TypeRef -> CULLong + diff --git a/LLVM/FFI/Transforms/IPO.hsc b/LLVM/FFI/Transforms/IPO.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/Transforms/IPO.hsc @@ -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 () diff --git a/LLVM/FFI/Transforms/Scalar.hsc b/LLVM/FFI/Transforms/Scalar.hsc new file mode 100644 --- /dev/null +++ b/LLVM/FFI/Transforms/Scalar.hsc @@ -0,0 +1,52 @@ +{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} + +module LLVM.FFI.Transforms.Scalar where + +import LLVM.FFI.Core + +foreign import ccall unsafe "LLVMAddCFGSimplificationPass" addCFGSimplificationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddConstantPropagationPass" addConstantPropagationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddDemoteMemoryToRegisterPass" addDemoteMemoryToRegisterPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddGVNPass" addGVNPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddInstructionCombiningPass" addInstructionCombiningPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddPromoteMemoryToRegisterPass" addPromoteMemoryToRegisterPass + :: 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 () diff --git a/LLVM/Target/ARM.hs b/LLVM/Target/ARM.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/ARM.hs @@ -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 () diff --git a/LLVM/Target/Alpha.hs b/LLVM/Target/Alpha.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/Alpha.hs @@ -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 () diff --git a/LLVM/Target/Blackfin.hs b/LLVM/Target/Blackfin.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/Blackfin.hs @@ -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 () diff --git a/LLVM/Target/CBackend.hs b/LLVM/Target/CBackend.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/CBackend.hs @@ -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 () diff --git a/LLVM/Target/CellSPU.hs b/LLVM/Target/CellSPU.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/CellSPU.hs @@ -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 () diff --git a/LLVM/Target/CppBackend.hs b/LLVM/Target/CppBackend.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/CppBackend.hs @@ -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 () diff --git a/LLVM/Target/MSIL.hs b/LLVM/Target/MSIL.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/MSIL.hs @@ -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 () diff --git a/LLVM/Target/MSP430.hs b/LLVM/Target/MSP430.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/MSP430.hs @@ -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 () diff --git a/LLVM/Target/Mips.hs b/LLVM/Target/Mips.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/Mips.hs @@ -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 () diff --git a/LLVM/Target/Native.hs b/LLVM/Target/Native.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/Native.hs @@ -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 diff --git a/LLVM/Target/PIC16.hs b/LLVM/Target/PIC16.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/PIC16.hs @@ -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 () diff --git a/LLVM/Target/PowerPC.hs b/LLVM/Target/PowerPC.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/PowerPC.hs @@ -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 () diff --git a/LLVM/Target/Sparc.hs b/LLVM/Target/Sparc.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/Sparc.hs @@ -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 () diff --git a/LLVM/Target/SystemZ.hs b/LLVM/Target/SystemZ.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/SystemZ.hs @@ -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 () diff --git a/LLVM/Target/X86.hs b/LLVM/Target/X86.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/X86.hs @@ -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 () diff --git a/LLVM/Target/XCore.hs b/LLVM/Target/XCore.hs new file mode 100644 --- /dev/null +++ b/LLVM/Target/XCore.hs @@ -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 () diff --git a/LLVM/Util/Arithmetic.hs b/LLVM/Util/Arithmetic.hs new file mode 100644 --- /dev/null +++ b/LLVM/Util/Arithmetic.hs @@ -0,0 +1,323 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, FlexibleContexts, UndecidableInstances, TypeSynonymInstances, MultiParamTypeClasses, FunctionalDependencies, OverlappingInstances #-} +module LLVM.Util.Arithmetic( + TValue, + Cmp(..), + (%==), (%/=), (%<), (%<=), (%>), (%>=), + (%&&), (%||), + (?), (??), + retrn, set, + ArithFunction, arithFunction, + UnwrapArgs, toArithFunction, + recursiveFunction, + CallIntrinsic, + ) where +#if defined(__MACOS__) +import Data.TypeLevel hiding (Bool, Eq, (+),(-),(*)) +#endif +import Data.Word +import Data.Int +import LLVM.Core +import LLVM.Util.Loop(mapVector, mapVector2) + +-- |Synonym for @CodeGenFunction r (Value a)@. +type TValue r a = CodeGenFunction r (Value a) + +class (CmpRet a b) => Cmp a b | a -> b where + cmp :: IntPredicate -> Value a -> Value a -> TValue r b + +instance Cmp Bool Bool where cmp = icmp +instance Cmp Word8 Bool where cmp = icmp +instance Cmp Word16 Bool where cmp = icmp +instance Cmp Word32 Bool where cmp = icmp +instance Cmp Word64 Bool where cmp = icmp +instance Cmp Int8 Bool where cmp = icmp . adjSigned +instance Cmp Int16 Bool where cmp = icmp . adjSigned +instance Cmp Int32 Bool where cmp = icmp . adjSigned +instance Cmp Int64 Bool where cmp = icmp . adjSigned +instance Cmp Float Bool where cmp = fcmp . adjFloat +instance Cmp Double Bool where cmp = fcmp . adjFloat +instance Cmp FP128 Bool where cmp = fcmp . adjFloat +{- +instance (IsPowerOf2 n) => Cmp (Vector n Bool) (Vector n Bool) where cmp = icmp +instance (IsPowerOf2 n) => Cmp (Vector n Word8) (Vector n Bool) where cmp = icmp +instance (IsPowerOf2 n) => Cmp (Vector n Word16) (Vector n Bool) where cmp = icmp +instance (IsPowerOf2 n) => Cmp (Vector n Word32) (Vector n Bool) where cmp = icmp +instance (IsPowerOf2 n) => Cmp (Vector n Word64) (Vector n Bool) where cmp = icmp +instance (IsPowerOf2 n) => Cmp (Vector n Int8) (Vector n Bool) where cmp = icmp . adjSigned +instance (IsPowerOf2 n) => Cmp (Vector n Int16) (Vector n Bool) where cmp = icmp . adjSigned +instance (IsPowerOf2 n) => Cmp (Vector n Int32) (Vector n Bool) where cmp = icmp . adjSigned +instance (IsPowerOf2 n) => Cmp (Vector n Int64) (Vector n Bool) where cmp = icmp . adjSigned +instance (IsPowerOf2 n) => Cmp (Vector n Float) (Vector n Bool) where cmp = fcmp . adjFloat +instance (IsPowerOf2 n) => Cmp (Vector n Double) (Vector n Bool) where cmp = fcmp . adjFloat +instance (IsPowerOf2 n) => Cmp (Vector n FP128) (Vector n Bool) where cmp = fcmp . adjFloat +-} +instance (IsPowerOf2 n) => Cmp (Vector n Float) (Vector n Bool) where + cmp op = mapVector2 (fcmp (adjFloat op)) +instance (IsPowerOf2 n) => Cmp (Vector n Word32) (Vector n Bool) where + cmp op = mapVector2 (cmp op) + +adjSigned :: IntPredicate -> IntPredicate +adjSigned IntUGT = IntSGT +adjSigned IntUGE = IntSGE +adjSigned IntULT = IntSLT +adjSigned IntULE = IntSLE +adjSigned p = p + +adjFloat :: IntPredicate -> FPPredicate +adjFloat IntEQ = FPOEQ +adjFloat IntNE = FPONE +adjFloat IntUGT = FPOGT +adjFloat IntUGE = FPOGE +adjFloat IntULT = FPOLT +adjFloat IntULE = FPOLE +adjFloat _ = error "adjFloat" + +infix 4 %==, %/=, %<, %<=, %>=, %> +-- |Comparison functions. +(%==), (%/=), (%<), (%<=), (%>), (%>=) :: (Cmp a b) => TValue r a -> TValue r a -> TValue r b +(%==) = binop $ cmp IntEQ +(%/=) = binop $ cmp IntNE +(%>) = binop $ cmp IntUGT +(%>=) = binop $ cmp IntUGE +(%<) = binop $ cmp IntULT +(%<=) = binop $ cmp IntULE + +infixr 3 %&& +infixr 2 %|| +-- |Lazy and. +(%&&) :: TValue r Bool -> TValue r Bool -> TValue r Bool +a %&& b = a ? (b, return (valueOf False)) +-- |Lazy or. +(%||) :: TValue r Bool -> TValue r Bool -> TValue r Bool +a %|| b = a ? (return (valueOf True), b) + +infix 0 ? +-- |Conditional, returns first element of the pair when condition is true, otherwise second. +(?) :: (IsFirstClass a) => TValue r Bool -> (TValue r a, TValue r a) -> TValue r a +c ? (t, f) = do + lt <- newBasicBlock + lf <- newBasicBlock + lj <- newBasicBlock + c' <- c + condBr c' lt lf + defineBasicBlock lt + rt <- t + lt' <- getCurrentBasicBlock + br lj + defineBasicBlock lf + rf <- f + lf' <- getCurrentBasicBlock + br lj + defineBasicBlock lj + phi [(rt, lt'), (rf, lf')] + +infix 0 ?? +(??) :: (IsFirstClass a, CmpRet a b) => TValue r b -> (TValue r a, TValue r a) -> TValue r a +c ?? (t, f) = do + c' <- c + t' <- t + f' <- f + select c' t' f' + +-- | Return a value from an 'arithFunction'. +retrn :: (Ret (Value a) r) => TValue r a -> CodeGenFunction r () +retrn x = x >>= ret + +-- | Use @x <- set $ ...@ to make a binding. +set :: TValue r a -> (CodeGenFunction r (TValue r a)) +set x = do x' <- x; return (return x') + +instance (Show (TValue r a)) +instance (Eq (TValue r a)) +instance (Ord (TValue r a)) + +instance (IsArithmetic a, Cmp a b, Num a, IsConst a) => Num (TValue r a) where + (+) = binop add + (-) = binop sub + (*) = binop mul + negate = (>>= neg) + abs x = x %< 0 ?? (-x, x) + signum x = x %< 0 ?? (-1, x %> 0 ?? (1, 0)) + fromInteger = return . valueOf . fromInteger + +instance (IsArithmetic a, Cmp a b, Num a, IsConst a) => Enum (TValue r a) where + succ x = x + 1 + pred x = x - 1 + fromEnum _ = error "CodeGenFunction Value: fromEnum" + toEnum = fromIntegral + +instance (IsArithmetic a, Cmp a b, Num a, IsConst a) => Real (TValue r a) where + toRational _ = error "CodeGenFunction Value: toRational" + +instance (Cmp a b, Num a, IsConst a, IsInteger a) => Integral (TValue r a) where + quot = binop (if (isSigned (undefined :: a)) then sdiv else udiv) + rem = binop (if (isSigned (undefined :: a)) then srem else urem) + quotRem x y = (quot x y, rem x y) + toInteger _ = error "CodeGenFunction Value: toInteger" + +instance (Cmp a b, Fractional a, IsConst a, IsFloating a) => Fractional (TValue r a) where + (/) = binop fdiv + fromRational = return . valueOf . fromRational + +instance (Cmp a b, Fractional a, IsConst a, IsFloating a) => RealFrac (TValue r a) where + properFraction _ = error "CodeGenFunction Value: properFraction" + +instance (Cmp a b, CallIntrinsic a, Floating a, IsConst a, IsFloating a) => Floating (TValue r a) where + pi = return $ valueOf pi + sqrt = callIntrinsic1 "sqrt" + sin = callIntrinsic1 "sin" + cos = callIntrinsic1 "cos" + (**) = callIntrinsic2 "pow" + exp = callIntrinsic1 "exp" + log = callIntrinsic1 "log" + + asin _ = error "LLVM missing intrinsic: asin" + acos _ = error "LLVM missing intrinsic: acos" + atan _ = error "LLVM missing intrinsic: atan" + + sinh x = (exp x - exp (-x)) / 2 + cosh x = (exp x + exp (-x)) / 2 + asinh x = log (x + sqrt (x*x + 1)) + acosh x = log (x + sqrt (x*x - 1)) + atanh x = (log (1 + x) - log (1 - x)) / 2 + +instance (Cmp a b, CallIntrinsic a, RealFloat a, IsConst a, IsFloating a) => RealFloat (TValue r a) where + floatRadix _ = floatRadix (undefined :: a) + floatDigits _ = floatDigits (undefined :: a) + floatRange _ = floatRange (undefined :: a) + decodeFloat _ = error "CodeGenFunction Value: decodeFloat" + encodeFloat _ _ = error "CodeGenFunction Value: encodeFloat" + exponent _ = 0 + scaleFloat 0 x = x + scaleFloat _ _ = error "CodeGenFunction Value: scaleFloat" + isNaN _ = error "CodeGenFunction Value: isNaN" + isInfinite _ = error "CodeGenFunction Value: isInfinite" + isDenormalized _ = error "CodeGenFunction Value: isDenormalized" + isNegativeZero _ = error "CodeGenFunction Value: isNegativeZero" + isIEEE _ = isIEEE (undefined :: a) + +binop :: (Value a -> Value b -> TValue r c) -> + TValue r a -> TValue r b -> TValue r c +binop op x y = do + x' <- x + y' <- y + op x' y' + +callIntrinsicP1 :: forall a b r . (IsFirstClass a, IsFirstClass b, IsPrimitive a) => + String -> Value a -> TValue r b +callIntrinsicP1 fn x = do + op :: Function (a -> IO b) <- externFunction ("llvm." ++ fn ++ "." ++ typeName (undefined :: a)) + r <- call op x + addAttributes r 0 [ReadNoneAttribute] + return r + +callIntrinsicP2 :: forall a b c r . (IsFirstClass a, IsFirstClass b, IsFirstClass c, IsPrimitive a) => + String -> Value a -> Value b -> TValue r c +callIntrinsicP2 fn x y = do + op :: Function (a -> b -> IO c) <- externFunction ("llvm." ++ fn ++ "." ++ typeName (undefined :: a)) + r <- call op x y + addAttributes r 0 [ReadNoneAttribute] + return r + +------------------------------------------- + +class ArithFunction a b | a -> b, b -> a where + arithFunction' :: a -> b + +instance (Ret a r) => ArithFunction (CodeGenFunction r a) (CodeGenFunction r ()) where + arithFunction' x = x >>= ret + +instance (ArithFunction b b') => ArithFunction (CodeGenFunction r a -> b) (a -> b') where + arithFunction' f = arithFunction' . f . return + +-- |Unlift a function with @TValue@ to have @Value@ arguments. +arithFunction :: ArithFunction a b => a -> b +arithFunction = arithFunction' + +------------------------------------------- + +class UncurryN a b | a -> b, b -> a where + uncurryN :: a -> b + curryN :: b -> a + +instance UncurryN (CodeGenFunction r a) (() -> CodeGenFunction r a) where + uncurryN i = \ () -> i + curryN f = f () + +instance (UncurryN t (b -> c)) => UncurryN (a -> t) ((a, b) -> c) where + uncurryN f = \ (a, b) -> uncurryN (f a) b + curryN f = \ a -> curryN (\ b -> f (a, b)) + +class LiftTuple r a b | a -> b, b -> a where + liftTuple :: a -> CodeGenFunction r b + +instance LiftTuple r () () where + liftTuple = return + +instance (LiftTuple r b b') => LiftTuple r (CodeGenFunction r a, b) (a, b') where + liftTuple (a, b) = do a' <- a; b' <- liftTuple b; return (a', b') + +class (UncurryN a (a1 -> CodeGenFunction r b1), LiftTuple r a1 b, UncurryN a2 (b -> CodeGenFunction r b1)) => + UnwrapArgs a a1 b1 b a2 r | a -> a1 b1, a1 b1 -> a, a1 -> b, b -> a1, a2 -> b b1, b b1 -> a2 where + unwrapArgs :: a2 -> a +instance (UncurryN a (a1 -> CodeGenFunction r b1), LiftTuple r a1 b, UncurryN a2 (b -> CodeGenFunction r b1)) => + UnwrapArgs a a1 b1 b a2 r where + unwrapArgs f = curryN $ \ x -> do x' <- liftTuple x; uncurryN f x' + +-- |Lift a function from having @Value@ arguments to having @TValue@ arguments. +toArithFunction :: (CallArgs f g, UnwrapArgs a a1 b1 b g r) => + Function f -> a +toArithFunction f = unwrapArgs (call f) + +------------------------------------------- + +-- |Define a recursive 'arithFunction', gets pased itself as the first argument. +recursiveFunction :: + (CallArgs a g, + UnwrapArgs a11 a1 b1 b g r, + FunctionArgs a a2 (CodeGenFunction r1 ()), + ArithFunction a3 a2, + IsFunction a) => + (a11 -> a3) -> CodeGenModule (Function a) +recursiveFunction af = do + f <- newFunction ExternalLinkage + let f' = toArithFunction f + defineFunction f $ arithFunction (af f') + return f + +------------------------------------------- + +class CallIntrinsic a where + callIntrinsic1' :: String -> Value a -> TValue r a + callIntrinsic2' :: String -> Value a -> Value a -> TValue r a + +instance CallIntrinsic Float where + callIntrinsic1' = callIntrinsicP1 + callIntrinsic2' = callIntrinsicP2 + +instance CallIntrinsic Double where + callIntrinsic1' = callIntrinsicP1 + callIntrinsic2' = callIntrinsicP2 + +instance (IsPowerOf2 n, IsPrimitive a, CallIntrinsic a) => CallIntrinsic (Vector n a) where + callIntrinsic1' s = mapVector (callIntrinsic1' s) + callIntrinsic2' s = mapVector2 (callIntrinsic2' s) + +callIntrinsic1 :: (CallIntrinsic a) => String -> TValue r a -> TValue r a +callIntrinsic1 s x = do x' <- x; callIntrinsic1' s x' + +callIntrinsic2 :: (CallIntrinsic a) => String -> TValue r a -> TValue r a -> TValue r a +callIntrinsic2 s x y = do x' <- x; y' <- y; callIntrinsic2' s x' y' + +#if defined(__MACOS__) +instance CallIntrinsic (Vector D4 Float) where + callIntrinsic1' s x | hasVFun = do op <- externFunction ("v" ++ s ++ "f") + r <- call op x + addAttributes r 0 [ReadNoneAttribute] + return r + | otherwise = mapVector (callIntrinsic1' s) x + where hasVFun = s `elem` ["sqrt", "log", "exp", "sin", "cos", "tan"] + callIntrinsic2' s = mapVector2 (callIntrinsic2' s) +#endif + diff --git a/LLVM/Util/File.hs b/LLVM/Util/File.hs new file mode 100644 --- /dev/null +++ b/LLVM/Util/File.hs @@ -0,0 +1,48 @@ +module LLVM.Util.File(writeCodeGenModule, optimizeFunction, optimizeFunctionCG) where + +import System.Cmd(system) + +import LLVM.Core +import LLVM.ExecutionEngine + +writeCodeGenModule :: String -> CodeGenModule a -> IO () +writeCodeGenModule name f = do + m <- newModule + defineModule m f + writeBitcodeToFile name m + +optimize :: String -> IO () +optimize name = do + _rc <- system $ "opt -std-compile-opts " ++ name ++ " -f -o " ++ name + return () + +optimizeFunction :: (IsType t, Translatable t) => CodeGenModule (Function t) -> IO (Function t) +optimizeFunction = fmap snd . optimizeFunction' + +optimizeFunction' :: (IsType t, Translatable t) => CodeGenModule (Function t) -> IO (Module, Function t) +optimizeFunction' mdl = do + m <- newModule + mf <- defineModule m mdl + fName <- getValueName mf + + let name = "__tmp__" ++ fName ++ ".bc" + writeBitcodeToFile name m + + optimize name + + m' <- readBitcodeFromFile name + funcs <- getModuleValues m' + +-- removeFile name + + let Just mf' = castModuleValue =<< lookup fName funcs + + return (m', mf') + +optimizeFunctionCG :: (IsType t, Translatable t) => CodeGenModule (Function t) -> IO t +optimizeFunctionCG mdl = do + (m', mf') <- optimizeFunction' mdl + rf <- runEngineAccess $ do + addModule m' + generateFunction mf' + return rf diff --git a/LLVM/Util/Foreign.hs b/LLVM/Util/Foreign.hs new file mode 100644 --- /dev/null +++ b/LLVM/Util/Foreign.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- These are replacements for the broken equivalents in Foreign.*. +-- The functions in Foreign.* do not obey the required alignment. +module LLVM.Util.Foreign where + +import Foreign.Ptr(alignPtr, Ptr) +import Foreign.Storable(Storable(poke, sizeOf, alignment)) +import Foreign.Marshal.Alloc(allocaBytes) +import Foreign.Marshal.Array(allocaArray, pokeArray) + +with :: Storable a => a -> (Ptr a -> IO b) -> IO b +with x act = + alloca $ \ p -> do + poke p x + act p + +alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b +alloca act = + allocaBytes (2 * sizeOf (undefined :: a)) $ \ p -> + act $ alignPtr p (alignment (undefined :: a)) + +withArrayLen :: (Storable a) => [a] -> (Int -> Ptr a -> IO b) -> IO b +withArrayLen xs act = + let l = length xs in + allocaArray (l+1) $ \ p -> do + let p' = alignPtr p (alignment (head xs)) + pokeArray p' xs + act l p' + diff --git a/LLVM/Util/Loop.hs b/LLVM/Util/Loop.hs new file mode 100644 --- /dev/null +++ b/LLVM/Util/Loop.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, TypeOperators, FlexibleContexts #-} +module LLVM.Util.Loop(Phi(phis,addPhis), forLoop, mapVector, mapVector2) where +import Data.TypeLevel hiding (Bool) +import LLVM.Core +import LLVM.Core.CodeGen (Undefined) + +class Undefined a => Phi a where + phis :: BasicBlock -> a -> CodeGenFunction r a + addPhis :: BasicBlock -> a -> a -> CodeGenFunction r () + +{- +infixr 1 :* +-- XXX should use HList if it was packaged in a nice way. +data a :* b = a :* b + deriving (Eq, Ord, Show, Read) + +instance (IsFirstClass a, Phi b) => Phi (Value a :* b) where + phis bb (a :* b) = do + a' <- phi [(a, bb)] + b' <- phis bb b + return (a' :* b') + addPhis bb (a :* b) (a' :* b') = do + addPhiInputs a [(a', bb)] + addPhis bb b b' +-} + +instance Phi () where + phis _ _ = return () + addPhis _ _ _ = return () + +instance (IsFirstClass a) => Phi (Value a) where + phis bb a = do + a' <- phi [(a, bb)] + return a' + addPhis bb a a' = do + addPhiInputs a [(a', bb)] + +instance (Phi a, Phi b) => Phi (a, b) where + phis bb (a, b) = do + a' <- phis bb a + b' <- phis bb b + return (a', b') + addPhis bb (a, b) (a', b') = do + addPhis bb a a' + addPhis bb b b' + +instance (Phi a, Phi b, Phi c) => Phi (a, b, c) where + phis bb (a, b, c) = do + a' <- phis bb a + b' <- phis bb b + c' <- phis bb c + return (a', b', c') + addPhis bb (a, b, c) (a', b', c') = do + addPhis bb a a' + addPhis bb b b' + addPhis bb c c' + +-- Loop the index variable from low to high. The state in the loop starts as start, and is modified +-- by incr in each iteration. +forLoop :: forall i a r . (Phi a, Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) => + Value i -> Value i -> a -> (Value i -> a -> CodeGenFunction r a) -> CodeGenFunction r a +forLoop low high start incr = do + top <- getCurrentBasicBlock + loop <- newBasicBlock + body <- newBasicBlock + exit <- newBasicBlock + + br loop + + defineBasicBlock loop + i <- phi [(low, top)] + vars <- phis top start + t <- icmp IntNE i high + condBr t body exit + + defineBasicBlock body + + vars' <- incr i vars + i' <- add i (valueOf 1 :: Value i) + + body' <- getCurrentBasicBlock + addPhis body' vars vars' + addPhiInputs i [(i', body')] + br loop + defineBasicBlock exit + + return vars + +-------------------------------------- + +mapVector :: forall a b n r . + (IsPowerOf2 n, IsPrimitive b) => + (Value a -> CodeGenFunction r (Value b)) -> + Value (Vector n a) -> CodeGenFunction r (Value (Vector n b)) +mapVector f v = + forLoop (valueOf 0) (valueOf (toNum (undefined :: n))) (value undef) $ \ i w -> do + x <- extractelement v i + y <- f x + insertelement w y i + +mapVector2 :: forall a b c n r . + (IsPowerOf2 n, IsPrimitive c) => + (Value a -> Value b -> CodeGenFunction r (Value c)) -> + Value (Vector n a) -> Value (Vector n b) -> CodeGenFunction r (Value (Vector n c)) +mapVector2 f v1 v2 = + forLoop (valueOf 0) (valueOf (toNum (undefined :: n))) (value undef) $ \ i w -> do + x <- extractelement v1 i + y <- extractelement v2 i + z <- f x y + insertelement w z i diff --git a/LLVM/Util/Optimize.hs b/LLVM/Util/Optimize.hs new file mode 100644 --- /dev/null +++ b/LLVM/Util/Optimize.hs @@ -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 diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,58 @@ +ghc := ghc +ghcflags := -Wall -Werror + +LLVMLIB=/usr/local +llvm_prefix ?= $(LLVMLIB) +prefix ?= $(LLVMLIB) +_lib := $(shell test -d /usr/lib64 && echo lib64 || echo lib) + +ifeq ($(prefix),$(HOME)) +user_flag := --user +endif + +all: build + +.PHONY: build +build: dist/setup-config + ./setup build + +dist/setup-config: setup configure llvm.cabal llvm.buildinfo.in + ./setup configure --prefix=$(prefix) --libdir=$(prefix)/$(_lib) \ + --configure-option --with-llvm-prefix=$(llvm_prefix) $(user_flag) + +setup: Setup.lhs + $(ghc) --make -O -o $@ $< + +configure: configure.ac + autoreconf + +.PHONY: examples +examples: + $(MAKE) -C examples + +.PHONY: tests +tests: + $(MAKE) -C tests + +doc haddock: dist/setup-config + ./setup haddock + +sdist: dist/setup-config + ./setup sdist + +.PHONY: install +install: setup + ./setup install + +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 + -rm *~ + -rm -rf dist + +distclean: clean + -rm -f setup configure diff --git a/PROBLEMS.txt b/PROBLEMS.txt new file mode 100644 --- /dev/null +++ b/PROBLEMS.txt @@ -0,0 +1,20 @@ +Known problems +-------------- + +If you have solutions to any of the problems listed below, please let +me know, or better yet, send a patch. Thanks! + + +Can't use LLVM bindings from ghci +--------------------------------- + +When I try to use the LLVM bindings in ghci, on Linux, loading the +bindings succeeds, but trying to do anything fails: + + $ ghci + Prelude> :m +LLVM.Core + Prelude LLVM.Core> m <- createModule "foo" + can't load .so/.DLL for: stdc++ (libstdc++.so: cannot open shared + object file: No such file or directory) + +I don't know why this happens, but it looks like a ghci bug. diff --git a/README.txt b/README.txt new file mode 100644 --- /dev/null +++ b/README.txt @@ -0,0 +1,47 @@ +Haskell LLVM bindings +--------------------- + +This package provides Haskell bindings for the popular LLVM compiler +infrastructure project. If you don't know what LLVM is, the main LLVM +home page is here: + + http://llvm.org/ + + +Configuration +------------- + +By default, when you run "runghc Setup configure", the Haskell +bindings will be configured to install to /usr/local. The configure +script will look for your LLVM installation in that same directory. + +If you have LLVM installed in a different location, e.g. /usr, you can +tell the configure script where to find it as follows: + + runghc Setup configure --configure-option=--with-llvm-prefix=/usr + + +Package status - what to expect +------------------------------- + +This package is still under development. + +The high level bindings are currently incomplete, so there are some +limits on what you can do. Adding new functions is generally easy, +though, so don't be afraid to get your hands dirty. + +The high level interface is mostly safe, but the type system cannot +protect against everything that can go wrong, so take care. And, of +course, there's no way to guarantee anything about the generated code. + + +Jump in and help! +----------------- + +We welcome your comments and contributions. You can send email to us +at or . If you want to +send patches, please get a copy of the darcs repository: + + darcs get http://darcs.serpentine.com/llvm + +Thanks! diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,28 @@ +#!/usr/bin/env runhaskell +> {-# LANGUAGE PatternGuards #-} +> import System.Environment +> import System.Info +> import Control.Monad +> import Data.List +> import Distribution.Simple +> import Distribution.Simple.Setup +> +> main = do +> let hooks = if os == "mingw32" then autoconfUserHooks{ postConf = generateBuildInfo } +> else autoconfUserHooks +> defaultMainWithHooks hooks +> +> -- On Windows we can't count on the configure script, so generate the +> -- llvm.buildinfo from a template. +> generateBuildInfo _ conf _ _ = do +> let args = configConfigureArgs conf +> let pref = "--with-llvm-prefix=" +> let path = case [ p | arg <- args, Just p <- [stripPrefix pref arg] ] of +> [p] -> p +> _ -> error $ "Use '--configure-option " ++ pref ++ "PATH' to give LLVM installation path" +> info <- readFile "llvm.buildinfo.windows.in" +> writeFile "llvm.buildinfo" $ subst "@llvm_path@" path info +> +> subst from to [] = [] +> subst from to xs | Just r <- stripPrefix from xs = to ++ subst from to r +> subst from to (x:xs) = x : subst from to xs diff --git a/cbits/free.c b/cbits/free.c new file mode 100644 --- /dev/null +++ b/cbits/free.c @@ -0,0 +1,17 @@ +#define __STDC_LIMIT_MACROS +#define __STDC_CONSTANT_MACROS +#include +#include + +/* C function to free function object resources. Can be called from a finalizer. */ +void +c_freeFunctionObject(LLVMExecutionEngineRef execEngine, + LLVMModuleProviderRef moduleProvider, + LLVMValueRef f) +{ + LLVMModuleRef mod; + LLVMFreeMachineCodeForFunction(execEngine, f); + if (!LLVMRemoveModuleProvider(execEngine, moduleProvider, &mod, 0)) { + LLVMDisposeModule(mod); + } +} diff --git a/configure b/configure new file mode 100644 --- /dev/null +++ b/configure @@ -0,0 +1,5199 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.63 for Haskell LLVM bindings 0.4.0.3. +# +# Report bugs to . +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + +# Work around bugs in pre-3.0 UWIN ksh. +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# CDPATH. +$as_unset CDPATH + + +if test "x$CONFIG_SHELL" = x; then + if (eval ":") 2>/dev/null; then + as_have_required=yes +else + as_have_required=no +fi + + if test $as_have_required = yes && (eval ": +(as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=\$LINENO + as_lineno_2=\$LINENO + test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && + test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } +") 2> /dev/null; then + : +else + as_candidate_shells= + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + case $as_dir in + /*) + for as_base in sh bash ksh sh5; do + as_candidate_shells="$as_candidate_shells $as_dir/$as_base" + done;; + esac +done +IFS=$as_save_IFS + + + for as_shell in $as_candidate_shells $SHELL; do + # Try only shells that exist, to save several forks. + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { ("$as_shell") 2> /dev/null <<\_ASEOF +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +_ASEOF +}; then + CONFIG_SHELL=$as_shell + as_have_required=yes + if { "$as_shell" 2> /dev/null <<\_ASEOF +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +(as_func_return () { + (exit $1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = "$1" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test $exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } + +_ASEOF +}; then + break +fi + +fi + + done + + if test "x$CONFIG_SHELL" != x; then + for as_var in BASH_ENV ENV + do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var + done + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} +fi + + + if test $as_have_required = no; then + echo This script requires a shell more modern than all the + echo shells that I found on your system. Please install a + echo modern shell, or manually run the script under such a + echo shell if you do have one. + { (exit 1); exit 1; } +fi + + +fi + +fi + + + +(eval "as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0") || { + echo No shell found that supports shell functions. + echo Please tell bug-autoconf@gnu.org about your system, + echo including any error possibly output before this message. + echo This can help us improve future autoconf versions. + echo Configuration will now proceed without shell functions. +} + + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line after each line using $LINENO; the second 'sed' + # does the real work. The second script uses 'N' to pair each + # line-number line with the line containing $LINENO, and appends + # trailing '-' during substitution so that $LINENO is not a special + # case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # scripts with optimization help from Paolo Bonzini. Blame Lee + # E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in +-n*) + case `echo 'x\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + *) ECHO_C='\c';; + esac;; +*) + ECHO_N='-n';; +esac +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + + +exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Identity of this package. +PACKAGE_NAME='Haskell LLVM bindings' +PACKAGE_TARNAME='llvm' +PACKAGE_VERSION='0.4.0.3' +PACKAGE_STRING='Haskell LLVM bindings 0.4.0.3' +PACKAGE_BUGREPORT='bos@serpentine.com' + +ac_unique_file="LLVM/ExecutionEngine.hs" +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_subst_vars='LTLIBOBJS +LIBOBJS +llvm_ldflags +llvm_includedir +llvm_target +llvm_all_libs +llvm_cppflags +EGREP +GREP +CPP +ac_ct_CC +CFLAGS +CC +llvm_config +OBJEXT +EXEEXT +ac_ct_CXX +CPPFLAGS +LDFLAGS +CXXFLAGS +CXX +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_compiler +with_llvm_prefix +with_llvm_bindir +' + ac_precious_vars='build_alias +host_alias +target_alias +CXX +CXXFLAGS +LDFLAGS +LIBS +CPPFLAGS +CCC +CC +CFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2 + { (exit 1); exit 1; }; } + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2 + { (exit 1); exit 1; }; } + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2 + { (exit 1); exit 1; }; } + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2 + { (exit 1); exit 1; }; } + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) { $as_echo "$as_me: error: unrecognized option: $ac_option +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && + { $as_echo "$as_me: error: invalid variable name: $ac_envvar" >&2 + { (exit 1); exit 1; }; } + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + { $as_echo "$as_me: error: missing argument to $ac_option" >&2 + { (exit 1); exit 1; }; } +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) { $as_echo "$as_me: error: unrecognized options: $ac_unrecognized_opts" >&2 + { (exit 1); exit 1; }; } ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + { $as_echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; } +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + { $as_echo "$as_me: error: working directory cannot be determined" >&2 + { (exit 1); exit 1; }; } +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + { $as_echo "$as_me: error: pwd does not report name of working directory" >&2 + { (exit 1); exit 1; }; } + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + { $as_echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || { $as_echo "$as_me: error: $ac_msg" >&2 + { (exit 1); exit 1; }; } + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures Haskell LLVM bindings 0.4.0.3 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/llvm] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +System types: + --target=TARGET configure for building compilers for TARGET [guessed] +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of Haskell LLVM bindings 0.4.0.3:";; + esac + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-compiler use the given Haskell compiler + --with-llvm-prefix use the version of LLVM at the given location + --with-llvm-bindir use LLVM binaries at the given location + +Some influential environment variables: + CXX C++ compiler command + CXXFLAGS C++ compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CC C compiler command + CFLAGS C compiler flags + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to . +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +Haskell LLVM bindings configure 0.4.0.3 +generated by GNU Autoconf 2.63 + +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by Haskell LLVM bindings $as_me 0.4.0.3, which was +generated by GNU Autoconf 2.63. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" +done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; + 2) + ac_configure_args1="$ac_configure_args1 '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + ac_configure_args="$ac_configure_args '$ac_arg'" + ;; + esac + done +done +$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } +$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) $as_unset $ac_var ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------------- ## +## File substitutions. ## +## ------------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + ac_site_file1=$CONFIG_SITE +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test -r "$ac_site_file"; then + { $as_echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { $as_echo "$as_me:$LINENO: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:$LINENO: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:$LINENO: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:$LINENO: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:$LINENO: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + { { $as_echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 +$as_echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} + { (exit 1); exit 1; }; } +fi + + + + + + + + + + + + + + + + + + + + + + + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + +ac_config_files="$ac_config_files llvm.buildinfo" + + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +if test -z "$CXX"; then + if test -n "$CCC"; then + CXX=$CCC + else + if test -n "$ac_tool_prefix"; then + for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CXX+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$CXX"; then + ac_cv_prog_CXX="$CXX" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CXX="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +fi +fi +CXX=$ac_cv_prog_CXX +if test -n "$CXX"; then + { $as_echo "$as_me:$LINENO: result: $CXX" >&5 +$as_echo "$CXX" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CXX" && break + done +fi +if test -z "$CXX"; then + ac_ct_CXX=$CXX + for ac_prog in g++ c++ gpp aCC CC cxx cc++ cl.exe FCC KCC RCC xlC_r xlC +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CXX"; then + ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_CXX="$ac_prog" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +fi +fi +ac_ct_CXX=$ac_cv_prog_ac_ct_CXX +if test -n "$ac_ct_CXX"; then + { $as_echo "$as_me:$LINENO: result: $ac_ct_CXX" >&5 +$as_echo "$ac_ct_CXX" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CXX" && break +done + + if test "x$ac_ct_CXX" = x; then + CXX="g++" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CXX=$ac_ct_CXX + fi +fi + + fi +fi +# Provide some information about the compiler. +$as_echo "$as_me:$LINENO: checking for C++ compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +{ (ac_try="$ac_compiler --version >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compiler --version >&5") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -v >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compiler -v >&5") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -V >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compiler -V >&5") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:$LINENO: checking for C++ compiler default output file name" >&5 +$as_echo_n "checking for C++ compiler default output file name... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { (ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi + +{ $as_echo "$as_me:$LINENO: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +if test -z "$ac_file"; then + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: C++ compiler cannot create executables +See \`config.log' for more details." >&5 +$as_echo "$as_me: error: C++ compiler cannot create executables +See \`config.log' for more details." >&2;} + { (exit 77); exit 77; }; }; } +fi + +ac_exeext=$ac_cv_exeext + +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:$LINENO: checking whether the C++ compiler works" >&5 +$as_echo_n "checking whether the C++ compiler works... " >&6; } +# FIXME: These cross compiler hacks should be removed for Autoconf 3.0 +# If not cross compiling, check that we can run a simple program. +if test "$cross_compiling" != yes; then + if { ac_try='./$ac_file' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot run C++ compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&5 +$as_echo "$as_me: error: cannot run C++ compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } + fi + fi +fi +{ $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +{ $as_echo "$as_me:$LINENO: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +{ $as_echo "$as_me:$LINENO: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&5 +$as_echo "$as_me: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +fi + +rm -f conftest$ac_cv_exeext +{ $as_echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +{ $as_echo "$as_me:$LINENO: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if test "${ac_cv_objext+set}" = set; then + $as_echo_n "(cached) " >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&5 +$as_echo "$as_me: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +fi + +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:$LINENO: checking whether we are using the GNU C++ compiler" >&5 +$as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; } +if test "${ac_cv_cxx_compiler_gnu+set}" = set; then + $as_echo_n "(cached) " >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_compiler_gnu=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_compiler_gnu=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_cxx_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_cxx_compiler_gnu" >&5 +$as_echo "$ac_cv_cxx_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GXX=yes +else + GXX= +fi +ac_test_CXXFLAGS=${CXXFLAGS+set} +ac_save_CXXFLAGS=$CXXFLAGS +{ $as_echo "$as_me:$LINENO: checking whether $CXX accepts -g" >&5 +$as_echo_n "checking whether $CXX accepts -g... " >&6; } +if test "${ac_cv_prog_cxx_g+set}" = set; then + $as_echo_n "(cached) " >&6 +else + ac_save_cxx_werror_flag=$ac_cxx_werror_flag + ac_cxx_werror_flag=yes + ac_cv_prog_cxx_g=no + CXXFLAGS="-g" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cxx_g=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + CXXFLAGS="" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cxx_werror_flag=$ac_save_cxx_werror_flag + CXXFLAGS="-g" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cxx_g=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cxx_werror_flag=$ac_save_cxx_werror_flag +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cxx_g" >&5 +$as_echo "$ac_cv_prog_cxx_g" >&6; } +if test "$ac_test_CXXFLAGS" = set; then + CXXFLAGS=$ac_save_CXXFLAGS +elif test $ac_cv_prog_cxx_g = yes; then + if test "$GXX" = yes; then + CXXFLAGS="-g -O2" + else + CXXFLAGS="-g" + fi +else + if test "$GXX" = yes; then + CXXFLAGS="-O2" + else + CXXFLAGS= + fi +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +# Check whether --with-compiler was given. +if test "${with_compiler+set}" = set; then + withval=$with_compiler; compiler="$withval" +else + compiler=ghc +fi + + +# Check whether --with-llvm_prefix was given. +if test "${with_llvm_prefix+set}" = set; then + withval=$with_llvm_prefix; llvm_prefix="$withval" +else + llvm_prefix="$prefix" +fi + + +# Check whether --with-llvm_bindir was given. +if test "${with_llvm_bindir+set}" = set; then + withval=$with_llvm_bindir; llvm_bindir="$withval" +else + llvm_bindir="$llvm_prefix/bin" +fi + +# Extract the first word of "llvm-config", so it can be a program name with args. +set dummy llvm-config; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_llvm_config+set}" = set; then + $as_echo_n "(cached) " >&6 +else + case $llvm_config in + [\\/]* | ?:[\\/]*) + ac_cv_path_llvm_config="$llvm_config" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_dummy=""$llvm_bindir:$PATH"" +for as_dir in $as_dummy +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_llvm_config="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + + test -z "$ac_cv_path_llvm_config" && ac_cv_path_llvm_config="{ { $as_echo "$as_me:$LINENO: error: could not find llvm-config in $llvm_bindir" >&5 +$as_echo "$as_me: error: could not find llvm-config in $llvm_bindir" >&2;} + { (exit 1); exit 1; }; }" + ;; +esac +fi +llvm_config=$ac_cv_path_llvm_config +if test -n "$llvm_config"; then + { $as_echo "$as_me:$LINENO: result: $llvm_config" >&5 +$as_echo "$llvm_config" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + + +if test "$target" = "" +then + if test "${compiler}" != "" + then + target=`${compiler} +RTS --info | grep '^ ,("Target platform"' | sed -e 's/.*, "//' -e 's/")//' | tr -d '\r'` + echo "Target platform inferred as: $target" + else + echo "Can't work out target platform" + exit 1 + fi +fi + +case $target in +i386-apple-darwin) + TARGET_CPPFLAGS="-m32" + TAGRET_LDFLAGS="-m32" + ;; +x86_64-apple-darwin) + TARGET_CPPFLAGS="-m64" + TAGRET_LDFLAGS="-m64" + ;; +esac + +llvm_cppflags="`$llvm_config --cppflags`" +llvm_includedir="`$llvm_config --includedir`" +llvm_ldflags="`$llvm_config --ldflags`" + +llvm_all_libs="`$llvm_config --libs all`" +llvm_target="`$llvm_config --libs engine | sed 's/.*LLVM\(.[^ ]*\)CodeGen.*/\1/'`" + +CPPFLAGS="$llvm_cppflags $CPPFLAGS $TARGET_CPPFLAGS" +LDFLAGS="$llvm_ldflags $LDFLAGS $TARGET_LDFLAGS" + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:$LINENO: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&5 +$as_echo "$as_me: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } + +# Provide some information about the compiler. +$as_echo "$as_me:$LINENO: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +{ (ac_try="$ac_compiler --version >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compiler --version >&5") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -v >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compiler -v >&5") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -V >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compiler -V >&5") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + +{ $as_echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if test "${ac_cv_c_compiler_gnu+set}" = set; then + $as_echo_n "(cached) " >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_compiler_gnu=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_compiler_gnu=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if test "${ac_cv_prog_cc_g+set}" = set; then + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_g=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + CFLAGS="" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_g=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if test "${ac_cv_prog_cc_c89+set}" = set; then + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +#include +#include +#include +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_c89=$ac_arg +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:$LINENO: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:$LINENO: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if test "${ac_cv_prog_CPP+set}" = set; then + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + : +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Broken: fails on valid input. +continue +fi + +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + # Broken: success on invalid input. +continue +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Passes both tests. +ac_preproc_ok=: +break +fi + +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:$LINENO: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + : +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Broken: fails on valid input. +continue +fi + +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + # Broken: success on invalid input. +continue +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + # Passes both tests. +ac_preproc_ok=: +break +fi + +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then + : +else + { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { $as_echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&5 +$as_echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if test "${ac_cv_path_GREP+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + ac_count=`expr $ac_count + 1` + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done +done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + { { $as_echo "$as_me:$LINENO: error: no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 +$as_echo "$as_me: error: no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} + { (exit 1); exit 1; }; } + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:$LINENO: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if test "${ac_cv_path_EGREP+set}" = set; then + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + ac_count=`expr $ac_count + 1` + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done +done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + { { $as_echo "$as_me:$LINENO: error: no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 +$as_echo "$as_me: error: no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} + { (exit 1); exit 1; }; } + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:$LINENO: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if test "${ac_cv_header_stdc+set}" = set; then + $as_echo_n "(cached) " >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_header_stdc=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_header_stdc=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then + : +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then + : +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then + : +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + : +else + $as_echo "$as_me: program exited with status $ac_status" >&5 +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +( exit $ac_status ) +ac_cv_header_stdc=no +fi +rm -rf conftest.dSYM +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext +fi + + +fi +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +cat >>confdefs.h <<\_ACEOF +#define STDC_HEADERS 1 +_ACEOF + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. + + + + + + + + + +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } +if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then + $as_echo_n "(cached) " >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default + +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + eval "$as_ac_Header=yes" +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + eval "$as_ac_Header=no" +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + +for ac_header in llvm-c/Core.h +do +as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then + { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } +if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then + $as_echo_n "(cached) " >&6 +fi +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5 +$as_echo_n "checking $ac_header usability... " >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_compile") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_header_compiler=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_compiler=no +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5 +$as_echo_n "checking $ac_header presence... " >&6; } +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <$ac_header> +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then + ac_header_preproc=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi + +rm -f conftest.err conftest.$ac_ext +{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5 +$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;} + { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5 +$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;} + ( cat <<\_ASBOX +## --------------------------------- ## +## Report this to bos@serpentine.com ## +## --------------------------------- ## +_ASBOX + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5 +$as_echo_n "checking for $ac_header... " >&6; } +if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then + $as_echo_n "(cached) " >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +ac_res=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + { $as_echo "$as_me:$LINENO: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + +fi +as_val=`eval 'as_val=${'$as_ac_Header'} + $as_echo "$as_val"'` + if test "x$as_val" = x""yes; then + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +else + { { $as_echo "$as_me:$LINENO: error: could not find LLVM C bindings" >&5 +$as_echo "$as_me: error: could not find LLVM C bindings" >&2;} + { (exit 1); exit 1; }; } +fi + +done + + +LIBS="-lLLVMSupport -lLLVMSystem $LIBS" + +# We have to link using the C++ compiler. +CC=$CXX + + +{ $as_echo "$as_me:$LINENO: checking for LLVMModuleCreateWithName in -lLLVMCore" >&5 +$as_echo_n "checking for LLVMModuleCreateWithName in -lLLVMCore... " >&6; } +if test "${ac_cv_lib_LLVMCore_LLVMModuleCreateWithName+set}" = set; then + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lLLVMCore $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char LLVMModuleCreateWithName (); +int +main () +{ +return LLVMModuleCreateWithName (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\"" +$as_echo "$ac_try_echo") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then + ac_cv_lib_LLVMCore_LLVMModuleCreateWithName=yes +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_cv_lib_LLVMCore_LLVMModuleCreateWithName=no +fi + +rm -rf conftest.dSYM +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_LLVMCore_LLVMModuleCreateWithName" >&5 +$as_echo "$ac_cv_lib_LLVMCore_LLVMModuleCreateWithName" >&6; } +if test "x$ac_cv_lib_LLVMCore_LLVMModuleCreateWithName" = x""yes; then + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBLLVMCORE 1 +_ACEOF + + LIBS="-lLLVMCore $LIBS" + +else + { { $as_echo "$as_me:$LINENO: error: could not find LLVM C bindings" >&5 +$as_echo "$as_me: error: could not find LLVM C bindings" >&2;} + { (exit 1); exit 1; }; } +fi + + + + + + + + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) $as_unset $ac_var ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + test "x$cache_file" != "x/dev/null" && + { $as_echo "$as_me:$LINENO: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + cat confcache >$cache_file + else + { $as_echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: ${CONFIG_STATUS=./config.status} +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +cat >$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false +SHELL=\${CONFIG_SHELL-$SHELL} +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +## --------------------- ## +## M4sh Initialization. ## +## --------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break +done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + +# Work around bugs in pre-3.0 UWIN ksh. +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + + +# Name of the executable. +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# CDPATH. +$as_unset CDPATH + + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { + + # Create $as_me.lineno as a copy of $as_myself, but with $LINENO + # uniformly replaced by the line number. The first 'sed' inserts a + # line-number line after each line using $LINENO; the second 'sed' + # does the real work. The second script uses 'N' to pair each + # line-number line with the line containing $LINENO, and appends + # trailing '-' during substitution so that $LINENO is not a special + # case at line end. + # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the + # scripts with optimization help from Paolo Bonzini. Blame Lee + # E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 + { (exit 1); exit 1; }; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in +-n*) + case `echo 'x\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + *) ECHO_C='\c';; + esac;; +*) + ECHO_N='-n';; +esac +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 + +# Save the log message, to keep $[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by Haskell LLVM bindings $as_me 0.4.0.3, which was +generated by GNU Autoconf 2.63. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files from templates according to the +current configuration. + +Usage: $0 [OPTION]... [FILE]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_version="\\ +Haskell LLVM bindings config.status 0.4.0.3 +configured by $0, generated by GNU Autoconf 2.63, + with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2008 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + CONFIG_FILES="$CONFIG_FILES '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { $as_echo "$as_me: error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } ;; + + *) ac_config_targets="$ac_config_targets $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "llvm.buildinfo") CONFIG_FILES="$CONFIG_FILES llvm.buildinfo" ;; + + *) { { $as_echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 +$as_echo "$as_me: error: invalid argument: $ac_config_target" >&2;} + { (exit 1); exit 1; }; };; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= + trap 'exit_status=$? + { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status +' 0 + trap '{ (exit 1); exit 1; }' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || +{ + $as_echo "$as_me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=' ' +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } +ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\).*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\).*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ + || { { $as_echo "$as_me:$LINENO: error: could not setup config files machinery" >&5 +$as_echo "$as_me: error: could not setup config files machinery" >&2;} + { (exit 1); exit 1; }; } +_ACEOF + +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/ +s/:*\${srcdir}:*/:/ +s/:*@srcdir@:*/:/ +s/^\([^=]*=[ ]*\):*/\1/ +s/:*$// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) { { $as_echo "$as_me:$LINENO: error: invalid tag $ac_tag" >&5 +$as_echo "$as_me: error: invalid tag $ac_tag" >&2;} + { (exit 1); exit 1; }; };; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + { { $as_echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 +$as_echo "$as_me: error: cannot find input file: $ac_f" >&2;} + { (exit 1); exit 1; }; };; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + ac_file_inputs="$ac_file_inputs '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:$LINENO: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$tmp/stdin" \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + { as_dir="$ac_dir" + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || { { $as_echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 +$as_echo "$as_me: error: cannot create directory $as_dir" >&2;} + { (exit 1); exit 1; }; }; } + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= + +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p +' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&2;} + + rm -f "$tmp/stdin" + case $ac_file in + -) cat "$tmp/out" && rm -f "$tmp/out";; + *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; + esac \ + || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 +$as_echo "$as_me: error: could not create $ac_file" >&2;} + { (exit 1); exit 1; }; } + ;; + + + + esac + +done # for ac_tag + + +{ (exit 0); exit 0; } +_ACEOF +chmod +x $CONFIG_STATUS +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + { { $as_echo "$as_me:$LINENO: error: write failure creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: error: write failure creating $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || { (exit 1); exit 1; } +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:$LINENO: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + diff --git a/configure.ac b/configure.ac new file mode 100644 --- /dev/null +++ b/configure.ac @@ -0,0 +1,98 @@ +AC_INIT([Haskell LLVM bindings], [0.4.0.3], [bos@serpentine.com], [llvm]) + +AC_CONFIG_SRCDIR([LLVM/ExecutionEngine.hs]) + +AC_CONFIG_FILES([llvm.buildinfo]) + +AC_PROG_CXX + +AC_ARG_WITH(compiler, + [AS_HELP_STRING([--with-compiler], + [use the given Haskell compiler])], + compiler="$withval", + compiler=ghc)dnl + +AC_ARG_WITH(llvm_prefix, + [AS_HELP_STRING([--with-llvm-prefix], + [use the version of LLVM at the given location])], + llvm_prefix="$withval", + llvm_prefix="$prefix")dnl + +AC_ARG_WITH(llvm_bindir, + [AS_HELP_STRING([--with-llvm-bindir], + [use LLVM binaries at the given location])], + llvm_bindir="$withval", + llvm_bindir="$llvm_prefix/bin")dnl + +AC_PATH_PROG(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 +dnl ask GHC what platform it is for. Why? We need to generate a library +dnl matching the compiler. +dnl NB: This code is from GHC's configure (where the corresponding code for +dnl guessing host and build variables can be found, too) + +dnl Guess target platform if necessary. +m4_divert_once([HELP_CANON], +[[ +System types: + --target=TARGET configure for building compilers for TARGET [guessed]]])dnl + +if test "$target" = "" +then + if test "${compiler}" != "" + then + target=`${compiler} +RTS --info | grep '^ ,("Target platform"' | sed -e 's/.*, "//' -e 's/")//' | tr -d '\r'` + echo "Target platform inferred as: $target" + else + echo "Can't work out target platform" + exit 1 + fi +fi + +dnl Determine target-specific options +dnl This is important as Snow Leopard (Mac OS X 10.6) defaults to generating +dnl 64-bit code. +case $target in +i386-apple-darwin) + TARGET_CPPFLAGS="-m32" + TAGRET_LDFLAGS="-m32" + ;; +x86_64-apple-darwin) + TARGET_CPPFLAGS="-m64" + TAGRET_LDFLAGS="-m64" + ;; +esac + +llvm_cppflags="`$llvm_config --cppflags`" +llvm_includedir="`$llvm_config --includedir`" +llvm_ldflags="`$llvm_config --ldflags`" + +llvm_all_libs="`$llvm_config --libs all`" +llvm_target="`$llvm_config --libs engine | sed 's/.*LLVM\(.[[^ ]]*\)CodeGen.*/\1/'`" + +CPPFLAGS="$llvm_cppflags $CPPFLAGS $TARGET_CPPFLAGS" +LDFLAGS="$llvm_ldflags $LDFLAGS $TARGET_LDFLAGS" + +AC_CHECK_HEADERS([llvm-c/Core.h], [], + [AC_MSG_ERROR(could not find LLVM C bindings)]) + +LIBS="-lLLVMSupport -lLLVMSystem $LIBS" + +# We have to link using the C++ compiler. +CC=$CXX + +AC_CHECK_LIB(LLVMCore, LLVMModuleCreateWithName, [], + [AC_MSG_ERROR(could not find LLVM C bindings)]) + +AC_SUBST([llvm_cppflags]) +AC_SUBST([llvm_all_libs]) +AC_SUBST([llvm_target]) +AC_SUBST([llvm_includedir]) +AC_SUBST([llvm_ldflags]) + +AC_OUTPUT diff --git a/examples/Align.hs b/examples/Align.hs new file mode 100644 --- /dev/null +++ b/examples/Align.hs @@ -0,0 +1,21 @@ +module Align (main) where +import Data.TypeLevel(D1, D2, D4) +import Data.Word + +import LLVM.Core +import LLVM.ExecutionEngine + +main :: IO () +main = do + -- Initialize jitter + initializeNativeTarget + + td <- getTargetData + print (littleEndian td, + aBIAlignmentOfType td $ typeRef (undefined :: Word32), + aBIAlignmentOfType td $ typeRef (undefined :: Word64), + aBIAlignmentOfType td $ typeRef (undefined :: Vector D4 Float), + aBIAlignmentOfType td $ typeRef (undefined :: Vector D1 Double), + storeSizeOfType td $ typeRef (undefined :: Vector D4 Float), + intPtrType td + ) diff --git a/examples/Arith.hs b/examples/Arith.hs new file mode 100644 --- /dev/null +++ b/examples/Arith.hs @@ -0,0 +1,86 @@ +{-# OPTIONS_GHC -fno-warn-type-defaults #-} +{-# LANGUAGE ScopedTypeVariables, PatternSignatures #-} +module Arith where +import Data.Int +import Data.TypeLevel(D4) +import LLVM.Core +import LLVM.ExecutionEngine +import LLVM.Util.Arithmetic +import LLVM.Util.Foreign as F +import LLVM.Util.File(writeCodeGenModule) + +import Foreign.Storable +{- +import Foreign.Ptr +import Foreign.Marshal.Utils +import Foreign.Marshal.Alloc as F +-} + +mSomeFn :: forall a b . (IsConst a, Floating a, IsFloating a, CallIntrinsic a, + FunctionRet a, Cmp a b + ) => CodeGenModule (Function (a -> IO a)) +mSomeFn = do + foo <- createFunction InternalLinkage $ arithFunction $ \ x y -> exp (sin x) + y + let foo' = toArithFunction foo + createFunction ExternalLinkage $ arithFunction $ \ x -> do + y <- set $ x^3 + sqrt (x^2 - 5 * x + 6) + foo' x x + y + log y + +mFib :: CodeGenModule (Function (Int32 -> IO Int32)) +mFib = recursiveFunction $ \ rfib n -> n %< 2 ? (1, rfib (n-1) + rfib (n-2)) + +type V = Vector D4 Float + +mVFun :: CodeGenModule (Function (Ptr V -> Ptr V -> IO ())) +mVFun = do + fn :: Function (V -> IO V) + <- createFunction ExternalLinkage $ arithFunction $ \ x -> + log x * exp x * x - 16 + + vectorToPtr fn + + +main :: IO () +main = do + -- Initialize jitter + initializeNativeTarget + + let mSomeFn' = mSomeFn + ioSomeFn <- simpleFunction mSomeFn' + let someFn :: Double -> Double + someFn = unsafePurify ioSomeFn + + writeCodeGenModule "Arith.bc" mSomeFn' + + print (someFn 10) + print (someFn 2) + + writeCodeGenModule "ArithFib.bc" mFib + + fib <- simpleFunction mFib + fib 22 >>= print + +{- + writeCodeGenModule "VArith.bc" mVFun + + ioVFun <- simpleFunction mVFun + let v = toVector (1,2,3,4) + + r <- vectorPtrWrap ioVFun v + print r +-} + +vectorToPtr :: Function (V -> IO V) -> CodeGenModule (Function (Ptr V -> Ptr V -> IO ())) +vectorToPtr f = + createFunction ExternalLinkage $ \ px py -> do + x <- load px + y <- call f x + store y py + ret () + +vectorPtrWrap :: (Ptr V -> Ptr V -> IO ()) -> V -> IO V +vectorPtrWrap f v = + with v $ \ aPtr -> + F.alloca $ \ bPtr -> do + f aPtr bPtr + peek bPtr diff --git a/examples/Array.hs b/examples/Array.hs new file mode 100644 --- /dev/null +++ b/examples/Array.hs @@ -0,0 +1,62 @@ +module Array where +import Data.Word + +import LLVM.Core +--import LLVM.ExecutionEngine +import LLVM.Util.Loop +import LLVM.Util.Optimize + +cg :: CodeGenModule (Function (Double -> IO (Ptr Double))) +cg = do + dotProd <- createFunction InternalLinkage $ \ size aPtr aStride bPtr bStride -> do + r <- forLoop (valueOf 0) size (valueOf 0) $ \ i s -> do + ai <- mul aStride i + bi <- mul bStride i + ap <- getElementPtr aPtr (ai, ()) + bp <- getElementPtr bPtr (bi, ()) + a <- load ap + b <- load bp + ab <- mul a b + add (s :: Value Double) ab + ret r + let _ = dotProd :: Function (Word32 -> Ptr Double -> Word32 -> Ptr Double -> Word32 -> IO Double) + + -- multiply a:[n x m], b:[m x l] + matMul <- createFunction InternalLinkage $ \ n m l aPtr bPtr cPtr -> do + forLoop (valueOf 0) n () $ \ ni () -> do + forLoop (valueOf 0) l () $ \ li () -> do + ni' <- mul ni m + row <- getElementPtr aPtr (ni', ()) + col <- getElementPtr bPtr (li, ()) + x <- call dotProd m row (valueOf 1) col m + j <- add ni' li + p <- getElementPtr cPtr (j, ()) + store x p + return () + ret () + let _ = matMul :: Function (Word32 -> Word32 -> Word32 -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()) + + let fillArray _ [] = return () + fillArray ptr (x:xs) = do store x ptr; ptr' <- getElementPtr ptr (1::Word32,()); fillArray ptr' xs + + test <- createNamedFunction ExternalLinkage "test" $ \ x -> do + a <- arrayMalloc (4 :: Word32) + fillArray a $ map valueOf [1,2,3,4] + b <- arrayMalloc (4 :: Word32) + fillArray b [x,x,x,x] + c <- arrayMalloc (4 :: Word32) + call matMul (valueOf 2) (valueOf 2) (valueOf 2) a b c + ret c + let _ = test :: Function (Double -> IO (Ptr Double)) + + return test + +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 diff --git a/examples/BrainF.hs b/examples/BrainF.hs new file mode 100644 --- /dev/null +++ b/examples/BrainF.hs @@ -0,0 +1,146 @@ +module BrainF where +-- BrainF compiler example +-- +-- The BrainF language has 8 commands: +-- Command Equivalent C Action +-- ------- ------------ ------ +-- , *h=getchar(); Read a character from stdin, 255 on EOF +-- . putchar(*h); Write a character to stdout +-- - --*h; Decrement tape +-- + ++*h; Increment tape +-- < --h; Move head left +-- > ++h; Move head right +-- [ while(*h) { Start loop +-- ] } End loop +-- +import Control.Monad(when) +import Data.Word +import Data.Int +import System.Environment(getArgs) + +import LLVM.Core +import LLVM.Util.File(writeCodeGenModule) +import LLVM.ExecutionEngine + +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 + ">++++" ++ -- next cell, loop counter, constant 4 + "[>++++++++++" ++ -- loop, loop counter, constant 10 + "[" ++ -- loop + "<<.+>>-" ++ -- back to 33, print, increment, forward, decrement loop counter + "]<-" ++ -- back to 4, decrement loop counter + "]" ++ + "++++++++++." + prog <- if length args == 1 then readFile (head args) else return text + + when (debug) $ + writeCodeGenModule "BrainF.bc" $ brainCompile debug prog 65536 + + bfprog <- simpleFunction $ brainCompile debug prog 65536 + when (prog == text) $ + putStrLn "Should print '!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGH' on the next line:" + bfprog + +brainCompile :: Bool -> String -> Word32 -> CodeGenModule (Function (IO ())) +brainCompile _debug instrs wmemtotal = do + -- LLVM functions + memset <- newNamedFunction ExternalLinkage "llvm.memset.i32" + :: TFunction (Ptr Word8 -> Word8 -> Word32 -> Word32 -> IO ()) + getchar <- newNamedFunction ExternalLinkage "getchar" + :: TFunction (IO Int32) + putchar <- newNamedFunction ExternalLinkage "putchar" + :: TFunction (Int32 -> IO Int32) + + -- Generate code, first argument is the list of commands, + -- second argument is a stack of loop contexts, and the + -- third argument is the current register for the head and + -- the current basic block. + -- A loop context is a triple of the phi node, the loop top label, + -- and the loop exit label. + let generate [] [] _ = + return () + generate [] (_:_) _ = error "Missing ]" + generate (']':_) [] _ = error "Missing [" + generate (']':is) ((cphi, loop, exit) : bs) (cur, bb) = do + -- The loop has terminated, add the phi node at the top, + -- branch to the top, and set up the exit label. + addPhiInputs cphi [(cur, bb)] + br loop + defineBasicBlock exit + generate is bs (cphi, exit) + + generate ('[':is) bs curbb = do + -- Start a new loop. + loop <- newBasicBlock -- loop top + body <- newBasicBlock -- body of the loop + exit <- newBasicBlock -- loop exit label + br loop + + defineBasicBlock loop + cur <- phi [curbb] -- will get one more input from the loop terminator. + val <- load cur -- load head byte. + eqz <- icmp IntEQ val (0::Word8) -- test if it is 0. + condBr eqz exit body -- and branch accordingly. + + defineBasicBlock body + generate is ((cur, loop, exit) : bs) (cur, body) + + generate (i:is) bs (curhead, bb) = do + -- A simple command, with no new basic blocks. + -- Just update which register the head is in. + curhead' <- gen curhead i + generate is bs (curhead', bb) + + gen cur ',' = do + -- Read a character. + char32 <- call getchar + char8 <- trunc char32 + store char8 cur + return cur + gen cur '.' = do + -- Write a character. + char8 <- load cur + char32 <- zext char8 + call putchar char32 + return cur + gen cur '-' = do + -- Decrement byte at head. + val <- load cur + val' <- sub val (1 :: Word8) + store val' cur + return cur + gen cur '+' = do + -- Increment byte at head. + val <- load cur + val' <- add val (1 :: Word8) + store val' cur + return cur + gen cur '<' = + -- Decrement head. + getElementPtr cur ((-1) :: Word32, ()) + gen cur '>' = + -- Increment head. + getElementPtr cur (1 :: Word32, ()) + gen _ c = error $ "Bad character in program: " ++ show c + + + brainf <- createFunction ExternalLinkage $ do + ptr_arr <- arrayMalloc wmemtotal + call memset ptr_arr (valueOf 0) (valueOf wmemtotal) (valueOf 0) +-- _ptr_arrmax <- getElementPtr ptr_arr (wmemtotal, ()) + -- Start head in the middle. + curhead <- getElementPtr ptr_arr (wmemtotal `div` 2, ()) + + bb <- getCurrentBasicBlock + generate instrs [] (curhead, bb) + + free ptr_arr + ret () + + return brainf diff --git a/examples/Convert.hs b/examples/Convert.hs new file mode 100644 --- /dev/null +++ b/examples/Convert.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE ForeignFunctionInterface, FlexibleInstances #-} +module Convert(Convert(..)) where +import Data.Int +import Data.Word +import Foreign.Ptr (FunPtr) + +type Importer f = FunPtr f -> f + +class Convert f where + convert :: Importer f + +foreign import ccall safe "dynamic" c_IOFloat :: Importer (IO Float) +instance Convert (IO Float) where convert = c_IOFloat + +foreign import ccall safe "dynamic" c_Float_IOFloat :: Importer (Float -> IO Float) +instance Convert (Float -> IO Float) where convert = c_Float_IOFloat + +foreign import ccall safe "dynamic" c_Float_Float :: Importer (Float -> Float) +instance Convert (Float -> Float) where convert = c_Float_Float + +foreign import ccall safe "dynamic" c_IODouble :: Importer (IO Double) +instance Convert (IO Double) where convert = c_IODouble + +foreign import ccall safe "dynamic" c_Double_IODouble :: Importer (Double -> IO Double) +instance Convert (Double -> IO Double) where convert = c_Double_IODouble + +foreign import ccall safe "dynamic" c_Double_Double :: Importer (Double -> Double) +instance Convert (Double -> Double) where convert = c_Double_Double + +foreign import ccall safe "dynamic" c_Word32_IOWord32 :: Importer (Word32 -> IO Word32) +instance Convert (Word32 -> IO Word32) where convert = c_Word32_IOWord32 + +foreign import ccall safe "dynamic" c_Word32_Word32 :: Importer (Word32 -> Word32) +instance Convert (Word32 -> Word32) where convert = c_Word32_Word32 + +foreign import ccall safe "dynamic" c_Int32_IOInt32 :: Importer (Int32 -> IO Int32) +instance Convert (Int32 -> IO Int32) where convert = c_Int32_IOInt32 + +foreign import ccall safe "dynamic" c_Int32_Int32 :: Importer (Int32 -> Int32) +instance Convert (Int32 -> Int32) where convert = c_Int32_Int32 + diff --git a/examples/DotProd.hs b/examples/DotProd.hs new file mode 100644 --- /dev/null +++ b/examples/DotProd.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} +module DotProd where +import Data.Word +import Data.TypeLevel.Num(D2, D4, D8, toNum) +import LLVM.Core +import LLVM.ExecutionEngine +import LLVM.Util.Loop +import LLVM.Util.File(writeCodeGenModule) +import LLVM.Util.Foreign + +mDotProd :: forall n a . (IsPowerOf2 n, + IsPrimitive a, IsArithmetic a, IsFirstClass a, IsConst a, Num a, + FunctionRet a + ) => + CodeGenModule (Function (Word32 -> Ptr (Vector n a) -> Ptr (Vector n a) -> IO a)) +mDotProd = + createFunction ExternalLinkage $ \ size aPtr bPtr -> do + s <- forLoop (valueOf 0) size (value (zero :: ConstValue (Vector n a))) $ \ i s -> do + + ap <- getElementPtr aPtr (i, ()) -- index into aPtr + bp <- getElementPtr bPtr (i, ()) -- index into bPtr + a <- load ap -- load element from a vector + b <- load bp -- load element from b vector + ab <- mul a b -- multiply them + add s ab -- accumulate sum + + r <- forLoop (valueOf (0::Word32)) (valueOf (toNum (undefined :: n))) + (valueOf 0) $ \ i r -> do + ri <- extractelement s i + add r ri + ret (r :: Value a) + +type R = Float +type T = Vector D4 R + +main :: IO () +main = do + -- Initialize jitter + initializeNativeTarget + let mDotProd' = mDotProd + writeCodeGenModule "DotProd.bc" mDotProd' + + ioDotProd <- simpleFunction mDotProd' + let dotProd :: [T] -> [T] -> R + dotProd a b = + unsafePurify $ + withArrayLen a $ \ aLen aPtr -> + withArrayLen b $ \ bLen bPtr -> + ioDotProd (fromIntegral (aLen `min` bLen)) aPtr bPtr + + + let a = [1 .. 8] + b = [4 .. 11] + print $ dotProd (vectorize 0 a) (vectorize 0 b) + print $ sum $ zipWith (*) a b + +class Vectorize n a where + vectorize :: a -> [a] -> [Vector n a] + +{- +instance (IsPrimitive a) => Vectorize D1 a where + vectorize _ [] = [] + vectorize x (x1:xs) = toVector x1 : vectorize x xs +-} + +instance (IsPrimitive a) => Vectorize D2 a where + vectorize _ [] = [] + vectorize x (x1:x2:xs) = toVector (x1, x2) : vectorize x xs + vectorize x xs = vectorize x $ xs ++ [x] + +instance (IsPrimitive a) => Vectorize D4 a where + vectorize _ [] = [] + vectorize x (x1:x2:x3:x4:xs) = toVector (x1, x2, x3, x4) : vectorize x xs + vectorize x xs = vectorize x $ xs ++ [x] + +instance (IsPrimitive a) => Vectorize D8 a where + vectorize _ [] = [] + vectorize x (x1:x2:x3:x4:x5:x6:x7:x8:xs) = toVector (x1, x2, x3, x4, x5, x6, x7, x8) : vectorize x xs + vectorize x xs = vectorize x $ xs ++ [x] diff --git a/examples/Fibonacci.hs b/examples/Fibonacci.hs new file mode 100644 --- /dev/null +++ b/examples/Fibonacci.hs @@ -0,0 +1,106 @@ +module Fibonacci where +import Prelude hiding(and, or) +import System.Environment(getArgs) +import Control.Monad(forM_) +import Data.Word + +import LLVM.Core +import LLVM.Util.Optimize +import LLVM.ExecutionEngine + +-- Our module will have these two functions. +data Mod = Mod { + mfib :: Function (Word32 -> IO Word32), + mplus :: Function (Word32 -> Word32 -> IO Word32) + } + +main :: IO () +main = do + args <- getArgs + let args' = if null args then ["10"] else args + + -- Initialize jitter + initializeNativeTarget + -- Create a module, + m <- newNamedModule "fib" + -- and define its contents. + fns <- defineModule m buildMod + + -- Show the code for the two functions, just for fun. + --dumpValue $ mfib fns + --dumpValue $ mplus fns + -- 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. + iofib <- runEngineAccess $ do + addModule m + generateFunction $ mfib fns + let fib = unsafePurify iofib + + -- Run fib for the arguments. + forM_ args' $ \num -> do + putStrLn $ "fib " ++ num ++ " = " ++ show (fib (read num)) + return () + +buildMod :: CodeGenModule Mod +buildMod = do + -- Add two numbers in a cumbersome way. + plus <- createFunction InternalLinkage $ \ x y -> do + -- Create three additional basic blocks, need to be created before being referred to. + l1 <- newBasicBlock + l2 <- newBasicBlock + l3 <- newBasicBlock + + -- Test if x is even/odd. + a <- and x (1 :: Word32) + c <- icmp IntEQ a (0 :: Word32) + condBr c l1 l2 + + -- Do x+y if even. + defineBasicBlock l1 + r1 <- add x y + br l3 + + -- Do y+x if odd. + defineBasicBlock l2 + r2 <- add y x + br l3 + + defineBasicBlock l3 + -- Join the two execution paths with a phi instruction. + r <- phi [(r1, l1), (r2, l2)] + ret r + + -- The usual doubly recursive Fibonacci. + -- Use new&define so the name fib is defined in the body for recursive calls. + fib <- newNamedFunction ExternalLinkage "fib" + defineFunction fib $ \ arg -> do + -- Create the two basic blocks. + recurse <- newBasicBlock + exit <- newBasicBlock + + -- Test if arg > 2 + test <- icmp IntUGT arg (2::Word32) + condBr test recurse exit + + -- Just return 1 if not > 2 + defineBasicBlock exit + ret (1::Word32) + + -- Recurse if > 2, using the cumbersome plus to add the results. + defineBasicBlock recurse + x1 <- sub arg (1::Word32) + fibx1 <- call fib x1 + x2 <- sub arg (2::Word32) + fibx2 <- call fib x2 + r <- call plus fibx1 fibx2 + ret r + + -- Return the two functions. + return $ Mod fib plus diff --git a/examples/HelloJIT.hs b/examples/HelloJIT.hs new file mode 100644 --- /dev/null +++ b/examples/HelloJIT.hs @@ -0,0 +1,25 @@ +module HelloJIT (main) where + +import Data.Word + +import LLVM.Core +import LLVM.ExecutionEngine + +bldGreet :: CodeGenModule (Function (IO ())) +bldGreet = do + puts <- newNamedFunction ExternalLinkage "puts" :: TFunction (Ptr Word8 -> IO Word32) + greetz <- createStringNul "Hello, JIT!" + func <- createFunction ExternalLinkage $ do + tmp <- getElementPtr0 greetz (0::Word32, ()) + call puts tmp -- Throw away return value. + ret () + return func + +main :: IO () +main = do + initializeNativeTarget + greet <- simpleFunction bldGreet + greet + greet + greet + return () diff --git a/examples/Makefile b/examples/Makefile new file mode 100644 --- /dev/null +++ b/examples/Makefile @@ -0,0 +1,32 @@ +ghc := ghc +ghcflags := -Wall -optl -w +# -DHAS_GETPOINTERTOGLOBAL=1 +examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align Struct Varargs List Tuple + +all: $(examples:%=%.exe) + +Vector: Convert.hs + +%.exe: %.hs + $(ghc) $(ghcflags) --make -o $(basename $<).exe -main-is $(basename $<).main $< + +Struct.exe: Struct.hs structCheck.c + $(ghc) $(ghcflags) --make -o Struct.exe -main-is Struct.main Struct.hs structCheck.c + +%.run: %.exe + ./$< + +run: $(examples:%=%.run) + +N=40 +fastfib: Fibonacci + @rm -f Fib.bc Fib.s + time ./Fibonacci $(N) + opt -std-compile-opts Fibonacci.bc -o Fib.bc + llc Fib.bc + $(CC) mainfib.c Fib.s -o Fib + time ./Fib $(N) + @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 *~ diff --git a/examples/Struct.hs b/examples/Struct.hs new file mode 100644 --- /dev/null +++ b/examples/Struct.hs @@ -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 () diff --git a/examples/Varargs.hs b/examples/Varargs.hs new file mode 100644 --- /dev/null +++ b/examples/Varargs.hs @@ -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 () diff --git a/examples/Vector.hs b/examples/Vector.hs new file mode 100644 --- /dev/null +++ b/examples/Vector.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE TypeOperators #-} +module Vector where +import System.Cmd(system) +import Control.Monad +import Data.TypeLevel.Num(D16, toNum) +import Data.Word + +import LLVM.Core +import LLVM.ExecutionEngine +import LLVM.Util.Loop + +import Convert + +-- Type of vector elements. +type T = Float + +-- Number of vector elements. +type N = D16 + +cgvec :: CodeGenModule (Function (T -> IO T)) +cgvec = do + -- A global variable that vectest messes with. + acc <- createNamedGlobal False ExternalLinkage "acc" (constOf (0 :: T)) + + -- Return the global variable. + retAcc <- createNamedFunction ExternalLinkage "retacc" $ do + vacc <- load acc + ret vacc + let _ = retAcc :: Function (IO T) -- Force the type of retAcc. + + -- A function that tests vector opreations. + f <- createNamedFunction ExternalLinkage "vectest" $ \ x -> do + + let v = value (zero :: ConstValue (Vector N T)) + n = toNum (undefined :: N) :: Word32 + + -- Fill the vector with x, x+1, x+2, ... + (_, v1) <- forLoop (valueOf 0) (valueOf n) (x, v) $ \ i (x1, v1) -> do + x1' <- add x1 (1::T) + v1' <- insertelement v1 x1 i + return (x1', v1') + + -- Elementwise cubing of the vector. + vsq <- mul v1 v1 + vcb <- mul vsq v1 + + -- Sum the elements of the vector. + s <- forLoop (valueOf 0) (valueOf n) (valueOf 0) $ \ i s -> do + y <- extractelement vcb i + s' <- add s (y :: Value T) + return s' + + -- Update the global variable. + vacc <- load acc + vacc' <- add vacc s + store vacc' acc + + ret (s :: Value T) + +-- liftIO $ dumpValue f + return f + +-- Run LLVM optimizer at standard level. +optimize :: String -> IO () +optimize name = do + _rc <- system $ "opt -std-compile-opts " ++ name ++ " -f -o " ++ name + return () + +-- Optimize the module by writing the bit code to file, running the optimizer, and then reading the file back in. +-- 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 + + fptr <- runEngineAccess $ do addModule m; getPointerToFunction iovec + let fvec = convert fptr + + fvec 10 >>= print + + vec <- runEngineAccess $ do addModule m; generateFunction iovec + + vec 10 >>= print + + -- And then optimize and run. + let name = "Vec.bc" + writeBitcodeToFile name m + optimize name + m' <- readBitcodeFromFile name + + funcs <- getModuleValues m' + print $ map fst funcs + + let iovec' :: Function (T -> IO T) + Just iovec' = castModuleValue =<< lookup "vectest" funcs + ioretacc' :: Function (IO T) + Just ioretacc' = castModuleValue =<< lookup "retacc" funcs + + (vec', retacc') <- runEngineAccess $ do + addModule m' + liftM2 (,) (generateFunction iovec') (generateFunction ioretacc') + + dumpValue iovec' + + vec' 10 >>= print + vec' 0 >>= print + retacc' >>= print + + + diff --git a/examples/mainfib.c b/examples/mainfib.c new file mode 100644 --- /dev/null +++ b/examples/mainfib.c @@ -0,0 +1,12 @@ +#include +#include + +extern unsigned int fib(unsigned int); + +int +main(int argc, char **argv) +{ + int n = argc > 1 ? atoi(argv[1]) : 10; + printf("fib %d = %d\n", n, fib(n)); + exit(0); +} diff --git a/examples/structCheck.c b/examples/structCheck.c new file mode 100644 --- /dev/null +++ b/examples/structCheck.c @@ -0,0 +1,9 @@ +#include + +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; +} diff --git a/llvm-ht.cabal b/llvm-ht.cabal new file mode 100644 --- /dev/null +++ b/llvm-ht.cabal @@ -0,0 +1,134 @@ +name: llvm-ht +version: 0.7.0.0 +license: BSD3 +license-file: LICENSE +synopsis: Bindings to the LLVM compiler toolkit with some custom extensions. +description: Bindings to the LLVM compiler toolkit. + + Custom extensions: + + * vector-aware versions of fptosi and friends + + * Callback from LLVM code into Haskell code including StablePtr support + + * tuple arguments to LLVM functions + + * instance IsFirstClass Array + + * CodeGen.constStruct + + * Instruction.extractvalue, insertvalue + + * Core.Instruction.bitcastUnify: like bitcast but uses type unification for asserting equal size of source and target + + News in the original llvm package: + + * 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; + + * New in 0.6.5.0: Adapted to LLVM 2.5; +author: Bryan O'Sullivan, Lennart Augustsson, Henning Thielemann +maintainer: Bryan O'Sullivan , Lennart Augustsson , Henning Thielemann +homepage: http://darcs.serpentine.com/llvm/ +stability: experimental +category: Compilers/Interpreters, Code Generation +tested-with: GHC == 6.10.4 +cabal-version: >= 1.2.3 +build-type: Custom + +extra-source-files: + INSTALL.txt + Makefile + PROBLEMS.txt + README.txt + configure + configure.ac + examples/Arith.hs + examples/Align.hs + examples/Array.hs + examples/BrainF.hs + examples/Convert.hs + examples/DotProd.hs + examples/Fibonacci.hs + examples/HelloJIT.hs + 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 + llvm.buildinfo.windows.in + +extra-tmp-files: + autom4te.cache + config.log + config.status + llvm.buildinfo + +library + build-depends: base >= 3 && < 5, bytestring >= 0.9, mtl, directory, process, type-level + + ghc-options: -Wall + + if os(darwin) + ld-options: -w /System/Library/Frameworks/vecLib.framework/Versions/A/vecLib + cpp-options: -D__MACOS__ + + exposed-modules: + LLVM.Core + LLVM.ExecutionEngine + LLVM.FFI.Analysis + LLVM.FFI.BitReader + LLVM.FFI.BitWriter + 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 + LLVM.Core.CodeGenMonad + LLVM.Core.Data + LLVM.Core.Instructions + LLVM.Core.Type + LLVM.Core.Util + 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 diff --git a/llvm.buildinfo.in b/llvm.buildinfo.in new file mode 100644 --- /dev/null +++ b/llvm.buildinfo.in @@ -0,0 +1,4 @@ +cpp-options: @llvm_cppflags@ -DTARGET=@llvm_target@ +ghc-options: -pgml @CXX@ +ld-options: @llvm_ldflags@ @llvm_all_libs@ -lstdc++ +include-dirs: @llvm_includedir@ diff --git a/llvm.buildinfo.windows.in b/llvm.buildinfo.windows.in new file mode 100644 --- /dev/null +++ b/llvm.buildinfo.windows.in @@ -0,0 +1,4 @@ +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 diff --git a/tests/Makefile b/tests/Makefile new file mode 100644 --- /dev/null +++ b/tests/Makefile @@ -0,0 +1,16 @@ +ghc := ghc +ghcflags := -Wall -Werror +tests := TestType TestValue + +all: $(tests:%=%.out) + +%.out: %.test + ./$< > $@ 2>&1; s=$$?; cat $@; \ + if [ $$s != 0 ]; then mv $@ $(basename $@).err; exit 1; fi + +.PRECIOUS: %.test +%.test: %.hs + $(ghc) $(ghcflags) --make -o $@ -main-is $(basename $<).main $< + +clean: + -rm -f *.o *.hi $(tests:%=%.test) $(tests:%=%.out) diff --git a/tests/TestValue.hs b/tests/TestValue.hs new file mode 100644 --- /dev/null +++ b/tests/TestValue.hs @@ -0,0 +1,69 @@ +module TestValue (main) where + +import qualified LLVM.Core as Core +import qualified LLVM.Core.Type as T +import qualified LLVM.Core.Value as V + +testArguments :: (T.DynamicType r, T.Params p, V.Params p v, V.Value v) + => T.Module -> String -> IO (V.Function r p) +testArguments m name = do + func <- Core.addFunction m name (T.function undefined undefined) + V.dumpValue func + let arg = V.params func + V.dumpValue arg + return func + +voidArguments :: T.Module -> IO () +voidArguments m = do + func <- Core.addFunction m "void" (T.function (undefined :: T.Void) ()) + V.dumpValue func + return () + +type F a = V.Function a a +type P a = V.Function (T.Pointer a) (T.Pointer a) +type V a = V.Function (T.Vector a) (T.Vector a) + +arguments :: T.Module -> IO () +arguments m = do + voidArguments m + + testArguments m "int1" :: IO (F T.Int1) + testArguments m "int8" :: IO (F T.Int8) + testArguments m "int16" :: IO (F T.Int16) + testArguments m "int32" :: IO (F T.Int32) + testArguments m "int64" :: IO (F T.Int64) + testArguments m "float" :: IO (F T.Float) + testArguments m "double" :: IO (F T.Double) + testArguments m "float128" :: IO (F T.Float128) + testArguments m "x86Float80" :: IO (F T.X86Float80) + testArguments m "ppcFloat128" :: IO (F T.PPCFloat128) + + testArguments m "ptrInt1" :: IO (P T.Int1) + testArguments m "ptrInt8" :: IO (P T.Int8) + testArguments m "ptrInt16" :: IO (P T.Int16) + testArguments m "ptrInt32" :: IO (P T.Int32) + testArguments m "ptrInt64" :: IO (P T.Int64) + testArguments m "ptrFloat" :: IO (P T.Float) + testArguments m "ptrDouble" :: IO (P T.Double) + testArguments m "ptrFloat128" :: IO (P T.Float128) + testArguments m "ptrX86Float80" :: IO (P T.X86Float80) + testArguments m "ptrPpcFloat128" :: IO (P T.PPCFloat128) + + testArguments m "vecInt1" :: IO (V T.Int1) + testArguments m "vecInt8" :: IO (V T.Int8) + testArguments m "vecInt16" :: IO (V T.Int16) + testArguments m "vecInt32" :: IO (V T.Int32) + testArguments m "vecInt64" :: IO (V T.Int64) + testArguments m "vecFloat" :: IO (V T.Float) + testArguments m "vecDouble" :: IO (V T.Double) + testArguments m "vecFloat128" :: IO (V T.Float128) + testArguments m "vecX86Float80" :: IO (V T.X86Float80) + testArguments m "vecPpcFloat128" :: IO (V T.PPCFloat128) + + return () + +main :: IO () +main = do + m <- Core.createModule "m" + arguments m + return () diff --git a/tools/DiffFFI.hs b/tools/DiffFFI.hs new file mode 100644 --- /dev/null +++ b/tools/DiffFFI.hs @@ -0,0 +1,39 @@ +module DiffFFI (main) where + +import Control.Monad (forM_) +import Data.List (foldl') +import qualified Data.Map as M +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) +import Text.Regex.Posix ((=~)) + +import FunctionMangulation (pattern, rewriteFunction) + +cFunctions :: String -> M.Map String String +cFunctions s = foldl' go M.empty (s =~ pattern) + where go m (_:ret:name:params:_) = + M.insert ("LLVM" ++ name) (rewriteFunction ret name params) m + go m _ = m + +hsFunctions :: String -> M.Map String String +hsFunctions s = foldl' go M.empty (s =~ pat) + where pat = "\"([a-zA-Z0-9_]+)\"[ \t\n]+([a-zA-Z0-9_']+)" + go m (_:cname:hsname:_) = M.insert cname hsname m + go m _ = m + +main :: IO () +main = do + args <- getArgs + case args of + [cFile, hsFile] -> do + c <- cFunctions `fmap` readFile cFile + hs <- hsFunctions `fmap` readFile hsFile + putStrLn "In C, not Haskell:" + forM_ (M.toAscList $ M.difference c hs) $ \(_, hsfunc) -> + putStrLn hsfunc + putStrLn "In Haskell, not C:" + forM_ (M.keys $ M.difference hs c) $ putStrLn . (" "++) + _ -> do + hPutStrLn stderr "Usage: DiffFFI cFile hsFile" + exitFailure diff --git a/tools/FunctionMangler.hs b/tools/FunctionMangler.hs new file mode 100644 --- /dev/null +++ b/tools/FunctionMangler.hs @@ -0,0 +1,8 @@ +module FunctionMangler (main) where + +import Data.List (intercalate) + +import FunctionMangulation (rewrite) + +main :: IO () +main = interact (intercalate "\n\n" . concat . rewrite) >> putStr "\n" diff --git a/tools/FunctionMangulation.hs b/tools/FunctionMangulation.hs new file mode 100644 --- /dev/null +++ b/tools/FunctionMangulation.hs @@ -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) diff --git a/tools/IntrinsicMangler.hs b/tools/IntrinsicMangler.hs new file mode 100644 --- /dev/null +++ b/tools/IntrinsicMangler.hs @@ -0,0 +1,22 @@ +module IntrinsicMangler (main) where + +import Control.Monad (forM_) +import qualified Data.ByteString.Char8 as C +import Data.Maybe (catMaybes) +import Text.Regex.Posix ((=~~)) + +maybeName :: C.ByteString -> Maybe C.ByteString +maybeName line = do + ((_:name:_):_) <- line =~~ "^[ \t]*([a-z0-9_]+),[ \t]*//[ \t]*llvm\\." + return name + +main :: IO () +main = do + input <- (catMaybes . map maybeName . C.lines) `fmap` C.getContents + + putStrLn "-- automatically generated file - do not edit!" + putStrLn "module LLVM.Core.Intrinsics (Intrinsic(..)) where" + putStrLn "data Intrinsic =" + putStrLn " NotIntrinsic" + forM_ input $ C.putStrLn . (C.append (C.pack " | I_")) + putStrLn " deriving (Eq, Ord, Enum, Show)" diff --git a/tools/Makefile b/tools/Makefile new file mode 100644 --- /dev/null +++ b/tools/Makefile @@ -0,0 +1,11 @@ +ghc := ghc +ghcflags := -O -Wall -Werror +tools := DiffFFI FunctionMangler IntrinsicMangler + +all: $(tools) + +%: %.hs + $(ghc) $(ghcflags) --make -o $@ -main-is $(basename $<).main $< + +clean: + -rm -f *.o *.hi $(tools) *.exe