diff --git a/LLVM/Core/CodeGen.hs b/LLVM/Core/CodeGen.hs --- a/LLVM/Core/CodeGen.hs +++ b/LLVM/Core/CodeGen.hs @@ -113,7 +113,7 @@ else error "constOf Ptr: pointer size not 4 or 8" -instance (IsPrimitive a, IsConst a, IsPowerOf2 n) => IsConst (Vector n a) where +instance (IsPrimitive a, IsConst a, Nat 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 @@ -397,7 +397,7 @@ -------------------------------------- -- |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 :: forall a n . (Nat n) => [ConstValue a] -> ConstValue (Vector n a) constVector xs = ConstValue $ U.constVector (toNum (undefined :: n)) [ v | ConstValue v <- xs ] diff --git a/LLVM/Core/Type.hs b/LLVM/Core/Type.hs --- a/LLVM/Core/Type.hs +++ b/LLVM/Core/Type.hs @@ -16,8 +16,6 @@ IsFirstClass, IsSized, IsFunction, - -- ** Others - IsPowerOf2, -- ** Structs (:&), (&), -- ** Type tests @@ -33,14 +31,11 @@ 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. @@ -187,7 +182,7 @@ 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) +instance (Nat n, IsPrimitive a) => IsType (Vector n a) where typeDesc _ = TDVector (toNum (undefined :: n)) (typeDesc (undefined :: a)) @@ -195,6 +190,15 @@ 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 [] @@ -241,12 +245,12 @@ instance IsArithmetic Word16 instance IsArithmetic Word32 instance IsArithmetic Word64 -instance (IsPowerOf2 n, IsPrimitive a, IsArithmetic a) => IsArithmetic (Vector n a) +instance (Nat 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 (Nat n, IsPrimitive a, IsFloating a) => IsFloating (Vector n a) instance (Pos n) => IsInteger (IntN n) instance (Pos n) => IsInteger (WordN n) @@ -259,7 +263,7 @@ instance IsInteger Word16 instance IsInteger Word32 instance IsInteger Word64 -instance (IsPowerOf2 n, IsPrimitive a, IsInteger a) => IsInteger (Vector n a) +instance (Nat n, IsPrimitive a, IsInteger a) => IsInteger (Vector n a) instance (Pos n) => IsIntegerOrPointer (IntN n) instance (Pos n) => IsIntegerOrPointer (WordN n) @@ -272,7 +276,7 @@ instance IsIntegerOrPointer Word16 instance IsIntegerOrPointer Word32 instance IsIntegerOrPointer Word64 -instance (IsPowerOf2 n, IsPrimitive a, IsInteger a) => IsIntegerOrPointer (Vector n a) +instance (Nat n, IsPrimitive a, IsInteger a) => IsIntegerOrPointer (Vector n a) instance (IsType a) => IsIntegerOrPointer (Ptr a) instance IsFirstClass Float @@ -289,8 +293,9 @@ instance IsFirstClass Word16 instance IsFirstClass Word32 instance IsFirstClass Word64 -instance (IsPowerOf2 n, IsPrimitive a) => IsFirstClass (Vector n a) +instance (Nat n, IsPrimitive a) => IsFirstClass (Vector 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) @@ -310,8 +315,9 @@ 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 (Nat 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 diff --git a/LLVM/Core/Vector.hs b/LLVM/Core/Vector.hs --- a/LLVM/Core/Vector.hs +++ b/LLVM/Core/Vector.hs @@ -12,7 +12,7 @@ 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 +class (Nat n, IsPrimitive a) => MkVector va n a | va -> n a, n a -> va where toVector :: va -> Vector n a fromVector :: Vector n a -> va @@ -36,7 +36,7 @@ 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 +instance (Storable a, Nat 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) diff --git a/LLVM/ExecutionEngine/Engine.hs b/LLVM/ExecutionEngine/Engine.hs --- a/LLVM/ExecutionEngine/Engine.hs +++ b/LLVM/ExecutionEngine/Engine.hs @@ -27,6 +27,7 @@ import Foreign.Ptr (FunPtr) import LLVM.Core.CodeGen(Value(..), Function) import Foreign.Storable (peek) +import Foreign.StablePtr (StablePtr, castStablePtrToPtr, castPtrToStablePtr, ) import System.IO.Unsafe (unsafePerformIO) import LLVM.Core.Util(Module, ModuleProvider, withModuleProvider, createModule, createModuleProviderForExistingModule) @@ -281,4 +282,8 @@ 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 diff --git a/LLVM/FFI/Core.hsc b/LLVM/FFI/Core.hsc --- a/LLVM/FFI/Core.hsc +++ b/LLVM/FFI/Core.hsc @@ -1201,6 +1201,15 @@ | NestAttribute | ReadNoneAttribute | ReadOnlyAttribute + | NoInlineAttribute + | AlwaysInlineAttribute + | OptimizeForSizeAttribute + | StackProtectAttribute + | StackProtectReqAttribute + | NoCaptureAttribute + | NoRedZoneAttribute + | NoImplicitFloatAttribute + | NakedAttribute deriving (Show, Eq, Ord, Enum, Bounded, Typeable) fromAttribute :: Attribute -> CAttribute @@ -1215,6 +1224,15 @@ fromAttribute NestAttribute = (#const LLVMNestAttribute) fromAttribute ReadNoneAttribute = (#const LLVMReadNoneAttribute) fromAttribute ReadOnlyAttribute = (#const LLVMReadOnlyAttribute) +fromAttribute NoInlineAttribute = (#const LLVMNoInlineAttribute) +fromAttribute AlwaysInlineAttribute = (#const LLVMAlwaysInlineAttribute) +fromAttribute OptimizeForSizeAttribute = (#const LLVMOptimizeForSizeAttribute) +fromAttribute StackProtectAttribute = (#const LLVMStackProtectAttribute) +fromAttribute StackProtectReqAttribute = (#const LLVMStackProtectReqAttribute) +fromAttribute NoCaptureAttribute = (#const LLVMNoCaptureAttribute) +fromAttribute NoRedZoneAttribute = (#const LLVMNoRedZoneAttribute) +fromAttribute NoImplicitFloatAttribute = (#const LLVMNoImplicitFloatAttribute) +fromAttribute NakedAttribute = (#const LLVMNakedAttribute) toAttribute :: CAttribute -> Attribute toAttribute c | c == (#const LLVMZExtAttribute) = ZExtAttribute @@ -1228,6 +1246,15 @@ toAttribute c | c == (#const LLVMNestAttribute) = NestAttribute toAttribute c | c == (#const LLVMReadNoneAttribute) = ReadNoneAttribute toAttribute c | c == (#const LLVMReadOnlyAttribute) = ReadOnlyAttribute +toAttribute c | c == (#const LLVMNoInlineAttribute) = NoInlineAttribute +toAttribute c | c == (#const LLVMAlwaysInlineAttribute) = AlwaysInlineAttribute +toAttribute c | c == (#const LLVMOptimizeForSizeAttribute) = OptimizeForSizeAttribute +toAttribute c | c == (#const LLVMStackProtectAttribute) = StackProtectAttribute +toAttribute c | c == (#const LLVMStackProtectReqAttribute) = StackProtectReqAttribute +toAttribute c | c == (#const LLVMNoCaptureAttribute) = NoCaptureAttribute +toAttribute c | c == (#const LLVMNoRedZoneAttribute) = NoRedZoneAttribute +toAttribute c | c == (#const LLVMNoImplicitFloatAttribute) = NoImplicitFloatAttribute +toAttribute c | c == (#const LLVMNakedAttribute) = NakedAttribute toAttribute _ = error "toAttribute: bad value" type CAttribute = CInt diff --git a/LLVM/FFI/ExecutionEngine.hsc b/LLVM/FFI/ExecutionEngine.hsc --- a/LLVM/FFI/ExecutionEngine.hsc +++ b/LLVM/FFI/ExecutionEngine.hsc @@ -82,7 +82,18 @@ foreign import ccall unsafe "&LLVMDisposeGenericValue" ptrDisposeGenericValue :: FunPtr (GenericValueRef -> IO ()) -foreign import ccall unsafe "LLVMRunFunction" runFunction +{- +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 @@ -93,7 +104,7 @@ 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 + :: Ptr ExecutionEngineRef -> ModuleProviderRef -> CUInt -> Ptr CString -> IO CInt foreign import ccall unsafe "LLVMFindFunction" findFunction :: ExecutionEngineRef -> CString -> Ptr ValueRef -> IO CInt foreign import ccall unsafe "LLVMFreeMachineCodeForFunction" @@ -105,7 +116,7 @@ foreign import ccall unsafe "LLVMRemoveModuleProvider" removeModuleProvider :: ExecutionEngineRef -> ModuleProviderRef -> Ptr ModuleRef -> Ptr CString -> IO CInt -foreign import ccall unsafe "LLVMRunFunctionAsMain" runFunctionAsMain +foreign import ccall safe "LLVMRunFunctionAsMain" runFunctionAsMain :: ExecutionEngineRef -> ValueRef -> CUInt -> Ptr CString -- ^ argv -> Ptr CString -- ^ envp diff --git a/LLVM/Util/Arithmetic.hs b/LLVM/Util/Arithmetic.hs --- a/LLVM/Util/Arithmetic.hs +++ b/LLVM/Util/Arithmetic.hs @@ -39,22 +39,22 @@ 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 (Nat n) => Cmp (Vector n Bool) (Vector n Bool) where cmp = icmp +instance (Nat n) => Cmp (Vector n Word8) (Vector n Bool) where cmp = icmp +instance (Nat n) => Cmp (Vector n Word16) (Vector n Bool) where cmp = icmp +instance (Nat n) => Cmp (Vector n Word32) (Vector n Bool) where cmp = icmp +instance (Nat n) => Cmp (Vector n Word64) (Vector n Bool) where cmp = icmp +instance (Nat n) => Cmp (Vector n Int8) (Vector n Bool) where cmp = icmp . adjSigned +instance (Nat n) => Cmp (Vector n Int16) (Vector n Bool) where cmp = icmp . adjSigned +instance (Nat n) => Cmp (Vector n Int32) (Vector n Bool) where cmp = icmp . adjSigned +instance (Nat n) => Cmp (Vector n Int64) (Vector n Bool) where cmp = icmp . adjSigned +instance (Nat n) => Cmp (Vector n Float) (Vector n Bool) where cmp = fcmp . adjFloat +instance (Nat n) => Cmp (Vector n Double) (Vector n Bool) where cmp = fcmp . adjFloat +instance (Nat n) => Cmp (Vector n FP128) (Vector n Bool) where cmp = fcmp . adjFloat -} -instance (IsPowerOf2 n) => Cmp (Vector n Float) (Vector n Bool) where +instance (Nat 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 +instance (Nat n) => Cmp (Vector n Word32) (Vector n Bool) where cmp op = mapVector2 (cmp op) adjSigned :: IntPredicate -> IntPredicate @@ -300,7 +300,7 @@ callIntrinsic1' = callIntrinsicP1 callIntrinsic2' = callIntrinsicP2 -instance (IsPowerOf2 n, IsPrimitive a, CallIntrinsic a) => CallIntrinsic (Vector n a) where +instance (Nat n, IsPrimitive a, CallIntrinsic a) => CallIntrinsic (Vector n a) where callIntrinsic1' s = mapVector (callIntrinsic1' s) callIntrinsic2' s = mapVector2 (callIntrinsic2' s) diff --git a/LLVM/Util/File.hs b/LLVM/Util/File.hs --- a/LLVM/Util/File.hs +++ b/LLVM/Util/File.hs @@ -1,5 +1,5 @@ module LLVM.Util.File(writeCodeGenModule, optimizeFunction, optimizeFunctionCG) where -import System.Directory + import System.Cmd(system) import LLVM.Core diff --git a/LLVM/Util/Loop.hs b/LLVM/Util/Loop.hs --- a/LLVM/Util/Loop.hs +++ b/LLVM/Util/Loop.hs @@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, FlexibleInstances, TypeOperators, FlexibleContexts #-} -module LLVM.Util.Loop(Phi, forLoop, mapVector, mapVector2) where +module LLVM.Util.Loop(Phi(phis,addPhis), forLoop, mapVector, mapVector2) where import Data.TypeLevel hiding (Bool) import LLVM.Core @@ -88,7 +88,7 @@ -------------------------------------- mapVector :: forall a b n r . - (IsPowerOf2 n, IsPrimitive b) => + (Nat n, IsPrimitive b) => (Value a -> CodeGenFunction r (Value b)) -> Value (Vector n a) -> CodeGenFunction r (Value (Vector n b)) mapVector f v = @@ -98,7 +98,7 @@ insertelement w y i mapVector2 :: forall a b c n r . - (IsPowerOf2 n, IsPrimitive c) => + (Nat 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 = diff --git a/examples/Arith.hs b/examples/Arith.hs --- a/examples/Arith.hs +++ b/examples/Arith.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-type-defaults #-} -{-# LANGUAGE ScopedTypeVariables, PatternSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} module Arith where import Data.Int import Data.TypeLevel(D4) diff --git a/llvm.buildinfo.in b/llvm.buildinfo.in --- a/llvm.buildinfo.in +++ b/llvm.buildinfo.in @@ -1,4 +1,4 @@ cpp-options: @llvm_cppflags@ -DTARGET=@llvm_target@ ghc-options: -pgml @CXX@ -ld-options: @llvm_ldflags@ @llvm_all_libs@ -lstdc++ +ld-options: @llvm_all_libs@ @llvm_ldflags@ -lstdc++ include-dirs: @llvm_includedir@ diff --git a/llvm.cabal b/llvm.cabal --- a/llvm.cabal +++ b/llvm.cabal @@ -1,16 +1,25 @@ name: llvm -version: 0.7.0.1 +version: 0.7.1.0 license: BSD3 license-file: LICENSE synopsis: Bindings to the LLVM compiler toolkit. description: Bindings to the LLVM compiler toolkit. - New in 0.7.0.0: Adapted to LLVM 2.6; - New in 0.6.8.0: Add functions to allow freeing function resources; - New in 0.6.7.0: Struct types; - New in 0.6.6.0: Bug fixes; - New in 0.6.5.0: Adapted to LLVM 2.5; + * New in 0.7.1.0: More attributes + . + * New in 0.7.0.1: MacOS fixes. + . + * 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 maintainer: Bryan O'Sullivan , Lennart Augustsson +bug-reports: Lennart Augustsson homepage: http://darcs.serpentine.com/llvm/ stability: experimental category: Compilers/Interpreters, Code Generation