llvm 3.2.0.0 → 3.2.0.1
raw patch · 18 files changed
+167/−152 lines, 18 filesdep ~llvm-basenew-uploader
Dependency ranges changed: llvm-base
Files
- CHANGELOG.md +8/−0
- LLVM/Core.hs +1/−1
- LLVM/Core/CodeGen.hs +21/−19
- LLVM/Core/CodeGenMonad.hs +6/−5
- LLVM/Core/Data.hs +1/−1
- LLVM/Core/Type.hs +26/−26
- LLVM/Core/Util.hs +49/−43
- LLVM/ExecutionEngine/Engine.hs +2/−2
- LLVM/Util/Optimize.hs +3/−1
- PROBLEMS.md +5/−9
- examples/Align.hs +4/−4
- examples/Arith.hs +2/−2
- examples/Array.hs +18/−18
- examples/Convert.hs +2/−2
- examples/DotProd.hs +3/−3
- examples/Vector.hs +9/−9
- llvm.cabal +3/−3
- tests/TestValue.hs +4/−4
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+#ChangeLog+++##New in 3.2.0.1 ++1. We now have a change log file!+2. Added support for a wider range of cabal versions. + Both < 1.17 and >= 1.17
LLVM/Core.hs view
@@ -66,7 +66,7 @@ Linkage(..), -- * Basic blocks BasicBlock, newBasicBlock, newNamedBasicBlock, defineBasicBlock, createBasicBlock, createNamedBasicBlock, getCurrentBasicBlock,- getBasicBlocks, + getBasicBlocks, fromLabel, toLabel, getInstructions, getOperands, hasUsers, getUsers, getUses, getUser, isChildOf, getDep, -- * Misc
LLVM/Core/CodeGen.hs view
@@ -143,10 +143,10 @@ constFieldsOf _ = [] constEnum :: (Enum a) => FFI.TypeRef -> a -> ConstValue a-constEnum t i = ConstValue $ FFI.constInt t (fromIntegral $ fromEnum i) False+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) (isSigned i)+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)@@ -206,9 +206,9 @@ defineFunction (Value fn) body = do bld <- liftIO $ U.createBuilder let body' = do- l <- newBasicBlock- defineBasicBlock l- applyArgs fn body :: CodeGenFunction r ()+ l <- newBasicBlock+ defineBasicBlock l+ applyArgs fn body :: CodeGenFunction r () runCodeGenFunction bld fn body' return () @@ -224,10 +224,10 @@ -- | Create a new function with the given body. createNamedFunction :: (IsFunction f, FunctionArgs f g r)- => Linkage- -> String- -> g -- ^ Function body.- -> CodeGenModule (Function f)+ => Linkage+ -> String+ -> g -- ^ Function body.+ -> CodeGenModule (Function f) createNamedFunction linkage name body = do f <- newNamedFunction linkage name defineFunction f body@@ -265,7 +265,7 @@ instance FunctionArgs (IO Float) (FA Float) Float where apArgs _ _ g = g instance FunctionArgs (IO Double) (FA Double) Double where apArgs _ _ g = g instance FunctionArgs (IO FP128) (FA FP128) FP128 where apArgs _ _ g = g-instance (Pos n) => +instance (Pos n) => FunctionArgs (IO (IntN n)) (FA (IntN n)) (IntN n) where apArgs _ _ g = g instance (Pos n) => FunctionArgs (IO (WordN n)) (FA (WordN n)) (WordN n) where apArgs _ _ g = g@@ -283,7 +283,7 @@ FunctionArgs (IO (Vector n a)) (FA (Vector n a)) (Vector n a) where apArgs _ _ g = g instance StructFields as => FunctionArgs (IO (Struct as)) (FA (Struct as)) (Struct as) where apArgs _ _ g = g-instance (IsType a) => +instance (IsType a) => FunctionArgs (IO (Ptr a)) (FA (Ptr a)) (Ptr a) where apArgs _ _ g = g instance FunctionArgs (IO (StablePtr a)) (FA (StablePtr a)) (StablePtr a) where apArgs _ _ g = g @@ -355,7 +355,7 @@ Nothing -> do f <- liftCodeGenModule $ act name putExterns ((name, f) : es)- return $ Value f+ return $ Value f {- | Make an external C function with a fixed address callable from LLVM code.@@ -414,9 +414,10 @@ 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 True- return g+ 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@@ -495,10 +496,11 @@ 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 True- FFI.setInitializer g s- return g+ liftIO $ liftM Value $ do+ g <- U.addGlobal modul InternalLinkage name typ+ FFI.setGlobalConstant g 1+ FFI.setInitializer g s+ return g --------------------------------------
LLVM/Core/CodeGenMonad.hs view
@@ -26,7 +26,7 @@ } deriving (Show, Typeable) newtype CodeGenModule a = CGM (StateT CGMState IO a)- deriving (Functor, Applicative, Monad, MonadState CGMState, MonadIO, Typeable)+ deriving (Functor, Applicative, Monad, MonadFix, MonadState CGMState, MonadIO, Typeable) genMSym :: String -> CodeGenModule String genMSym prefix = do@@ -45,15 +45,16 @@ -------------------------------------- -data CGFState r = CGFState { +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, Applicative, Monad, MonadState (CGFState r), MonadIO, Typeable)+ deriving (Functor, Applicative, Monad, MonadFix, MonadState (CGFState r), MonadIO, Typeable) genFSym :: CodeGenFunction a String genFSym = do@@ -104,8 +105,8 @@ cgm <- get let cgf = CGFState { cgf_module = cgm, cgf_builder = bld,- cgf_function = fn,- cgf_next = 1 }+ cgf_function = fn,+ cgf_next = 1 } (a, cgf') <- liftIO $ runStateT body cgf put (cgf_module cgf') return a
LLVM/Core/Data.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE EmptyDataDecls, DeriveDataTypeable #-} module LLVM.Core.Data(IntN(..), WordN(..), FP128(..),- Array(..), Vector(..), Ptr, Label, Struct(..), PackedStruct(..)) where+ Array(..), Vector(..), Ptr, Label, Struct(..), PackedStruct(..)) where import Data.Typeable import Foreign.Ptr(Ptr)
LLVM/Core/Type.hs view
@@ -64,29 +64,29 @@ 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 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 code TDInvalidType = error "typeRef TDInvalidType" 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 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) ++@@ -131,7 +131,7 @@ -- |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+ | TDPtr TypeDesc | TDFunction Bool [TypeDesc] TypeDesc | TDLabel | TDStruct [TypeDesc] Bool | TDInvalidType deriving (Eq, Ord, Show, Typeable, Data) @@ -165,8 +165,8 @@ isSigned :: (IsInteger a) => a -> Bool isSigned = is . typeDesc where is (TDInt s _) = s- is (TDVector _ a) = is a- is _ = error "isSigned got impossible input"+ is (TDVector _ a) = is a+ is _ = error "isSigned got impossible input" -- Usage: -- constF@@ -177,10 +177,10 @@ 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+ is TDDouble = True+ is TDFP128 = True+ is (TDVector _ a) = is a+ is _ = False -- Usage: -- Precondition for Vector@@ -243,10 +243,10 @@ -- Sequence types instance (Nat n, IsSized a s) => IsType (Array n a) where typeDesc _ = TDArray (toNum (undefined :: n))- (typeDesc (undefined :: a))+ (typeDesc (undefined :: a)) instance (Pos n, IsPrimitive a) => IsType (Vector n a) where typeDesc _ = TDVector (toNum (undefined :: n))- (typeDesc (undefined :: a))+ (typeDesc (undefined :: a)) -- Pointer type. instance (IsType a) => IsType (Ptr a) where
LLVM/Core/Util.hs view
@@ -46,6 +46,7 @@ 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@@ -60,13 +61,14 @@ functionType :: Bool -> Type -> [Type] -> Type functionType varargs retType paramTypes = unsafePerformIO $ withArrayLen paramTypes $ \ len ptr ->- return $ FFI.functionType retType ptr (fromIntegral len) varargs+ 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) packed+ return $ FFI.structType ptr (fromIntegral len) (if packed then 1 else 0) -------------------------------------- -- Handle modules@@ -104,7 +106,7 @@ withCString name $ \ namePtr -> withModule mdl $ \ mdlPtr -> do rc <- FFI.writeBitcodeToFile mdlPtr namePtr- when (rc /= False) $+ when (rc /= 0) $ ioError $ userError $ "writeBitcodeToFile: return code " ++ show rc return () @@ -116,18 +118,20 @@ alloca $ \ modPtr -> alloca $ \ errStr -> do rrc <- FFI.createMemoryBufferWithContentsOfFile namePtr bufPtr errStr- if rrc /= False then do- msg <- peek errStr >>= peekCString- ioError $ userError $ "readBitcodeFromFile: read return code " ++ show rrc ++ ", " ++ msg- else do- buf <- peek bufPtr- prc <- FFI.parseBitcode buf modPtr errStr- if prc /= False then do+ if rrc /= 0 then do msg <- peek errStr >>= peekCString- ioError $ userError $ "readBitcodeFromFile: parse return code " ++ show prc ++ ", " ++ msg- else do- ptr <- peek modPtr- return $ Module ptr+ 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 -}@@ -159,28 +163,28 @@ case pk of FFI.VoidTypeKind -> return "()" FFI.HalfTypeKind -> return "Half"- FFI.FloatTypeKind -> return "Float"- FFI.DoubleTypeKind -> return "Double"- FFI.X86_FP80TypeKind -> return "X86_FP80"- FFI.FP128TypeKind -> return "FP128"- FFI.PPC_FP128TypeKind -> return "PPC_FP128"+ FFI.FloatTypeKind -> return "Float"+ FFI.DoubleTypeKind -> return "Double"+ FFI.X86_FP80TypeKind -> return "X86_FP80"+ FFI.FP128TypeKind -> return "FP128"+ FFI.PPC_FP128TypeKind -> return "PPC_FP128" FFI.X86_MMXTypeKind -> return "X86_MMX" FFI.MetadataTypeKind -> return "Metadata"- FFI.LabelTypeKind -> return "Label"- FFI.IntegerTypeKind -> do w <- FFI.getIntTypeWidth p; return $ "(IntN " ++ show w ++ ")"- FFI.FunctionTypeKind -> do+ 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.VectorTypeKind -> do n <- FFI.getVectorSize p; t <- FFI.getElementType p >>= showType'; return $ "(Vector " ++ show n ++ " " ++ t ++ ")"+ c <- FFI.countParamTypes p+ let n = fromIntegral c+ as <- allocaArray n $ \ args -> do+ FFI.getParamTypes p args+ peekArray n args+ ts <- mapM showType' (as ++ [r])+ return $ "(" ++ intercalate " -> " ts ++ ")"+ FFI.StructTypeKind -> return "(Struct ...)"+ FFI.ArrayTypeKind -> do n <- FFI.getArrayLength p; t <- FFI.getElementType p >>= showType'; return $ "(Array " ++ show n ++ " " ++ t ++ ")"+ FFI.PointerTypeKind -> do t <- FFI.getElementType p >>= showType'; return $ "(Ptr " ++ t ++ ")"+ FFI.VectorTypeKind -> do n <- FFI.getVectorSize p; t <- FFI.getElementType p >>= showType'; return $ "(Vector " ++ show n ++ " " ++ t ++ ")" -------------------------------------- -- Handle module providers@@ -274,7 +278,7 @@ constStringInternal :: Bool -> String -> (Value, Int) constStringInternal nulTerm s = unsafePerformIO $ withCStringLen s $ \(sPtr, sLen) ->- return (FFI.constString sPtr (fromIntegral sLen) (not nulTerm), sLen)+ return (FFI.constString sPtr (fromIntegral sLen) (fromBool (not nulTerm)), sLen) constString :: String -> (Value, Int) constString = constStringInternal False@@ -403,14 +407,14 @@ addTargetData :: FFI.TargetDataRef -> PassManager -> IO () addTargetData td pm = withPassManager pm $ FFI.addTargetData td -runFunctionPassManager :: PassManager -> Function -> IO Bool-runFunctionPassManager pm fcn = withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn+runFunctionPassManager :: PassManager -> Function -> IO Int+runFunctionPassManager pm fcn = liftM fromIntegral $ withPassManager pm $ \ pmref -> FFI.runFunctionPassManager pmref fcn -initializeFunctionPassManager :: PassManager -> IO Bool-initializeFunctionPassManager pm = withPassManager pm FFI.initializeFunctionPassManager+initializeFunctionPassManager :: PassManager -> IO Int+initializeFunctionPassManager pm = liftM fromIntegral $ withPassManager pm FFI.initializeFunctionPassManager -finalizeFunctionPassManager :: PassManager -> IO Bool-finalizeFunctionPassManager pm = withPassManager pm FFI.finalizeFunctionPassManager+finalizeFunctionPassManager :: PassManager -> IO Int+finalizeFunctionPassManager pm = liftM fromIntegral $ withPassManager pm FFI.finalizeFunctionPassManager -------------------------------------- @@ -432,7 +436,7 @@ constStruct :: [Value] -> Bool -> Value constStruct xs packed = unsafePerformIO $ do withArrayLen xs $ \ len ptr ->- return $ FFI.constStruct ptr (fromIntegral len) packed+ return $ FFI.constStruct ptr (fromIntegral len) (if packed then 1 else 0) -------------------------------------- @@ -452,7 +456,7 @@ -> (Ptr a -> IO (Ptr a)) -> t1 -> t getObjList withF firstF nextF obj = do withF obj $ \ objPtr -> do- ofst <- firstF objPtr + ofst <- firstF objPtr let oloop p = if p == nullPtr then return [] else do n <- nextF p ps <- oloop n@@ -465,7 +469,9 @@ return $ zip names vs isConstant :: Value -> IO Bool-isConstant = FFI.isConstant+isConstant v = do+ isC <- FFI.isConstant v+ if isC == 0 then return False else return True isIntrinsic :: Value -> IO Bool isIntrinsic v = do
LLVM/ExecutionEngine/Engine.hs view
@@ -222,7 +222,7 @@ 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@@ -232,7 +232,7 @@ getRunFunction :: EngineAccess (U.Function -> [GenericValue] -> IO GenericValue) getRunFunction = do eePtr <- gets ea_engine- return $ \ func args -> + return $ \ func args -> withAll args $ \argLen argPtr -> createGenericValueWith $ FFI.runFunction eePtr func (fromIntegral argLen) argPtr
LLVM/Util/Optimize.hs view
@@ -75,7 +75,9 @@ moduleModified <- FFI.runPassManager passes m - return $ moduleModified || functionsModified+ return $+ toEnum (fromIntegral moduleModified) ||+ toEnum (fromIntegral functionsModified) -- tools/opt/opt.cpp: AddOptimizationPasses addOptimizationPasses :: FFI.PassManagerRef -> FFI.PassManagerRef -> Int -> IO ()
PROBLEMS.md view
@@ -8,13 +8,9 @@ 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)+ghci versions < 7.7 have their own special linker that dynamically+links static libraries rather than using the system dynamic linker.+This is the source of a long history of ffi + ghci bugs, and fundamentally unfixable. -I don't know why this happens, but it looks like a `ghci` bug.+If you have troubles using llvm with ghci versions >= 7.7 , that is a+bug on the GHCI or llvm-hs sides, please file a bug report so we can resolve it.
examples/Align.hs view
@@ -14,8 +14,8 @@ 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),+ aBIAlignmentOfType td $ typeRef (undefined :: Vector D4 Float),+ aBIAlignmentOfType td $ typeRef (undefined :: Vector D1 Double),+ storeSizeOfType td $ typeRef (undefined :: Vector D4 Float), intPtrType td- )+ )
examples/Arith.hs view
@@ -17,7 +17,7 @@ -} mSomeFn :: forall a b . (IsConst a, Floating a, IsFloating a, CallIntrinsic a,- FunctionRet a, Cmp a b+ FunctionRet a, Cmp a b ) => CodeGenModule (Function (a -> IO a)) mSomeFn = do foo <- createFunction InternalLinkage $ arithFunction $ \ x y -> exp (sin x) + y@@ -76,7 +76,7 @@ x <- load px y <- call f x store y py- ret ()+ ret () vectorPtrWrap :: (Ptr V -> Ptr V -> IO ()) -> V -> IO V vectorPtrWrap f v =
examples/Array.hs view
@@ -10,29 +10,29 @@ 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+ 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+ 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 ()+ 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 ()) @@ -41,12 +41,12 @@ 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+ 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
examples/Convert.hs view
@@ -17,7 +17,7 @@ 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 @@ -26,7 +26,7 @@ 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
examples/DotProd.hs view
@@ -9,9 +9,9 @@ import LLVM.Util.Foreign mDotProd :: forall n a . (Pos n,- IsPrimitive a, IsArithmetic a, IsFirstClass a, IsConst a, Num a,- FunctionRet a- ) =>+ 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
examples/Vector.hs view
@@ -33,23 +33,23 @@ f <- createNamedFunction ExternalLinkage "vectest" $ \ x -> do let v = value (zero :: ConstValue (Vector N T))- n = toNum (undefined :: N) :: Word32+ 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')+ v1' <- insertelement v1 x1 i+ return (x1', v1') - -- Elementwise cubing of the vector.- vsq <- mul v1 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'+ s' <- add s (y :: Value T)+ return s' -- Update the global variable. vacc <- load acc@@ -58,7 +58,7 @@ ret (s :: Value T) --- liftIO $ dumpValue f+ -- liftIO $ dumpValue f return f main :: IO ()@@ -86,7 +86,7 @@ let iovec' :: Function (T -> IO T) Just iovec' = castModuleValue =<< lookup "vectest" funcs- ioretacc' :: Function (IO T)+ ioretacc' :: Function (IO T) Just ioretacc' = castModuleValue =<< lookup "retacc" funcs (vec', retacc') <- runEngineAccess $ do
llvm.cabal view
@@ -1,5 +1,5 @@ name: llvm-version: 3.2.0.0+version: 3.2.0.1 license: BSD3 license-file: LICENSE synopsis: Bindings to the LLVM compiler toolkit.@@ -44,7 +44,7 @@ base >= 3 && < 5, bytestring >= 0.9, directory,- llvm-base >= 3.2.0.0 && < 4,+ llvm-base >= 3.2.0.1 && < 4, mtl, process, type-level,@@ -56,7 +56,7 @@ ghc-options: -Werror if os(darwin)- ld-options: -w + ld-options: -w frameworks: vecLib cpp-options: -D__MACOS__
tests/TestValue.hs view
@@ -1,9 +1,9 @@ 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@@ -12,12 +12,12 @@ 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 () + return () type F a = V.Function a a type P a = V.Function (T.Pointer a) (T.Pointer a)