[haskell-llvm] fptoui et.al. for vectors
Henning Thielemann
lemming at henning-thielemann.de
Mon Aug 23 14:01:22 EDT 2010
On Sat, 24 Jul 2010, Henning Thielemann wrote:
> I like to propose another patch that generalizes conversions between
> integers and floating point numbers to vectors. However the way, I did
> it so far, is incompatible with the current version of the 'llvm'
> package. Do you want it that way? This would require to bump version to
> llvm-0.9 - if you follow the package versioning policy, at all. If not I
> would have to give the generic functions new names like fptouiVector or
> fptouiGeneric or put them in a separate module and call it like
> Vector.fptoui. I made (NumberOfElements D1 a) a constraint of class
> IsPrimitive a. This enforces consistency between NumberOfElements and
> IsPrimitive instance, but of course this is also incompatible with
> llvm-0.8.0.2. (If you decide to do incompatible changes, then also
> consider replacing bitcast by the recently submitted bitcastUnify, since
> the constraint (sa :==: sb) of bitcast is extremely unhandy in practical
> use.)
No comments?
I'll just submit a darcs patch for vectorial fptosi and friends.
Still waiting for the patches to appear on code.haskell.org/llvm, since I
want to adapt my sound synthesis code to the official llvm release in
order to make all the code installable from Hackage.
-------------- next part --------------
New patches:
[vector constructs Vector analogously to constVector
llvm at henning-thielemann.de**20100210095124] {
hunk ./LLVM/Core/Vector.hs 3
-module LLVM.Core.Vector(MkVector(..)) where
+module LLVM.Core.Vector(MkVector(..), vector, ) where
hunk ./LLVM/Core/Vector.hs 54
+-- |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))
+
+
hunk ./LLVM/Core.hs 50
- toVector, fromVector,
+ toVector, fromVector, vector,
}
[CodeGen.constStruct
llvm at henning-thielemann.de**20100305082944] {
hunk ./LLVM/Core/CodeGen.hs 23
- constVector, constArray,
+ constVector, constArray, constStruct, constPackedStruct,
hunk ./LLVM/Core/CodeGen.hs 409
+-- |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 _ = []
+
hunk ./LLVM/Core.hs 50
+ constStruct, constPackedStruct,
hunk ./LLVM/Core.hs 73
-import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, getModuleValues, valueHasType)
+import LLVM.Core.Util hiding (Function, BasicBlock, createModule, constString, constStringNul, constVector, constArray, constStruct, getModuleValues, valueHasType)
}
[Core.Instruction.bitcastUnify: like bitcast but uses type unification for asserting equal size of source and target
llvm at henning-thielemann.de**20100319134650] {
hunk ./LLVM/Core/Instructions.hs 37
- bitcast,
+ bitcast, bitcastUnify,
hunk ./LLVM/Core/Instructions.hs 343
+-- | 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
+
}
[Instruction.extractvalue, insertvalue
llvm at henning-thielemann.de**20100724165235] {
hunk ./LLVM/Core/Instructions.hs 24
+ -- * Aggregate operations
+ extractvalue,
+ insertvalue,
hunk ./LLVM/Core/Instructions.hs 53
- GetElementPtr, IsIndexArg
+ GetElementPtr, IsIndexArg, GetValue
hunk ./LLVM/Core/Instructions.hs 60
-import Foreign.C(CInt)
+import Foreign.C(CInt, CUInt)
hunk ./LLVM/Core/Instructions.hs 264
--- | Insert a value into a vector, nondescructive.
+-- | Insert a value into a vector, nondestructive.
hunk ./LLVM/Core/Instructions.hs 286
+
+-- |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)
+
}
[Type: export UnknownSize for use of Structs in Arrays
llvm at henning-thielemann.de**20100724170004] {
hunk ./LLVM/Core/Type.hs 20
+ UnknownSize, -- needed for arrays of structs
}
[Type: instance IsFirstClass Array
llvm at henning-thielemann.de**20100724170033] {
hunk ./LLVM/Core/Type.hs 299
+instance (Nat n, IsType a, IsSized a s) => IsFirstClass (Array n a)
}
[Callbacks into Haskell functions
llvm at henning-thielemann.de**20100727215631
Ignore-this: eef6c0d0416a465182235bc0c66fdb7b
this is achieved by maintaining a GlobalMappings dictionary
] {
hunk ./LLVM/Core.hs 59
- externFunction,
+ externFunction, staticFunction,
+ GlobalMappings, getGlobalMappings,
hunk ./LLVM/Core.hs 76
-import LLVM.Core.CodeGenMonad(CodeGenFunction, CodeGenModule)
+import LLVM.Core.CodeGenMonad(CodeGenFunction, CodeGenModule, GlobalMappings, getGlobalMappings)
hunk ./LLVM/Core/CodeGen.hs 13
- externFunction,
+ externFunction, staticFunction,
hunk ./LLVM/Core/CodeGen.hs 34
-import Foreign.Ptr(minusPtr, nullPtr)
+import Foreign.StablePtr (StablePtr, castStablePtrToPtr)
+import Foreign.Ptr(minusPtr, nullPtr, FunPtr, castFunPtrToPtr)
hunk ./LLVM/Core/CodeGen.hs 269
+instance FunctionArgs (IO (StablePtr a)) (FA (StablePtr a)) (FA (StablePtr a)) where apArgs _ _ g = g
hunk ./LLVM/Core/CodeGen.hs 313
--- |Create a reference to an external function while code generating for a function.
+-- | Create a reference to an external function while code generating for a function.
+-- If LLVM cannot resolve its name, then you may try 'staticFunction'.
hunk ./LLVM/Core/CodeGen.hs 328
+{- |
+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 at .
+
+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
+<http://old.nabble.com/jit-with-external-functions-td7769793.html>.
+-}
+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
+
hunk ./LLVM/Core/CodeGenMonad.hs 5
+ GlobalMappings(..), addGlobalMapping, getGlobalMappings,
hunk ./LLVM/Core/CodeGenMonad.hs 14
+import Foreign.Ptr (Ptr, )
+
hunk ./LLVM/Core/CodeGenMonad.hs 23
+ cgm_global_mappings :: [(Function, Ptr ())],
hunk ./LLVM/Core/CodeGenMonad.hs 42
- let cgm = CGMState { cgm_module = m, cgm_next = 1, cgm_externs = [] }
+ let cgm = CGMState { cgm_module = m, cgm_next = 1, cgm_externs = [], cgm_global_mappings = [] }
hunk ./LLVM/Core/CodeGenMonad.hs 82
+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)
+
hunk ./LLVM/ExecutionEngine.hs 14
+ addFunctionValue,
+ addGlobalMappings,
hunk ./LLVM/ExecutionEngine.hs 37
+import Control.Monad (liftM2, )
hunk ./LLVM/ExecutionEngine.hs 51
+--
+-- 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'.
hunk ./LLVM/ExecutionEngine.hs 72
+-- It is based on 'generateFunction', so see there for limitations.
hunk ./LLVM/ExecutionEngine.hs 76
- func <- defineModule m bld
+ (func, mappings) <- defineModule m (liftM2 (,) bld getGlobalMappings)
hunk ./LLVM/ExecutionEngine.hs 80
+ addGlobalMappings mappings
hunk ./LLVM/ExecutionEngine/Engine.hs 12
+ addFunctionValue, addGlobalMappings,
hunk ./LLVM/ExecutionEngine/Engine.hs 27
-import Foreign.Ptr (Ptr)
-import Foreign.Ptr (FunPtr)
+import Foreign.Ptr (Ptr, FunPtr, castFunPtrToPtr)
hunk ./LLVM/ExecutionEngine/Engine.hs 29
+import LLVM.Core.CodeGenMonad(GlobalMappings(..))
hunk ./LLVM/ExecutionEngine/Engine.hs 38
-import qualified LLVM.Core.Util(Function)
+import qualified LLVM.Core.Util as U
hunk ./LLVM/ExecutionEngine/Engine.hs 154
+{- |
+In contrast to 'generateFunction' this compiles a function once.
+Thus it is faster for many calls to the same function.
+See @examples\/Vector.hs at .
+
+If the function calls back into Haskell code,
+you also have to set the function addresses
+using 'addFunctionValue' or 'addGlobalMappings'.
+-}
hunk ./LLVM/ExecutionEngine/Engine.hs 168
+{- |
+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 :: LLVM.Core.Util.Function -> Ptr () -> EngineAccess ()
+addFunctionValueCore g f = do
+ eePtr <- gets ea_engine
+ liftIO $ FFI.addGlobalMapping eePtr g f
+
hunk ./LLVM/ExecutionEngine/Engine.hs 322
-
replace ./LLVM/ExecutionEngine/Engine.hs [A-Za-z_0-9\-\.] LLVM.Core.Util.Function U.Function
}
[example/List: demonstrate callback to a Haskell function that traverses through a lazy Haskell list
llvm at henning-thielemann.de**20100727215841
Ignore-this: 42fb25902dc8d7e07de50f98ddc0a5b7
] {
addfile ./examples/List.hs
hunk ./examples/List.hs 1
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+module List(main) where
+
+import LLVM.Util.Loop (Phi, phis, addPhis, )
+import LLVM.ExecutionEngine (simpleFunction, )
+import LLVM.Core
+import qualified System.IO as IO
+
+import Data.Word (Word32, )
+import Data.Int (Int32, )
+import Foreign.Storable (Storable, sizeOf, )
+import Foreign.Marshal.Array (allocaArray, )
+
+import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )
+import Foreign.Ptr (FunPtr, )
+import Data.IORef (IORef, newIORef, readIORef, writeIORef, )
+
+
+{-
+I had to export Phi's methods in llvm-0.6.8
+in order to be able to implement this function.
+-}
+arrayLoop ::
+ (Phi a, IsType b,
+ Num i, IsConst i, IsInteger i, IsFirstClass i, CmpRet i Bool) =>
+ Value i -> Value (Ptr b) -> a ->
+ (Value (Ptr b) -> a -> CodeGenFunction r a) ->
+ CodeGenFunction r a
+arrayLoop len ptr start loopBody = do
+ top <- getCurrentBasicBlock
+ loop <- newBasicBlock
+ body <- newBasicBlock
+ exit <- newBasicBlock
+
+ br loop
+
+ defineBasicBlock loop
+ i <- phi [(len, top)]
+ p <- phi [(ptr, top)]
+ vars <- phis top start
+ t <- icmp IntNE i (valueOf 0 `asTypeOf` len)
+ condBr t body exit
+
+ defineBasicBlock body
+
+ vars' <- loopBody p vars
+ i' <- sub i (valueOf 1 `asTypeOf` len)
+ p' <- getElementPtr p (valueOf 1 :: Value Word32, ())
+
+ body' <- getCurrentBasicBlock
+ addPhis body' vars vars'
+ addPhiInputs i [(i', body')]
+ addPhiInputs p [(p', body')]
+ br loop
+
+ defineBasicBlock exit
+ return vars
+
+
+mList ::
+ CodeGenModule (Function
+ (StablePtr (IORef [Word32]) -> Word32 -> Ptr Word32 -> IO Int32))
+mList =
+ createFunction ExternalLinkage $ \ ref size ptr -> do
+ next <- staticFunction nelem
+ let _ = next :: Function (StablePtr (IORef [Word32]) -> IO Word32)
+ s <- arrayLoop size ptr (valueOf 0) $ \ ptri y -> do
+ flip store ptri =<< call next ref
+ return y
+ ret (s :: Value Int32)
+
+renderList :: IO ()
+renderList = do
+ m <- newModule
+ _f <- defineModule m mList
+ writeBitcodeToFile "List.bc" m
+
+ fill <- simpleFunction mList
+ stable <- newStablePtr =<< newIORef [3,5..]
+ IO.withFile "listcontent.u32" IO.WriteMode $ \h ->
+ let len = 100
+ in allocaArray len $ \ ptr ->
+ fill stable (fromIntegral len) ptr >>
+ IO.hPutBuf h ptr (len*sizeOf(undefined::Int32))
+ freeStablePtr stable
+
+
+foreign import ccall "&nextListElement"
+ nelem :: FunPtr (StablePtr (IORef [Word32]) -> IO Word32)
+
+foreign export ccall
+ nextListElement :: StablePtr (IORef [Word32]) -> IO Word32
+
+nextListElement :: StablePtr (IORef [Word32]) -> IO Word32
+nextListElement stable =
+ do ioRef <- deRefStablePtr stable
+ xt <- readIORef ioRef
+ case xt of
+ [] -> return 0
+ (x:xs) -> writeIORef ioRef xs >> return x
+
+
+main :: IO ()
+main = do
+ -- Initialize jitter
+ initializeNativeTarget
+ renderList
hunk ./examples/Makefile 4
-examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align Struct Varargs
+examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align Struct Varargs List
hunk ./llvm.cabal 47
+ examples/List.hs
}
[vector versions of conversion between floating point numbers and integers
llvm at henning-thielemann.de**20100823175454
NumberOfElements: new type class for assertion of matching vector sizes in those conversions
] {
hunk ./LLVM/Core/Instructions.hs 355
--- XXX The fp<->i conversion can handle vectors.
hunk ./LLVM/Core/Instructions.hs 356
-fptoui :: (IsFloating a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
+fptoui :: (IsFloating a, IsInteger b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b)
hunk ./LLVM/Core/Instructions.hs 360
-fptosi :: (IsFloating a, IsInteger b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
+fptosi :: (IsFloating a, IsInteger b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b)
hunk ./LLVM/Core/Instructions.hs 364
-uitofp :: (IsInteger a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
+uitofp :: (IsInteger a, IsFloating b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b)
hunk ./LLVM/Core/Instructions.hs 368
-sitofp :: (IsInteger a, IsFloating b, IsPrimitive a, IsPrimitive b) => Value a -> CodeGenFunction r (Value b)
+sitofp :: (IsInteger a, IsFloating b, NumberOfElements n a, NumberOfElements n b) => Value a -> CodeGenFunction r (Value b)
hunk ./LLVM/Core/Type.hs 20
+ -- ** Others
+ NumberOfElements,
hunk ./LLVM/Core/Type.hs 134
-class IsType a => IsPrimitive a
+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
+
hunk ./LLVM/Core/Type.hs 355
+
+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 (Nat n, IsPrimitive a) =>
+ NumberOfElements n (Vector n a)
+
+
}
Context:
[TAG 0.8.0.2
Bryan O'Sullivan <bos at serpentine.com>**20100626055728
Ignore-this: 6136d73c998ace13b784082927997c50
]
Patch bundle hash:
f9ee867db38011f2bab414aec99efc56e6d703c8
More information about the Haskell-llvm
mailing list