llvm-extra 0.10.1 → 0.11
raw patch · 29 files changed
+1300/−257 lines, 29 filesdep +doctest-exitcode-stdiodep ~llvm-tfdep ~transformers
Dependencies added: doctest-exitcode-stdio
Dependency ranges changed: llvm-tf, transformers
Files
- Changes.md +13/−0
- llvm-extra.cabal +10/−6
- private/LLVM/Extra/ArithmeticPrivate.hs +1/−0
- private/LLVM/Extra/ScalarOrVectorPrivate.hs +2/−1
- src/LLVM/Extra/Arithmetic.hs +13/−2
- src/LLVM/Extra/Array.hs +3/−5
- src/LLVM/Extra/FastMath.hs +3/−10
- src/LLVM/Extra/Function.hs +1/−1
- src/LLVM/Extra/Marshal.hs +0/−41
- src/LLVM/Extra/MaybeContinuation.hs +2/−2
- src/LLVM/Extra/Memory.hs +52/−12
- src/LLVM/Extra/MemoryPrivate.hs +0/−23
- src/LLVM/Extra/Multi/Class.hs +2/−1
- src/LLVM/Extra/Multi/Value.hs +2/−0
- src/LLVM/Extra/Multi/Value/Array.hs +79/−0
- src/LLVM/Extra/Multi/Value/Marshal.hs +221/−0
- src/LLVM/Extra/Multi/Value/Private.hs +77/−37
- src/LLVM/Extra/Multi/Value/Storable.hs +417/−0
- src/LLVM/Extra/Multi/Value/Vector.hs +94/−2
- src/LLVM/Extra/Multi/Vector.hs +266/−74
- src/LLVM/Extra/Multi/Vector/Instance.hs +21/−1
- src/LLVM/Extra/ScalarOrVector.hs +1/−0
- src/LLVM/Extra/Storable.hs +0/−6
- src/LLVM/Extra/Storable/Array.hs +8/−6
- src/LLVM/Extra/Storable/Private.hs +0/−22
- src/LLVM/Extra/Vector.hs +3/−3
- test/LLVM/Extra/VectorAlt.hs +1/−0
- test/Main.hs +7/−2
- test/Test/Storable.hs +1/−0
Changes.md view
@@ -1,6 +1,19 @@ # Change log for the `llvm-extra` package +## 0.11++* `Memory`: turn methods `load` and `store` into top-level functions+ based on `decompose` and `compose`.+ Deriving `decompose` and `compose` from `load` and `store`, respectively,+ requires `alloca` which will blast your stack when used in a loop.+ ## 0.10++* `Storable`: We do not support storing tuple types directly anymore.+ This would require the `storable-tuple` package.+ That package ships orphan `Storable` instances+ with a memory layout that does not match your system's ABI.+ Instead, we support the `Tuple` wrapper from `storable-record`. * `Memory`: Attention! Memory layout is no longer compatible with `Foreign.Storable`.
llvm-extra.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: llvm-extra-Version: 0.10.1+Version: 0.11 License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -61,7 +61,7 @@ default: False Source-Repository this- Tag: 0.10.1+ Tag: 0.11 Type: darcs Location: http://code.haskell.org/~thielema/llvm-extra/ @@ -72,16 +72,16 @@ Library Build-Depends: private,- llvm-tf >=9.2 && <9.3,+ llvm-tf >=12.1 && <13.0, tfp >=1.0 && <1.1, non-empty >=0.2.1 && <0.4, fixed-length >=0.2.1 && <0.3, containers >=0.1 && <0.7,- enumset >=0.0.5 && <0.1,+ enumset >=0.0.5 && <0.2, storable-record >=0.0.5 && <0.1, storable-enum >=0.0 && <0.1, bool8 >=0.0 && <0.1,- transformers >=0.1.1 && <0.6,+ transformers >=0.1.1 && <0.7, tagged >=0.7 && <0.9, utility-ht >=0.0.15 && <0.1, prelude-compat >=0.0 && <0.0.1,@@ -113,6 +113,8 @@ LLVM.Extra.Multi.Iterator LLVM.Extra.Multi.Value LLVM.Extra.Multi.Value.Vector+ LLVM.Extra.Multi.Value.Marshal+ LLVM.Extra.Multi.Value.Storable LLVM.Extra.Multi.Vector LLVM.Extra.Multi.Vector.Instance LLVM.Extra.Multi.Class@@ -122,8 +124,8 @@ LLVM.Extra.TuplePrivate LLVM.Extra.MaybePrivate LLVM.Extra.EitherPrivate- LLVM.Extra.MemoryPrivate LLVM.Extra.Multi.Value.Private+ LLVM.Extra.Multi.Value.Array Library private Build-Depends:@@ -160,6 +162,7 @@ Test-Suite llvm-extra-test Type: exitcode-stdio-1.0 Build-Depends:+ doctest-exitcode-stdio >=0.0 && <0.1, QuickCheck >=2.11 && <3, private, llvm-extra,@@ -167,6 +170,7 @@ tfp, storable-record, utility-ht >=0.0.1 && <0.1,+ transformers, base >=3 && <5 Default-Language: Haskell98 GHC-Options: -Wall
private/LLVM/Extra/ArithmeticPrivate.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module LLVM.Extra.ArithmeticPrivate where import qualified LLVM.Util.Intrinsic as Intrinsic
private/LLVM/Extra/ScalarOrVectorPrivate.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module LLVM.Extra.ScalarOrVectorPrivate where import qualified LLVM.Extra.ArithmeticPrivate as A@@ -20,7 +21,7 @@ import Prelude hiding (replicate) -type family Scalar vector :: *+type family Scalar vector type instance Scalar Float = Float type instance Scalar Double = Double
src/LLVM/Extra/Arithmetic.hs view
@@ -23,6 +23,7 @@ -- * transcendental functions Algebraic (sqrt), Transcendental (pi, sin, cos, exp, log, pow),+ exp2, log2, log10, ) where import qualified LLVM.Util.Intrinsic as Intrinsic@@ -105,7 +106,7 @@ mul = LLVM.mul -type family Scalar vector :: *+type family Scalar vector type instance Scalar (Value a) = Value (SoV.Scalar a) type instance Scalar (ConstValue a) = ConstValue (SoV.Scalar a) @@ -234,7 +235,7 @@ class Comparison a where- type CmpResult a :: *+ type CmpResult a cmp :: LLVM.CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a) instance (LLVM.CmpRet a) => Comparison (Value a) where@@ -296,3 +297,13 @@ exp = Intrinsic.call1 "exp" log = Intrinsic.call1 "log" pow = Intrinsic.call2 "pow"+++exp2 :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+exp2 = Intrinsic.call1 "exp2"++log2 :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+log2 = Intrinsic.call1 "log2"++log10 :: (IsFloating a) => Value a -> CodeGenFunction r (Value a)+log10 = Intrinsic.call1 "log10"
src/LLVM/Extra/Array.hs view
@@ -41,7 +41,7 @@ This can be considered the inverse of 'extractAll'. -} assemble ::- (TypeNum.Natural n, LLVM.IsFirstClass a, LLVM.IsSized a) =>+ (TypeNum.Natural n, LLVM.IsSized a) => [Value a] -> CodeGenFunction r (Value (Array n a)) assemble = foldM (\v (k,x) -> LLVM.insertvalue v x (k::Word32)) Tuple.undef .@@ -53,7 +53,7 @@ This can be considered the inverse of 'assemble'. -} extractAll ::- (TypeNum.Natural n, LLVM.IsFirstClass a, LLVM.IsSized a) =>+ (TypeNum.Natural n, LLVM.IsSized a) => Value (Array n a) -> LLVM.CodeGenFunction r [Value a] extractAll x = mapM@@ -65,9 +65,7 @@ since 'LLVM.insertvalue' and 'LLVM.extractvalue' expect constant indices. -} map ::- (TypeNum.Natural n,- LLVM.IsFirstClass a, LLVM.IsSized a,- LLVM.IsFirstClass b, LLVM.IsSized b) =>+ (TypeNum.Natural n, LLVM.IsSized a, LLVM.IsSized b) => (Value a -> CodeGenFunction r (Value b)) -> (Value (Array n a) -> CodeGenFunction r (Value (Array n b))) map f =
src/LLVM/Extra/FastMath.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module LLVM.Extra.FastMath ( @@ -93,11 +92,8 @@ getNumber :: flags -> Number flags a -> a getNumber _ (Number a) = a -instance (Tuple.Value a) => Tuple.Value (Number flags a) where- type ValueOf (Number flags a) = Tuple.ValueOf a- valueOf = Tuple.valueOf . deconsNumber- instance MultiValue a => MV.C (Number flags a) where+ type Repr (Number flags a) = MV.Repr a cons = mvNumber . MV.cons . deconsNumber undef = mvNumber MV.undef zero = mvNumber MV.zero@@ -286,11 +282,8 @@ attachMultiVectorFlags $ Monad.lift mvecNumber $ f (mvecDenumber a) (mvecDenumber b) -instance (Tuple.VectorValue n a) => Tuple.VectorValue n (Number flags a) where- type VectorValueOf n (Number flags a) = Tuple.VectorValueOf n a- vectorValueOf = Tuple.vectorValueOf . fmap deconsNumber- instance (Flags flags, MultiVector a) => MultiVector.C (Number flags a) where+ type Repr n (Number flags a) = MultiVector.Repr n a cons = mvecNumber . MultiVector.cons . fmap deconsNumber undef = mvecNumber MultiVector.undef zero = mvecNumber MultiVector.zero
src/LLVM/Extra/Function.hs view
@@ -55,7 +55,7 @@ > Value a -> Value b -> ... CodeGenFunction r (Value z)@. -} class LLVM.FunctionArgs f => C f where- type CodeGen f :: *+ type CodeGen f addRet :: LP.Proxy f -> CodeGen f -> LLVM.FunctionCodeGen f instance (C b, LLVM.IsFirstClass a) => C (a -> b) where
src/LLVM/Extra/Marshal.hs view
@@ -17,7 +17,6 @@ Struct, peek, poke,- MV, VectorStruct, Vector(..),@@ -26,7 +25,6 @@ EE.alloca, ) where -import qualified LLVM.Extra.Multi.Value as MultiValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.ExecutionEngine as EE@@ -219,45 +217,6 @@ (a,b,c) -> LLVM.consStruct (packVector a) (packVector b) (packVector c) unpackVector = LLVM.uncurryStruct $ \a b c -> liftA3 (,,) (unpackVector a) (unpackVector b) (unpackVector c)----class (C a, MultiValue.C a) => MV a where--instance MV Float where-instance MV Double where-instance MV Word where-instance MV Word8 where-instance MV Word16 where-instance MV Word32 where-instance MV Word64 where-instance MV Int where-instance MV Int8 where-instance MV Int16 where-instance MV Int32 where-instance MV Int64 where--instance (Storable a) => MV (Ptr a) where-instance (LLVM.IsType a) => MV (LLVM.Ptr a) where-instance (LLVM.IsFunction a) => MV (FunPtr a) where-instance MV (StablePtr a) where--instance MV () where--instance- (LLVM.IsSized (Struct a), LLVM.IsSized (Struct b), MV a, MV b) =>- MV (a,b) where--instance- (LLVM.IsSized (Struct a), LLVM.IsSized (Struct b), LLVM.IsSized (Struct c),- MV a, MV b, MV c) =>- MV (a,b,c) where--instance- (LLVM.IsSized (Struct a), LLVM.IsSized (Struct b),- LLVM.IsSized (Struct c), LLVM.IsSized (Struct d),- MV a, MV b, MV c, MV d) =>- MV (a,b,c,d) where with :: (C a) => a -> (LLVM.Ptr (Struct a) -> IO b) -> IO b
src/LLVM/Extra/MaybeContinuation.hs view
@@ -46,11 +46,11 @@ fmap f (Cons m) = Cons $ \n j -> m n (j . f) instance App.Applicative (T r z) where- pure = return+ pure a = lift (pure a) (<*>) = M.ap instance Monad (T r z) where- return a = lift (return a)+ return = pure (>>=) = bind instance MonadIO (T r z) where
src/LLVM/Extra/Memory.hs view
@@ -12,10 +12,8 @@ loadNewtype, storeNewtype, decomposeNewtype, composeNewtype, ) where -import LLVM.Extra.MemoryPrivate (decomposeFromLoad, composeFromStore, )- import qualified LLVM.Extra.Multi.Vector as MultiVector-import qualified LLVM.Extra.Multi.Value as MultiValue+import qualified LLVM.Extra.Multi.Value.Private as MultiValue import qualified LLVM.Extra.Scalar as Scalar import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Struct as Struct@@ -38,6 +36,8 @@ import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold import qualified Data.FixedLength as FixedLength+import qualified Data.Complex as Complex+import Data.Complex (Complex((:+))) import Data.Tuple.HT (fst3, snd3, thd3, ) import Data.Word (Word) @@ -61,16 +61,33 @@ -} class (Tuple.Phi llvmValue, Tuple.Undefined llvmValue, IsType (Struct llvmValue), IsSized (Struct llvmValue)) => C llvmValue where- {-# MINIMAL (load|decompose), (store|compose) #-}- type Struct llvmValue :: *+ type Struct llvmValue load :: Value (LLVM.Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue load ptr = decompose =<< LLVM.load ptr store :: llvmValue -> Value (LLVM.Ptr (Struct llvmValue)) -> CodeGenFunction r () store r ptr = flip LLVM.store ptr =<< compose r+ {- |+ In principle it holds:++ > decompose struct = do+ > ptr <- LLVM.alloca+ > LLVM.store struct ptr+ > Memory.load ptr++ but 'LLVM.alloca' will blast your stack when used in a loop.+ -} decompose :: Value (Struct llvmValue) -> CodeGenFunction r llvmValue- decompose = decomposeFromLoad load+ {- |+ In principle it holds:++ > compose struct = do+ > ptr <- LLVM.alloca+ > Memory.store struct ptr+ > LLVM.load ptr++ but 'LLVM.alloca' will blast your stack when used in a loop.+ -} compose :: llvmValue -> CodeGenFunction r (Value (Struct llvmValue))- compose = composeFromStore store modify :: (C llvmValue) =>@@ -218,6 +235,22 @@ compose = composeRecord quadruple +complex ::+ (C a) =>+ Record r (LLVM.Struct (Struct a, (Struct a, ()))) (Complex a)+complex =+ liftA2 (:+)+ (element Complex.realPart d0)+ (element Complex.imagPart d1)++instance (C a) => C (Complex a) where+ type Struct (Complex a) = LLVM.Struct (Struct a, (Struct a, ()))+ load = loadRecord complex+ store = storeRecord complex+ decompose = decomposeRecord complex+ compose = composeRecord complex++ instance (Unary.Natural n, C a, TypeNum.Natural (TypeNum.FromUnary n),@@ -281,7 +314,7 @@ compose = composeNewtype Scalar.decons -instance (IsSized a, LLVM.IsFirstClass a) => C (Value a) where+instance (IsSized a) => C (Value a) where type Struct (Value a) = a load = LLVM.load store = LLVM.store@@ -330,17 +363,24 @@ -instance (MultiValue.C a, C (Tuple.ValueOf a)) => C (MultiValue.T a) where- type Struct (MultiValue.T a) = Struct (Tuple.ValueOf a)+-- redundant IsType and IsSized constraints required for loopy instance+instance+ (IsType (Struct (MultiValue.Repr a)),+ IsSized (Struct (MultiValue.Repr a)),+ MultiValue.C a, C (MultiValue.Repr a)) =>+ C (MultiValue.T a) where+ type Struct (MultiValue.T a) = Struct (MultiValue.Repr a) load = fmap MultiValue.Cons . load store (MultiValue.Cons a) = store a decompose = fmap MultiValue.Cons . decompose compose (MultiValue.Cons a) = compose a instance- (TypeNum.Positive n, MultiVector.C a, C (Tuple.VectorValueOf n a)) =>+ (IsType (Struct (MultiVector.Repr n a)),+ IsSized (Struct (MultiVector.Repr n a)),+ TypeNum.Positive n, MultiVector.C a, C (MultiVector.Repr n a)) => C (MultiVector.T n a) where- type Struct (MultiVector.T n a) = Struct (Tuple.VectorValueOf n a)+ type Struct (MultiVector.T n a) = Struct (MultiVector.Repr n a) load = fmap MultiVector.Cons . load store (MultiVector.Cons a) = store a decompose = fmap MultiVector.Cons . decompose
− src/LLVM/Extra/MemoryPrivate.hs
@@ -1,23 +0,0 @@-module LLVM.Extra.MemoryPrivate where--import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, Value, )---decomposeFromLoad ::- LLVM.IsSized struct =>- (Value (LLVM.Ptr struct) -> CodeGenFunction r a) ->- Value struct -> CodeGenFunction r a-decomposeFromLoad loadStruct struct = do- ptr <- LLVM.alloca- LLVM.store struct ptr- loadStruct ptr--composeFromStore ::- LLVM.IsSized struct =>- (a -> Value (LLVM.Ptr struct) -> CodeGenFunction r ()) ->- a -> CodeGenFunction r (Value struct)-composeFromStore storeStruct x = do- ptr <- LLVM.alloca- storeStruct x ptr- LLVM.load ptr
src/LLVM/Extra/Multi/Class.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module LLVM.Extra.Multi.Class where import qualified LLVM.Extra.Multi.Value as MultiValue@@ -11,7 +12,7 @@ class C value where- type Size value :: *+ type Size value switch :: f MultiValue.T -> f (MultiVector.T (Size value)) ->
src/LLVM/Extra/Multi/Value.hs view
@@ -1,6 +1,8 @@ module LLVM.Extra.Multi.Value ( module LLVM.Extra.Multi.Value.Private,+ Array(..), withArraySize, extractArrayValue, insertArrayValue, ) where import LLVM.Extra.Multi.Vector.Instance ()+import LLVM.Extra.Multi.Value.Array import LLVM.Extra.Multi.Value.Private
+ src/LLVM/Extra/Multi/Value/Array.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+module LLVM.Extra.Multi.Value.Array where++import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Multi.Value.Marshal as Marshal+import qualified LLVM.Extra.Multi.Value.Private as MultiValue+import LLVM.Extra.Multi.Value.Private (Repr)++import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum+import qualified Type.Data.Num.Decimal.Number as Dec+import Type.Base.Proxy (Proxy(Proxy))++import Control.Applicative (Applicative(pure, (<*>)))++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import Data.Functor.Identity (Identity(Identity, runIdentity))+import Data.Functor ((<$>))++import Prelude2010+import Prelude ()++++newtype Array n a = Array [a]+ deriving (Eq, Show)++instance (Dec.Integer n) => Functor (Array n) where+ fmap f (Array xs) = Array (map f xs)++instance (Dec.Integer n) => Applicative (Array n) where+ pure x =+ runIdentity $ withArraySize $+ \n -> Identity $ Array $ replicate (Dec.integralFromProxy n) x+ Array fs <*> Array xs = Array $ zipWith id fs xs++instance (Dec.Integer n) => Fold.Foldable (Array n) where+ foldMap f (Array xs) = Fold.foldMap f xs++instance (Dec.Integer n) => Trav.Traversable (Array n) where+ traverse f (Array xs) = Array <$> Trav.traverse f xs++withArraySize :: (Proxy n -> gen (Array n a)) -> gen (Array n a)+withArraySize f = f Proxy+++instance (TypeNum.Natural n, Marshal.C a) => MultiValue.C (Array n a) where+ type Repr (Array n a) = LLVM.Value (LLVM.Array n (Marshal.Struct a))+ cons (Array xs) = MultiValue.consPrimitive $ LLVM.Array $ map Marshal.pack xs+ undef = MultiValue.undefPrimitive+ zero = MultiValue.zeroPrimitive+ phi = MultiValue.phiPrimitive+ addPhi = MultiValue.addPhiPrimitive++instance+ (TypeNum.Natural n, Marshal.C a,+ Dec.Natural (n Dec.:*: LLVM.SizeOf (Marshal.Struct a))) =>+ Marshal.C (Array n a) where+ pack (Array xs) = LLVM.Array $ map Marshal.pack xs+ unpack (LLVM.Array xs) = Array $ map Marshal.unpack xs++extractArrayValue ::+ (TypeNum.Natural n, LLVM.ArrayIndex n i, Marshal.C a) =>+ i -> MultiValue.T (Array n a) ->+ LLVM.CodeGenFunction r (MultiValue.T a)+extractArrayValue i (MultiValue.Cons arr) =+ MultiValue.Cons <$> (Memory.decompose =<< LLVM.extractvalue arr i)++insertArrayValue ::+ (TypeNum.Natural n, LLVM.ArrayIndex n i, Marshal.C a) =>+ i -> MultiValue.T a -> MultiValue.T (Array n a) ->+ LLVM.CodeGenFunction r (MultiValue.T (Array n a))+insertArrayValue i (MultiValue.Cons a) (MultiValue.Cons arr) =+ MultiValue.Cons <$> (flip (LLVM.insertvalue arr) i =<< Memory.compose a)
+ src/LLVM/Extra/Multi/Value/Marshal.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{- |+Transfer values between Haskell and JIT generated code+in an LLVM-compatible format.+E.g. 'Bool' is stored as 'i1' and occupies a byte,+@'Vector' n 'Bool'@ is stored as a bit vector,+@'Vector' n 'Word8'@ is stored in an order depending on machine endianess,+and Haskell tuples are stored as LLVM structs.+-}+module LLVM.Extra.Multi.Value.Marshal (+ C(..),+ Struct,+ peek,+ poke,++ VectorStruct,+ Vector(..),++ with,+ EE.alloca,+ ) where++import qualified LLVM.Extra.Multi.Vector as MultiVector+import qualified LLVM.Extra.Multi.Value.Private as MultiValue+import qualified LLVM.Extra.Memory as Memory+import LLVM.Extra.Multi.Vector.Instance ()++import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Core as LLVM++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Control.Functor.HT as FuncHT+import Control.Applicative (liftA2, liftA3, (<$>))++import Foreign.Storable (Storable)+import Foreign.StablePtr (StablePtr)+import Foreign.Ptr (FunPtr, Ptr)++import Data.Complex (Complex((:+)))+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int (Int8, Int16, Int32, Int64)++++peek ::+ (C a, Struct a ~ struct, EE.Marshal struct) => LLVM.Ptr struct -> IO a+peek ptr = unpack <$> EE.peek ptr++poke ::+ (C a, Struct a ~ struct, EE.Marshal struct) => LLVM.Ptr struct -> a -> IO ()+poke ptr = EE.poke ptr . pack+++type Struct a = Memory.Struct (MultiValue.Repr a)++class+ (MultiValue.C a, Memory.C (MultiValue.Repr a),+ EE.Marshal (Struct a), LLVM.IsConst (Struct a)) =>+ C a where+ pack :: a -> Struct a+ unpack :: Struct a -> a++instance C Bool where pack = id; unpack = id+instance C Float where pack = id; unpack = id+instance C Double where pack = id; unpack = id+instance C Word where pack = id; unpack = id+instance C Word8 where pack = id; unpack = id+instance C Word16 where pack = id; unpack = id+instance C Word32 where pack = id; unpack = id+instance C Word64 where pack = id; unpack = id+instance C Int where pack = id; unpack = id+instance C Int8 where pack = id; unpack = id+instance C Int16 where pack = id; unpack = id+instance C Int32 where pack = id; unpack = id+instance C Int64 where pack = id; unpack = id++instance (Storable a) => C (Ptr a) where pack = id; unpack = id+instance (LLVM.IsType a) => C (LLVM.Ptr a) where pack = id; unpack = id+instance (LLVM.IsFunction a) => C (FunPtr a) where pack = id; unpack = id+instance C (StablePtr a) where pack = id; unpack = id++instance C () where+ pack = LLVM.Struct+ unpack (LLVM.Struct unit) = unit++instance (C a, C b) => C (a,b) where+ pack (a,b) = LLVM.consStruct (pack a) (pack b)+ unpack = LLVM.uncurryStruct $ \a b -> (unpack a, unpack b)++instance (C a, C b, C c) => C (a,b,c) where+ pack (a,b,c) = LLVM.consStruct (pack a) (pack b) (pack c)+ unpack = LLVM.uncurryStruct $ \a b c -> (unpack a, unpack b, unpack c)++instance (C a, C b, C c, C d) => C (a,b,c,d) where+ pack (a,b,c,d) = LLVM.consStruct (pack a) (pack b) (pack c) (pack d)+ unpack =+ LLVM.uncurryStruct $ \a b c d -> (unpack a, unpack b, unpack c, unpack d)+++instance (C a) => C (Complex a) where+ pack (a:+b) = LLVM.consStruct (pack a) (pack b)+ unpack = LLVM.uncurryStruct $ \a b -> unpack a :+ unpack b++++type VectorStruct n a = Memory.Struct (MultiVector.Repr n a)++class+ (TypeNum.Positive n, C a,+ MultiVector.C a, Memory.C (MultiVector.Repr n a),+ EE.Marshal (VectorStruct n a),+ LLVM.IsConst (VectorStruct n a)) =>+ Vector n a where+ packVector :: LLVM.Vector n a -> VectorStruct n a+ unpackVector :: VectorStruct n a -> LLVM.Vector n a++instance (TypeNum.Positive n, Vector n a) => C (LLVM.Vector n a) where+ pack = packVector; unpack = unpackVector+++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D1)) =>+ Vector n Bool where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+ Vector n Float where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+ Vector n Double where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: LLVM.IntSize)) =>+ Vector n Word where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D8)) =>+ Vector n Word8 where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D16)) =>+ Vector n Word16 where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+ Vector n Word32 where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+ Vector n Word64 where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: LLVM.IntSize)) =>+ Vector n Int where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D8)) =>+ Vector n Int8 where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D16)) =>+ Vector n Int16 where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D32)) =>+ Vector n Int32 where+ packVector = id+ unpackVector = id++instance+ (TypeNum.Positive n, TypeNum.Natural (n TypeNum.:*: TypeNum.D64)) =>+ Vector n Int64 where+ packVector = id+ unpackVector = id++instance (Vector n a, Vector n b) => Vector n (a,b) where+ packVector x =+ case FuncHT.unzip x of+ (a,b) -> LLVM.consStruct (packVector a) (packVector b)+ unpackVector = LLVM.uncurryStruct $ \a b ->+ liftA2 (,) (unpackVector a) (unpackVector b)++instance (Vector n a, Vector n b, Vector n c) => Vector n (a,b,c) where+ packVector x =+ case FuncHT.unzip3 x of+ (a,b,c) -> LLVM.consStruct (packVector a) (packVector b) (packVector c)+ unpackVector = LLVM.uncurryStruct $ \a b c ->+ liftA3 (,,) (unpackVector a) (unpackVector b) (unpackVector c)+++with :: (C a) => a -> (LLVM.Ptr (Struct a) -> IO b) -> IO b+with a act = EE.alloca $ \ptr -> poke ptr a >> act ptr
src/LLVM/Extra/Multi/Value/Private.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -9,8 +10,8 @@ import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Struct as Struct-import qualified LLVM.Extra.MaybePrivate as Maybe +import qualified LLVM.ExecutionEngine as EE import qualified LLVM.Core as LLVM import LLVM.Core (WordN, IntN, ) @@ -43,10 +44,11 @@ import Prelude (Float, Double, Integer, Rational, ) -newtype T a = Cons (Tuple.ValueOf a)+newtype T a = Cons (Repr a) class C a where+ type Repr a cons :: a -> T a undef :: T a zero :: T a@@ -54,6 +56,7 @@ addPhi :: LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r () instance C Bool where+ type Repr Bool = LLVM.Value Bool cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -61,6 +64,7 @@ addPhi = addPhiPrimitive instance C Float where+ type Repr Float = LLVM.Value Float cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -68,6 +72,7 @@ addPhi = addPhiPrimitive instance C Double where+ type Repr Double = LLVM.Value Double cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -75,6 +80,7 @@ addPhi = addPhiPrimitive instance C Word where+ type Repr Word = LLVM.Value Word cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -82,6 +88,7 @@ addPhi = addPhiPrimitive instance C Word8 where+ type Repr Word8 = LLVM.Value Word8 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -89,6 +96,7 @@ addPhi = addPhiPrimitive instance C Word16 where+ type Repr Word16 = LLVM.Value Word16 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -96,6 +104,7 @@ addPhi = addPhiPrimitive instance C Word32 where+ type Repr Word32 = LLVM.Value Word32 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -103,6 +112,7 @@ addPhi = addPhiPrimitive instance C Word64 where+ type Repr Word64 = LLVM.Value Word64 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -110,6 +120,7 @@ addPhi = addPhiPrimitive instance (Dec.Positive n) => C (LLVM.WordN n) where+ type Repr (LLVM.WordN n) = LLVM.Value (LLVM.WordN n) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -117,6 +128,7 @@ addPhi = addPhiPrimitive instance C Int where+ type Repr Int = LLVM.Value Int cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -124,6 +136,7 @@ addPhi = addPhiPrimitive instance C Int8 where+ type Repr Int8 = LLVM.Value Int8 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -131,6 +144,7 @@ addPhi = addPhiPrimitive instance C Int16 where+ type Repr Int16 = LLVM.Value Int16 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -138,6 +152,7 @@ addPhi = addPhiPrimitive instance C Int32 where+ type Repr Int32 = LLVM.Value Int32 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -145,6 +160,7 @@ addPhi = addPhiPrimitive instance C Int64 where+ type Repr Int64 = LLVM.Value Int64 cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -152,6 +168,7 @@ addPhi = addPhiPrimitive instance (Dec.Positive n) => C (LLVM.IntN n) where+ type Repr (LLVM.IntN n) = LLVM.Value (LLVM.IntN n) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -159,6 +176,7 @@ addPhi = addPhiPrimitive instance (LLVM.IsType a) => C (LLVM.Ptr a) where+ type Repr (LLVM.Ptr a) = LLVM.Value (LLVM.Ptr a) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -166,6 +184,7 @@ addPhi = addPhiPrimitive instance C (Ptr a) where+ type Repr (Ptr a) = LLVM.Value (Ptr a) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -173,6 +192,7 @@ addPhi = addPhiPrimitive instance (LLVM.IsFunction a) => C (FunPtr a) where+ type Repr (FunPtr a) = LLVM.Value (FunPtr a) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -180,6 +200,7 @@ addPhi = addPhiPrimitive instance C (StablePtr a) where+ type Repr (StablePtr a) = LLVM.Value (StablePtr a) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -187,82 +208,82 @@ addPhi = addPhiPrimitive +cast :: (Repr a ~ Repr b) => T a -> T b+cast (Cons a) = Cons a++ consPrimitive ::- (LLVM.IsConst al, LLVM.Value al ~ Tuple.ValueOf a) =>+ (LLVM.IsConst al, LLVM.Value al ~ Repr a) => al -> T a consPrimitive = Cons . LLVM.valueOf undefPrimitive, zeroPrimitive ::- (LLVM.IsType al, LLVM.Value al ~ Tuple.ValueOf a) =>+ (LLVM.IsType al, LLVM.Value al ~ Repr a) => T a undefPrimitive = Cons $ LLVM.value LLVM.undef zeroPrimitive = Cons $ LLVM.value LLVM.zero phiPrimitive ::- (LLVM.IsFirstClass al, LLVM.Value al ~ Tuple.ValueOf a) =>+ (LLVM.IsFirstClass al, LLVM.Value al ~ Repr a) => LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a) phiPrimitive bb (Cons a) = fmap Cons $ Tuple.phi bb a addPhiPrimitive ::- (LLVM.IsFirstClass al, LLVM.Value al ~ Tuple.ValueOf a) =>+ (LLVM.IsFirstClass al, LLVM.Value al ~ Repr a) => LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r () addPhiPrimitive bb (Cons a) (Cons b) = Tuple.addPhi bb a b -consTuple ::- (Tuple.Value a) =>- a -> T a+consTuple :: (Tuple.Value a, Repr a ~ Tuple.ValueOf a) => a -> T a consTuple = Cons . Tuple.valueOf -undefTuple ::- (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Undefined al) =>- T a+undefTuple :: (Repr a ~ al, Tuple.Undefined al) => T a undefTuple = Cons Tuple.undef -zeroTuple ::- (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Zero al) =>- T a+zeroTuple :: (Repr a ~ al, Tuple.Zero al) => T a zeroTuple = Cons Tuple.zero phiTuple ::- (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Phi al) =>+ (Repr a ~ al, Tuple.Phi al) => LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a) phiTuple bb (Cons a) = fmap Cons $ Tuple.phi bb a addPhiTuple ::- (Tuple.Value a, Tuple.ValueOf a ~ al, Tuple.Phi al) =>+ (Repr a ~ al, Tuple.Phi al) => LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r () addPhiTuple bb (Cons a) (Cons b) = Tuple.addPhi bb a b instance C () where+ type Repr () = () cons = consUnit undef = undefUnit zero = zeroUnit phi = phiUnit addPhi = addPhiUnit -consUnit :: (Tuple.ValueOf a ~ ()) => a -> T a+consUnit :: (Repr a ~ ()) => a -> T a consUnit _ = Cons () -undefUnit :: (Tuple.ValueOf a ~ ()) => T a+undefUnit :: (Repr a ~ ()) => T a undefUnit = Cons () -zeroUnit :: (Tuple.ValueOf a ~ ()) => T a+zeroUnit :: (Repr a ~ ()) => T a zeroUnit = Cons () phiUnit ::- (Tuple.ValueOf a ~ ()) =>+ (Repr a ~ ()) => LLVM.BasicBlock -> T a -> LLVM.CodeGenFunction r (T a) phiUnit _bb (Cons ()) = return $ Cons () addPhiUnit ::- (Tuple.ValueOf a ~ ()) =>+ (Repr a ~ ()) => LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r () addPhiUnit _bb (Cons ()) (Cons ()) = return () instance C Bool8 where+ type Repr Bool8 = LLVM.Value Bool cons = consPrimitive . Bool8.toBool undef = undefPrimitive zero = zeroPrimitive@@ -286,6 +307,7 @@ instance (LLVM.IsInteger w, LLVM.IsConst w, P.Num w, P.Enum e) => C (Enum.T w e) where+ type Repr (Enum.T w e) = LLVM.Value w cons = consPrimitive . P.fromIntegral . P.fromEnum . Enum.toPlain undef = undefPrimitive zero = zeroPrimitive@@ -293,12 +315,12 @@ addPhi = addPhiPrimitive toEnum ::- (Tuple.ValueOf w ~ LLVM.Value w) =>+ (Repr w ~ LLVM.Value w) => T w -> T (Enum.T w e) toEnum (Cons w) = Cons w fromEnum ::- (Tuple.ValueOf w ~ LLVM.Value w) =>+ (Repr w ~ LLVM.Value w) => T (Enum.T w e) -> T w fromEnum (Cons w) = Cons w @@ -327,6 +349,7 @@ instance (LLVM.IsInteger w, LLVM.IsConst w) => C (EnumBitSet.T w i) where+ type Repr (EnumBitSet.T w i) = LLVM.Value w cons = consPrimitive . EnumBitSet.decons undef = undefPrimitive zero = zeroPrimitive@@ -335,6 +358,7 @@ instance (C a) => C (Maybe a) where+ type Repr (Maybe a) = (LLVM.Value Bool, Repr a) cons Nothing = nothing cons (Just a) = just $ cons a undef = toMaybe undef undef@@ -349,10 +373,10 @@ addPhi bb xa ya splitMaybe :: T (Maybe a) -> (T Bool, T a)-splitMaybe (Cons (Maybe.Cons b a)) = (Cons b, Cons a)+splitMaybe (Cons (b,a)) = (Cons b, Cons a) toMaybe :: T Bool -> T a -> T (Maybe a)-toMaybe (Cons b) (Cons a) = Cons (Maybe.Cons b a)+toMaybe (Cons b) (Cons a) = Cons (b,a) nothing :: (C a) => T (Maybe a) nothing = toMaybe (cons False) undef@@ -362,6 +386,7 @@ instance (C a, C b) => C (a,b) where+ type Repr (a, b) = (Repr a, Repr b) cons (a,b) = zip (cons a) (cons b) undef = zip undef undef zero = zip zero zero@@ -376,6 +401,7 @@ addPhi bb a1 b1 instance (C a, C b, C c) => C (a,b,c) where+ type Repr (a, b, c) = (Repr a, Repr b, Repr c) cons (a,b,c) = zip3 (cons a) (cons b) (cons c) undef = zip3 undef undef undef zero = zip3 zero zero zero@@ -391,6 +417,7 @@ addPhi bb a2 b2 instance (C a, C b, C c, C d) => C (a,b,c,d) where+ type Repr (a, b, c, d) = (Repr a, Repr b, Repr c, Repr d) cons (a,b,c,d) = zip4 (cons a) (cons b) (cons c) (cons d) undef = zip4 undef undef undef undef zero = zip4 zero zero zero zero@@ -491,6 +518,7 @@ instance (C tuple) => C (StoreTuple.Tuple tuple) where+ type Repr (StoreTuple.Tuple tuple) = Repr tuple cons = tuple . cons . StoreTuple.getTuple undef = tuple undef zero = tuple zero@@ -514,6 +542,7 @@ LLVM.BasicBlock -> T a -> T a -> LLVM.CodeGenFunction r () instance (Struct struct) => C (Struct.T struct) where+ type Repr (Struct.T struct) = Struct.T (Repr struct) cons = consStruct undef = undefStruct zero = zeroStruct@@ -546,7 +575,17 @@ ((a,as), (b,bs)) -> addPhi bb a b >> addPhiStruct bb as bs +instance (LLVM.IsConst a, LLVM.IsFirstClass a) => C (EE.Stored a) where+ type Repr (EE.Stored a) = LLVM.Value a+ cons = Cons . LLVM.valueOf . EE.getStored+ undef = undefPrimitive+ zero = zeroPrimitive+ phi = phiPrimitive+ addPhi = addPhiPrimitive++ instance C a => C (Tagged tag a) where+ type Repr (Tagged tag a) = Repr a cons = tag . cons . unTagged undef = tag undef zero = tag zero@@ -554,10 +593,10 @@ addPhi bb a b = addPhi bb (untag a) (untag b) tag :: T a -> T (Tagged tag a)-tag (Cons a) = Cons a+tag = cast untag :: T (Tagged tag a) -> T a-untag (Cons a) = Cons a+untag = cast liftTaggedM :: (Monad m) => (T a -> m (T b)) -> T (Tagged tag a) -> m (T (Tagged tag b))@@ -571,6 +610,7 @@ instance (C a) => C (Complex a) where+ type Repr (Complex a) = Complex (Repr a) cons (a:+b) = consComplex (cons a) (cons b) undef = consComplex undef undef zero = consComplex zero zero@@ -769,31 +809,31 @@ -lift1 :: (Tuple.ValueOf a -> Tuple.ValueOf b) -> T a -> T b+lift1 :: (Repr a -> Repr b) -> T a -> T b lift1 f (Cons a) = Cons $ f a liftM0 :: (Monad m) =>- m (Tuple.ValueOf a) ->+ m (Repr a) -> m (T a) liftM0 f = Monad.lift Cons f liftM :: (Monad m) =>- (Tuple.ValueOf a -> m (Tuple.ValueOf b)) ->+ (Repr a -> m (Repr b)) -> T a -> m (T b) liftM f (Cons a) = Monad.lift Cons $ f a liftM2 :: (Monad m) =>- (Tuple.ValueOf a -> Tuple.ValueOf b -> m (Tuple.ValueOf c)) ->+ (Repr a -> Repr b -> m (Repr c)) -> T a -> T b -> m (T c) liftM2 f (Cons a) (Cons b) = Monad.lift Cons $ f a b liftM3 :: (Monad m) =>- (Tuple.ValueOf a -> Tuple.ValueOf b -> Tuple.ValueOf c ->- m (Tuple.ValueOf d)) ->+ (Repr a -> Repr b -> Repr c ->+ m (Repr d)) -> T a -> T b -> T c -> m (T d) liftM3 f (Cons a) (Cons b) (Cons c) = Monad.lift Cons $ f a b c @@ -981,7 +1021,7 @@ fdiv = fdiv -type family Scalar vector :: *+type family Scalar vector type instance Scalar Float = Float type instance Scalar Double = Double type instance Scalar (Tagged tag a) = Tagged tag (Scalar a)@@ -1128,7 +1168,7 @@ class- (Tuple.ValueOf i ~ LLVM.Value ir,+ (Repr i ~ LLVM.Value ir, LLVM.IsInteger ir, SoV.IntegerConstant ir, LLVM.CmpRet ir, LLVM.IsPrimitive ir) => NativeInteger i ir where@@ -1149,7 +1189,7 @@ class- (Tuple.ValueOf a ~ LLVM.Value ar,+ (Repr a ~ LLVM.Value ar, LLVM.IsFloating ar, SoV.RationalConstant ar, LLVM.CmpRet ar, LLVM.IsPrimitive ar) => NativeFloating a ar where
+ src/LLVM/Extra/Multi/Value/Storable.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module LLVM.Extra.Multi.Value.Storable (+ -- * Basic class+ C(load, store),+ storeNext,+ modify,++ -- * Classes for tuples and vectors+ Tuple(..),+ Vector(..),+ TupleVector(..),++ -- * Standard method implementations+ loadTraversable,+ loadApplicative,+ storeFoldable,++ -- * Pointer handling+ Storable.advancePtr,+ Storable.incrementPtr,+ Storable.decrementPtr,++ -- * Loops over Storable arrays+ Array.arrayLoop,+ Array.arrayLoop2,+ Array.arrayLoopMaybeCont,+ Array.arrayLoopMaybeCont2,+ ) where++import qualified LLVM.Extra.Storable.Private as Storable+import qualified LLVM.Extra.Storable.Array as Array+import LLVM.Extra.Storable.Private+ (BytePtr, advancePtrStatic, incPtrState, incrementPtr, update,+ castFromBytePtr, castToBytePtr,+ runElements, elementOffset, castElementPtr,+ assemblePrimitive, disassemblePrimitive, proxyFromElement3)++import qualified LLVM.Extra.Multi.Vector as MultiVector+import qualified LLVM.Extra.Multi.Value as MultiValue+import qualified LLVM.Extra.ArithmeticPrivate as A++import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Util.Proxy as LP+import qualified LLVM.Core as LLVM+import LLVM.Core (CodeGenFunction, Value)++import qualified Type.Data.Num.Decimal as TypeNum++import qualified Control.Monad.Trans.Class as MT+import qualified Control.Monad.Trans.Reader as MR+import qualified Control.Monad.Trans.State as MS+import qualified Control.Applicative.HT as App+import qualified Control.Functor.HT as FuncHT+import Control.Monad (foldM, replicateM, replicateM_, (<=<))+import Control.Applicative (Applicative, pure, (<$>))++import qualified Foreign.Storable.Record.Tuple as StoreTuple+import qualified Foreign.Storable as Store+import Foreign.Ptr (Ptr)++import qualified Data.NonEmpty.Class as NonEmptyC+import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import Data.Orphans ()+import Data.Tuple.HT (uncurry3)+import Data.Complex (Complex)+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Bool8 (Bool8)++++class (Store.Storable a, MultiValue.C a) => C a where+ {-+ Not all Storable types have a compatible LLVM type,+ or even more, one LLVM type that is compatible on all platforms.+ -}+ load :: Value (Ptr a) -> CodeGenFunction r (MultiValue.T a)+ store :: MultiValue.T a -> Value (Ptr a) -> CodeGenFunction r ()++storeNext ::+ (C a, Value (Ptr a) ~ ptr) => MultiValue.T a -> ptr -> CodeGenFunction r ptr+storeNext a ptr = store a ptr >> incrementPtr ptr++modify ::+ (C a, MultiValue.T a ~ al) =>+ (al -> CodeGenFunction r al) ->+ Value (Ptr a) -> CodeGenFunction r ()+modify f ptr = flip store ptr =<< f =<< load ptr+++instance+ (EE.Marshal a, LLVM.IsConst a, LLVM.IsFirstClass a) =>+ C (EE.Stored a) where+ load = fmap MultiValue.Cons . LLVM.load <=< castFromStoredPtr+ store (MultiValue.Cons a) = LLVM.store a <=< castFromStoredPtr++castFromStoredPtr ::+ (LLVM.IsType a) =>+ Value (Ptr (EE.Stored a)) -> CodeGenFunction r (Value (LLVM.Ptr a))+castFromStoredPtr = LLVM.bitcast+++loadPrimitive ::+ (LLVM.Storable a, MultiValue.Repr a ~ LLVM.Value a) =>+ Value (Ptr a) -> CodeGenFunction r (MultiValue.T a)+loadPrimitive ptr = fmap MultiValue.Cons $ LLVM.load =<< LLVM.bitcast ptr++storePrimitive ::+ (LLVM.Storable a, MultiValue.Repr a ~ LLVM.Value a) =>+ MultiValue.T a -> Value (Ptr a) -> CodeGenFunction r ()+storePrimitive (MultiValue.Cons a) ptr = LLVM.store a =<< LLVM.bitcast ptr++instance C Float where+ load = loadPrimitive; store = storePrimitive++instance C Double where+ load = loadPrimitive; store = storePrimitive++instance C Word where+ load = loadPrimitive; store = storePrimitive++instance C Word8 where+ load = loadPrimitive; store = storePrimitive++instance C Word16 where+ load = loadPrimitive; store = storePrimitive++instance C Word32 where+ load = loadPrimitive; store = storePrimitive++instance C Word64 where+ load = loadPrimitive; store = storePrimitive++instance C Int where+ load = loadPrimitive; store = storePrimitive++instance C Int8 where+ load = loadPrimitive; store = storePrimitive++instance C Int16 where+ load = loadPrimitive; store = storePrimitive++instance C Int32 where+ load = loadPrimitive; store = storePrimitive++instance C Int64 where+ load = loadPrimitive; store = storePrimitive++{- |+Not very efficient implementation+because we want to adapt to @sizeOf Bool@ dynamically.+Unfortunately, LLVM-9's optimizer does not recognize the instruction pattern.+Better use 'Bool8' for booleans.+-}+instance C Bool where+ load ptr = do+ bytePtr <- castToBytePtr ptr+ bytes <-+ flip MS.evalStateT bytePtr $+ replicateM (Store.sizeOf (False :: Bool))+ (MT.lift . LLVM.load =<< incPtrState)+ let zero = LLVM.valueOf 0+ mask <- foldM A.or zero bytes+ MultiValue.Cons <$> A.cmp LLVM.CmpNE mask zero+ store (MultiValue.Cons b) ptr = do+ bytePtr <- castToBytePtr ptr+ byte <- LLVM.sext b+ flip MS.evalStateT bytePtr $+ replicateM_ (Store.sizeOf (False :: Bool))+ (MT.lift . LLVM.store byte =<< incPtrState)++instance C Bool8 where+ load ptr =+ fmap MultiValue.Cons $+ A.cmp LLVM.CmpNE (LLVM.valueOf 0) =<< LLVM.load =<< castToBytePtr ptr+ store (MultiValue.Cons b) ptr = do+ byte <- LLVM.zext b+ LLVM.store byte =<< castToBytePtr ptr++instance (C a) => C (Complex a) where+ load = loadApplicative; store = storeFoldable++++instance (Tuple tuple) => C (StoreTuple.Tuple tuple) where+ load ptr = MultiValue.cast <$> loadTuple ptr+ store = storeTuple . MultiValue.cast++class (StoreTuple.Storable tuple, MultiValue.C tuple) => Tuple tuple where+ loadTuple ::+ Value (Ptr (StoreTuple.Tuple tuple)) ->+ CodeGenFunction r (MultiValue.T tuple)+ storeTuple ::+ MultiValue.T tuple ->+ Value (Ptr (StoreTuple.Tuple tuple)) ->+ CodeGenFunction r ()++instance (C a, C b) => Tuple (a,b) where+ loadTuple ptr =+ runElements ptr $ fmap (uncurry MultiValue.zip) $+ App.mapPair (loadElement, loadElement) $+ FuncHT.unzip $ proxyFromElement3 ptr+ storeTuple = MultiValue.uncurry $ \a b ptr ->+ case FuncHT.unzip $ proxyFromElement3 ptr of+ (pa,pb) -> runElements ptr $ storeElement pa a >> storeElement pb b++instance (C a, C b, C c) => Tuple (a,b,c) where+ loadTuple ptr =+ runElements ptr $ fmap (uncurry3 MultiValue.zip3) $+ App.mapTriple (loadElement, loadElement, loadElement) $+ FuncHT.unzip3 $ proxyFromElement3 ptr+ storeTuple = MultiValue.uncurry3 $ \a b c ptr ->+ case FuncHT.unzip3 $ proxyFromElement3 ptr of+ (pa,pb,pc) ->+ runElements ptr $+ storeElement pa a >> storeElement pb b >> storeElement pc c++loadElement ::+ (C a) =>+ LP.Proxy a ->+ MR.ReaderT BytePtr (MS.StateT Int (CodeGenFunction r)) (MultiValue.T a)+loadElement proxy =+ MT.lift . MT.lift . load =<< elementPtr proxy++storeElement ::+ (C a) =>+ LP.Proxy a -> MultiValue.T a ->+ MR.ReaderT BytePtr (MS.StateT Int (CodeGenFunction r)) ()+storeElement proxy a =+ MT.lift . MT.lift . store a =<< elementPtr proxy++elementPtr ::+ (C a) =>+ LP.Proxy a ->+ MR.ReaderT BytePtr+ (MS.StateT Int (CodeGenFunction r)) (LLVM.Value (Ptr a))+elementPtr proxy = do+ ptr <- MR.ask+ MT.lift $ do+ offset <- elementOffset proxy+ MT.lift $ castFromBytePtr =<< LLVM.getElementPtr ptr (offset, ())+++instance+ (TypeNum.Positive n, Vector a) =>+ C (LLVM.Vector n a) where+ load ptr =+ fmap MultiValue.Cons $+ assembleVector (proxyFromElement3 ptr) =<< loadApplicativeRepr ptr+ store (MultiValue.Cons a) ptr =+ flip storeFoldableRepr ptr+ =<< disassembleVector (proxyFromElement3 ptr) a++class (C a, MultiVector.C a) => Vector a where+ assembleVector ::+ (TypeNum.Positive n) =>+ LP.Proxy a -> LLVM.Vector n (MultiValue.Repr a) ->+ CodeGenFunction r (MultiVector.Repr n a)+ disassembleVector ::+ (TypeNum.Positive n) =>+ LP.Proxy a -> MultiVector.Repr n a ->+ CodeGenFunction r (LLVM.Vector n (MultiValue.Repr a))++instance Vector Float where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Double where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word8 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word16 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word32 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Word64 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int8 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int16 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int32 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Int64 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Bool where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive++instance Vector Bool8 where+ assembleVector LP.Proxy = assemblePrimitive+ disassembleVector LP.Proxy = disassemblePrimitive+++instance+ (Tuple tuple, TupleVector tuple) =>+ Vector (StoreTuple.Tuple tuple) where+ assembleVector = deinterleave . fmap StoreTuple.getTuple+ disassembleVector = interleave . fmap StoreTuple.getTuple+++class (MultiVector.C a) => TupleVector a where+ deinterleave ::+ (TypeNum.Positive n) =>+ LP.Proxy a -> LLVM.Vector n (MultiValue.Repr a) ->+ CodeGenFunction r (MultiVector.Repr n a)+ interleave ::+ (TypeNum.Positive n) =>+ LP.Proxy a -> MultiVector.Repr n a ->+ CodeGenFunction r (LLVM.Vector n (MultiValue.Repr a))++instance (Vector a, Vector b) => TupleVector (a,b) where+ deinterleave = FuncHT.uncurry $ \pa pb -> FuncHT.uncurry $ \a b ->+ App.lift2 (,) (assembleVector pa a) (assembleVector pb b)+ interleave = FuncHT.uncurry $ \pa pb (a,b) ->+ App.lift2 (App.lift2 (,))+ (disassembleVector pa a) (disassembleVector pb b)++instance (Vector a, Vector b, Vector c) => TupleVector (a,b,c) where+ deinterleave = FuncHT.uncurry3 $ \pa pb pc -> FuncHT.uncurry3 $ \a b c ->+ App.lift3 (,,)+ (assembleVector pa a)+ (assembleVector pb b)+ (assembleVector pc c)+ interleave = FuncHT.uncurry3 $ \pa pb pc (a,b,c) ->+ App.lift3 (App.lift3 (,,))+ (disassembleVector pa a)+ (disassembleVector pb b)+ (disassembleVector pc c)+++{-+instance Storable () available since base-4.9/GHC-8.0.+Before we need Data.Orphans.+-}+instance C () where+ load _ptr = return $ MultiValue.Cons ()+ store (MultiValue.Cons ()) _ptr = return ()+++loadTraversable ::+ (NonEmptyC.Repeat f, Trav.Traversable f,+ C a, MultiValue.Repr fa ~ f (MultiValue.Repr a)) =>+ Value (Ptr (f a)) -> CodeGenFunction r (MultiValue.T fa)+loadTraversable =+ (MS.evalStateT $ fmap MultiValue.Cons $+ Trav.sequence $ NonEmptyC.repeat $ loadState)+ <=< castElementPtr++loadApplicative ::+ (Applicative f, Trav.Traversable f,+ C a, MultiValue.Repr fa ~ f (MultiValue.Repr a)) =>+ Value (Ptr (f a)) -> CodeGenFunction r (MultiValue.T fa)+loadApplicative = fmap MultiValue.Cons . loadApplicativeRepr++loadApplicativeRepr ::+ (Applicative f, Trav.Traversable f, C a) =>+ Value (Ptr (f a)) -> CodeGenFunction r (f (MultiValue.Repr a))+loadApplicativeRepr =+ (MS.evalStateT $ Trav.sequence $ pure loadState) <=< castElementPtr++loadState ::+ (C a, MultiValue.Repr a ~ al) =>+ MS.StateT (Value (Ptr a)) (CodeGenFunction r) al+loadState =+ MT.lift . fmap (\(MultiValue.Cons a) -> a) . load =<< advancePtrState+++storeFoldable ::+ (Fold.Foldable f, C a, MultiValue.Repr fa ~ f (MultiValue.Repr a)) =>+ MultiValue.T fa -> Value (Ptr (f a)) -> CodeGenFunction r ()+storeFoldable (MultiValue.Cons xs) = storeFoldableRepr xs++storeFoldableRepr ::+ (Fold.Foldable f, C a) =>+ f (MultiValue.Repr a) -> Value (Ptr (f a)) -> CodeGenFunction r ()+storeFoldableRepr xs =+ MS.evalStateT (Fold.mapM_ storeState xs) <=< castElementPtr++storeState ::+ (C a, MultiValue.Repr a ~ al) =>+ al -> MS.StateT (Value (Ptr a)) (CodeGenFunction r) ()+storeState a = MT.lift . store (MultiValue.Cons a) =<< advancePtrState+++advancePtrState ::+ (C a, Value (Ptr a) ~ ptr) =>+ MS.StateT ptr (CodeGenFunction r) ptr+advancePtrState = update $ advancePtrStatic 1
src/LLVM/Extra/Multi/Value/Vector.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-} module LLVM.Extra.Multi.Value.Vector ( cons, fst, snd,@@ -11,26 +14,38 @@ extract, insert, replicate,+ iterate, dissect,+ dissect1, select, cmp, take, takeRev,++ NativeInteger,+ NativeFloating,+ fromIntegral,+ truncateToInt,+ splitFractionToInt, ) where import qualified LLVM.Extra.Multi.Vector.Instance as Inst import qualified LLVM.Extra.Multi.Vector as MultiVector import qualified LLVM.Extra.Multi.Value.Private as MultiValue+import qualified LLVM.Extra.ScalarOrVector as SoV import LLVM.Extra.Multi.Vector.Instance (MVVector) import qualified LLVM.Core as LLVM import qualified Type.Data.Num.Decimal as TypeNum ++import qualified Data.NonEmpty as NonEmpty import qualified Data.Tuple.HT as TupleHT import qualified Data.Tuple as Tuple-import Data.Word (Word32)+import Data.Word (Word8, Word16, Word32, Word64, Word)+import Data.Int (Int8, Int16, Int32, Int64, Int) -import Prelude (Bool, fmap, (.))+import Prelude (Float, Double, Bool, fmap, (.)) cons ::@@ -116,6 +131,12 @@ MultiValue.T a -> LLVM.CodeGenFunction r (MVVector n a) replicate = fmap Inst.toMultiValue . MultiVector.replicate +iterate ::+ (TypeNum.Positive n, MultiVector.C a) =>+ (MultiValue.T a -> LLVM.CodeGenFunction r (MultiValue.T a)) ->+ MultiValue.T a -> LLVM.CodeGenFunction r (MVVector n a)+iterate f = fmap Inst.toMultiValue . MultiVector.iterate f+ take :: (TypeNum.Positive n, TypeNum.Positive m, MultiVector.C a) => MVVector n a -> LLVM.CodeGenFunction r (MVVector m a)@@ -132,6 +153,11 @@ MVVector n a -> LLVM.CodeGenFunction r [MultiValue.T a] dissect = MultiVector.dissect . Inst.fromMultiValue +dissect1 ::+ (TypeNum.Positive n, MultiVector.C a) =>+ MVVector n a -> LLVM.CodeGenFunction r (NonEmpty.T [] (MultiValue.T a))+dissect1 = MultiVector.dissect1 . Inst.fromMultiValue+ select :: (TypeNum.Positive n, MultiVector.Select a) => MVVector n Bool ->@@ -145,3 +171,69 @@ MVVector n a -> MVVector n a -> LLVM.CodeGenFunction r (MVVector n Bool) cmp = Inst.liftMultiValueM2 . MultiVector.cmp+++{-+ToDo: make this a super-class of MultiValue.NativeInteger+problem: we need MultiValue.Repr, which provokes an import cycle+maybe we should break the cycle using a ConstraintKind,+i.e. define class NativeIntegerVec in MultiValue,+and define NativeInteger = MultiValue.NativeIntegerVec here+and export only MultiValueVec.NativeInteger constraint synonym.+-}+class+ (MultiValue.Repr i ~ LLVM.Value ir,+ LLVM.CmpRet ir, LLVM.IsInteger ir, SoV.IntegerConstant ir) =>+ NativeInteger i ir where++instance NativeInteger Word Word where+instance NativeInteger Word8 Word8 where+instance NativeInteger Word16 Word16 where+instance NativeInteger Word32 Word32 where+instance NativeInteger Word64 Word64 where++instance NativeInteger Int Int where+instance NativeInteger Int8 Int8 where+instance NativeInteger Int16 Int16 where+instance NativeInteger Int32 Int32 where+instance NativeInteger Int64 Int64 where++instance+ (TypeNum.Positive n, n ~ m,+ MultiVector.NativeInteger n i ir,+ MultiValue.NativeInteger i ir) =>+ NativeInteger (LLVM.Vector n i) (LLVM.Vector m ir) where+++class+ (MultiValue.Repr a ~ LLVM.Value ar,+ LLVM.CmpRet ar, SoV.RationalConstant ar, LLVM.IsFloating ar) =>+ NativeFloating a ar where++instance NativeFloating Float Float where+instance NativeFloating Double Double where++instance+ (TypeNum.Positive n, n ~ m,+ MultiVector.NativeFloating n a ar,+ MultiValue.NativeFloating a ar) =>+ NativeFloating (LLVM.Vector n a) (LLVM.Vector m ar) where++fromIntegral ::+ (NativeInteger i ir, NativeFloating a ar,+ LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>+ MultiValue.T i -> LLVM.CodeGenFunction r (MultiValue.T a)+fromIntegral = MultiValue.liftM LLVM.inttofp+++truncateToInt ::+ (NativeInteger i ir, NativeFloating a ar,+ LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>+ MultiValue.T a -> LLVM.CodeGenFunction r (MultiValue.T i)+truncateToInt = MultiValue.liftM LLVM.fptoint++splitFractionToInt ::+ (NativeInteger i ir, NativeFloating a ar,+ LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>+ MultiValue.T a -> LLVM.CodeGenFunction r (MultiValue.T (i,a))+splitFractionToInt = MultiValue.liftM SoV.splitFractionToInt
src/LLVM/Extra/Multi/Vector.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} module LLVM.Extra.Multi.Vector ( T(Cons), consPrim, deconsPrim,@@ -11,6 +14,11 @@ take, takeRev, + sum,+ dotProduct,+ cumulate,+ cumulate1,+ lift1, modify,@@ -18,6 +26,12 @@ dissect, dissectList, + assemble1,+ dissect1,+ dissectList1,++ assembleFromVector,+ reverse, rotateUp, rotateDown,@@ -42,9 +56,11 @@ Additive(..), PseudoRing(..), Field(..),+ scale, PseudoModule(..), Real(..), Fraction(..),+ NativeInteger, NativeFloating, fromIntegral, Algebraic(..), Transcendental(..), FloatingComparison(..),@@ -72,6 +88,7 @@ import qualified Data.List as List import qualified Data.Bool8 as Bool8 import Data.Traversable (mapM, sequence, )+import Data.Foldable (foldlM) import Data.NonEmpty ((!:), ) import Data.Function (flip, (.), ($), ) import Data.Tuple (snd, )@@ -86,27 +103,23 @@ import qualified Control.Applicative as App import qualified Control.Functor.HT as FuncHT import Control.Monad.HT ((<=<), )-import Control.Monad (Monad, foldM, fmap, return, (>>), (=<<), )-import Control.Applicative (liftA2, )+import Control.Monad (Monad, join, fmap, return, (>>), (=<<))+import Control.Applicative (liftA2, (<$>)) +import qualified Prelude as P import Prelude- (Float, Double, Integer, Int, Rational,- fromIntegral, asTypeOf, (-), (+), error, )+ (Float, Double, Integer, Int, Rational, asTypeOf, (-), (+), (*), error) -newtype T n a = Cons (Tuple.VectorValueOf n a)+newtype T n a = Cons (Repr n a) type Value n a = LLVM.Value (LLVM.Vector n a) -consPrim ::- (Tuple.VectorValueOf n a ~ Value n a) =>- LLVM.Value (LLVM.Vector n a) -> T n a+consPrim :: (Repr n a ~ Value n ar) => Value n ar -> T n a consPrim = Cons -deconsPrim ::- (Tuple.VectorValueOf n a ~ Value n a) =>- T n a -> LLVM.Value (LLVM.Vector n a)+deconsPrim :: (Repr n a ~ Value n ar) => T n a -> Value n ar deconsPrim (Cons a) = a @@ -121,13 +134,18 @@ addPhi = addPhi -size :: TypeNum.Positive n => T n a -> Int-size =- let sz :: TypeNum.Positive n => TypeNum.Singleton n -> T n a -> Int- sz n _ = TypeNum.integralFromSingleton n- in sz TypeNum.singleton+sizeS :: TypeNum.Positive n => T n a -> TypeNum.Singleton n+sizeS _ = TypeNum.singleton +size :: (TypeNum.Positive n, P.Integral i) => T n a -> i+size = TypeNum.integralFromSingleton . sizeS +last ::+ (TypeNum.Positive n, C a) =>+ T n a -> CodeGenFunction r (MultiValue.T a)+last x = extract (valueOf (size x - 1)) x++ zip :: T n a -> T n b -> T n (a,b) zip (Cons a) (Cons b) = Cons (a,b) @@ -142,6 +160,7 @@ class (MultiValue.C a) => C a where+ type Repr n a cons :: (TypeNum.Positive n) => LLVM.Vector n a -> T n a undef :: (TypeNum.Positive n) => T n a zero :: (TypeNum.Positive n) => T n a@@ -165,6 +184,7 @@ T n a -> CodeGenFunction r (T n a) instance C Bool where+ type Repr n Bool = LLVM.Value (LLVM.Vector n Bool) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -175,6 +195,7 @@ insert = insertPrimitive instance C Bool8 where+ type Repr n Bool8 = LLVM.Value (LLVM.Vector n Bool) cons = consPrimitive . fmap Bool8.toBool undef = undefPrimitive zero = zeroPrimitive@@ -185,6 +206,7 @@ insert = insertPrimitive instance C Float where+ type Repr n Float = LLVM.Value (LLVM.Vector n Float) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -195,6 +217,7 @@ insert = insertPrimitive instance C Double where+ type Repr n Double = LLVM.Value (LLVM.Vector n Double) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -205,6 +228,7 @@ insert = insertPrimitive instance C Int where+ type Repr n Int = LLVM.Value (LLVM.Vector n Int) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -215,6 +239,7 @@ insert = insertPrimitive instance C Int8 where+ type Repr n Int8 = LLVM.Value (LLVM.Vector n Int8) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -225,6 +250,7 @@ insert = insertPrimitive instance C Int16 where+ type Repr n Int16 = LLVM.Value (LLVM.Vector n Int16) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -235,6 +261,7 @@ insert = insertPrimitive instance C Int32 where+ type Repr n Int32 = LLVM.Value (LLVM.Vector n Int32) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -245,6 +272,7 @@ insert = insertPrimitive instance C Int64 where+ type Repr n Int64 = LLVM.Value (LLVM.Vector n Int64) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -255,6 +283,7 @@ insert = insertPrimitive instance C Word where+ type Repr n Word = LLVM.Value (LLVM.Vector n Word) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -265,6 +294,7 @@ insert = insertPrimitive instance C Word8 where+ type Repr n Word8 = LLVM.Value (LLVM.Vector n Word8) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -275,6 +305,7 @@ insert = insertPrimitive instance C Word16 where+ type Repr n Word16 = LLVM.Value (LLVM.Vector n Word16) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -285,6 +316,7 @@ insert = insertPrimitive instance C Word32 where+ type Repr n Word32 = LLVM.Value (LLVM.Vector n Word32) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -295,6 +327,7 @@ insert = insertPrimitive instance C Word64 where+ type Repr n Word64 = LLVM.Value (LLVM.Vector n Word64) cons = consPrimitive undef = undefPrimitive zero = zeroPrimitive@@ -305,37 +338,39 @@ insert = insertPrimitive consPrimitive ::- (TypeNum.Positive n,- LLVM.IsConst al, IsPrimitive al, Tuple.VectorValueOf n a ~ Value n al) =>+ (TypeNum.Positive n, LLVM.IsConst al, IsPrimitive al,+ Repr n a ~ Value n al) => LLVM.Vector n al -> T n a consPrimitive = Cons . LLVM.valueOf undefPrimitive ::- (TypeNum.Positive n, IsPrimitive al, Tuple.VectorValueOf n a ~ Value n al) =>+ (TypeNum.Positive n, IsPrimitive al,+ Repr n a ~ Value n al) => T n a undefPrimitive = Cons $ LLVM.value LLVM.undef zeroPrimitive ::- (TypeNum.Positive n, IsPrimitive al, Tuple.VectorValueOf n a ~ Value n al) =>+ (TypeNum.Positive n, IsPrimitive al,+ Repr n a ~ Value n al) => T n a zeroPrimitive = Cons $ LLVM.value LLVM.zero phiPrimitive ::- (TypeNum.Positive n, IsPrimitive al, Tuple.VectorValueOf n a ~ Value n al) =>+ (TypeNum.Positive n, IsPrimitive al, Repr n a ~ Value n al) => LLVM.BasicBlock -> T n a -> LLVM.CodeGenFunction r (T n a) phiPrimitive bb (Cons a) = fmap Cons $ Tuple.phi bb a addPhiPrimitive ::- (TypeNum.Positive n, IsPrimitive al, Tuple.VectorValueOf n a ~ Value n al) =>+ (TypeNum.Positive n, IsPrimitive al, Repr n a ~ Value n al) => LLVM.BasicBlock -> T n a -> T n a -> LLVM.CodeGenFunction r () addPhiPrimitive bb (Cons a) (Cons b) = Tuple.addPhi bb a b shufflePrimitive :: (TypeNum.Positive n, TypeNum.Positive m, IsPrimitive al,- Tuple.ValueOf a ~ LLVM.Value al,- Tuple.VectorValueOf n a ~ Value n al,- Tuple.VectorValueOf m a ~ Value m al) =>+ MultiValue.Repr a ~ LLVM.Value al,+ Repr n a ~ Value n al,+ Repr m a ~ Value m al) => LLVM.ConstValue (LLVM.Vector m Word32) -> T n a -> T n a -> CodeGenFunction r (T m a) shufflePrimitive k (Cons u) (Cons v) =@@ -343,16 +378,16 @@ extractPrimitive :: (TypeNum.Positive n, IsPrimitive al,- Tuple.ValueOf a ~ LLVM.Value al,- Tuple.VectorValueOf n a ~ Value n al) =>+ MultiValue.Repr a ~ LLVM.Value al,+ Repr n a ~ Value n al) => LLVM.Value Word32 -> T n a -> CodeGenFunction r (MultiValue.T a) extractPrimitive k (Cons v) = fmap MultiValue.Cons $ LLVM.extractelement v k insertPrimitive :: (TypeNum.Positive n, IsPrimitive al,- Tuple.ValueOf a ~ LLVM.Value al,- Tuple.VectorValueOf n a ~ Value n al) =>+ MultiValue.Repr a ~ LLVM.Value al,+ Repr n a ~ Value n al) => LLVM.Value Word32 -> MultiValue.T a -> T n a -> CodeGenFunction r (T n a) insertPrimitive k (MultiValue.Cons a) (Cons v) =@@ -360,6 +395,7 @@ instance (C a, C b) => C (a,b) where+ type Repr n (a,b) = (Repr n a, Repr n b) cons v = case FuncHT.unzip v of (a,b) -> zip (cons a) (cons b) undef = zip undef undef zero = zip zero zero@@ -397,6 +433,7 @@ instance (C a, C b, C c) => C (a,b,c) where+ type Repr n (a,b,c) = (Repr n a, Repr n b, Repr n c) cons v = case FuncHT.unzip3 v of (a,b,c) -> zip3 (cons a) (cons b) (cons c) undef = zip3 undef undef undef zero = zip3 zero zero zero@@ -438,14 +475,15 @@ instance (C tuple) => C (StoreTuple.Tuple tuple) where+ type Repr n (StoreTuple.Tuple tuple) = Repr n tuple cons = tuple . cons . fmap StoreTuple.getTuple undef = tuple undef zero = tuple zero phi bb = fmap tuple . phi bb . untuple addPhi bb a b = addPhi bb (untuple a) (untuple b)- shuffle is u v = fmap tuple $ shuffle is (untuple u) (untuple v)- extract k v = fmap MultiValue.tuple $ extract k (untuple v)- insert k a v = fmap tuple $ insert k (MultiValue.untuple a) (untuple v)+ shuffle is u v = tuple <$> shuffle is (untuple u) (untuple v)+ extract k v = MultiValue.tuple <$> extract k (untuple v)+ insert k a v = tuple <$> insert k (MultiValue.untuple a) (untuple v) tuple :: T n tuple -> T n (StoreTuple.Tuple tuple) tuple (Cons a) = Cons a@@ -477,7 +515,7 @@ fromIntegerPrimitive :: (TypeNum.Positive n, IsPrimitive a, SoV.IntegerConstant a,- Tuple.VectorValueOf n a ~ Value n a) =>+ Repr n a ~ Value n a) => Integer -> T n a fromIntegerPrimitive = Cons . LLVM.value . SoV.constFromInteger @@ -486,7 +524,7 @@ fromRationalPrimitive :: (TypeNum.Positive n, IsPrimitive a, SoV.RationalConstant a,- Tuple.VectorValueOf n a ~ Value n a) =>+ Repr n a ~ Value n a) => Rational -> T n a fromRationalPrimitive = Cons . LLVM.value . SoV.constFromRational @@ -514,7 +552,7 @@ (TypeNum.Positive n, C a) => [MultiValue.T a] -> CodeGenFunction r (T n a) assemble =- foldM (\v (k,x) -> insert (valueOf k) x v) undef .+ foldlM (\v (k,x) -> insert (valueOf k) x v) undef . List.zip [0..] dissect ::@@ -531,6 +569,33 @@ (List.take (size x) [0..]) +assemble1 ::+ (TypeNum.Positive n, C a) =>+ NonEmpty.T [] (MultiValue.T a) -> CodeGenFunction r (T n a)+assemble1 = assemble . NonEmpty.flatten++dissect1 ::+ (TypeNum.Positive n, C a) =>+ T n a -> LLVM.CodeGenFunction r (NonEmpty.T [] (MultiValue.T a))+dissect1 = sequence . dissectList1++dissectList1 ::+ (TypeNum.Positive n, C a) =>+ T n a -> NonEmpty.T [] (LLVM.CodeGenFunction r (MultiValue.T a))+dissectList1 x =+ fmap+ (flip extract x . LLVM.valueOf)+ (0 !: List.take (size x - 1) [1 ..])+++assembleFromVector ::+ (TypeNum.Positive n, C a) =>+ LLVM.Vector n (MultiValue.T a) -> CodeGenFunction r (T n a)+assembleFromVector =+ fmap snd .+ foldlM (\(k,v) x -> (,) (k+1) <$> insert (valueOf k) x v) (0,undef)++ map :: (TypeNum.Positive n, C a, C b) => (MultiValue.T a -> CodeGenFunction r (MultiValue.T b)) ->@@ -560,12 +625,48 @@ MultiValue.T a -> T n a -> CodeGenFunction r (MultiValue.T a, T n a) iterateCore f x0 v0 =- foldM+ foldlM (\(x,v) k -> Monad.lift2 (,) (f x) (insert (valueOf k) x v)) (x0,v0) (List.take (size v0) [0..]) +sum ::+ (TypeNum.Positive n, Additive a) =>+ T n a -> CodeGenFunction r (MultiValue.T a)+sum =+ NonEmpty.foldBalanced (\x y -> join $ liftA2 MultiValue.add x y) .+ dissectList1++dotProduct ::+ (TypeNum.Positive n, PseudoRing a) =>+ T n a -> T n a -> CodeGenFunction r (MultiValue.T a)+dotProduct x y = sum =<< mul x y+++cumulate ::+ (TypeNum.Positive n, Additive a) =>+ MultiValue.T a -> T n a ->+ CodeGenFunction r (MultiValue.T a, T n a)+cumulate a x0 = do+ (b,x1) <- shiftUp a x0+ y <- cumulate1 x1+ z <- A.add b =<< last y+ return (z,y)++{- |+Needs (log n) vector additions+-}+cumulate1 ::+ (TypeNum.Positive n, Additive a) =>+ T n a -> CodeGenFunction r (T n a)+cumulate1 x =+ foldlM+ (\y k -> A.add y =<< shiftUpMultiZero k y)+ x+ (List.takeWhile (< size x) $ List.iterate (2*) 1)++ -- * re-ordering of elements constCyclicVector ::@@ -595,9 +696,7 @@ (TypeNum.Positive n, C a) => T n a -> CodeGenFunction r (T n a) rotateUp x =- shuffleMatch- (constCyclicVector $- (fromIntegral (size x) - 1) !: [0..]) x+ shuffleMatch (constCyclicVector $ (size x - 1) !: [0..]) x rotateDown :: (TypeNum.Positive n, C a) =>@@ -630,8 +729,7 @@ let v0 = zero v <- shuffle- (constCyclicVector $- NonEmptyC.iterate (1+) (fromIntegral (size u - size v0)))+ (constCyclicVector $ NonEmptyC.iterate (1+) (size u - size v0)) u undef return $ v `asTypeOf` v0 @@ -642,9 +740,7 @@ y <- shuffleMatch (LLVM.constCyclicVector $ LLVM.undef !: List.map LLVM.constOf [0..]) x- Monad.lift2 (,)- (extract (LLVM.valueOf (fromIntegral (size x) - 1)) x)- (insert (value LLVM.zero) x0 y)+ Monad.lift2 (,) (last x) (insert (value LLVM.zero) x0 y) shiftDown :: (TypeNum.Positive n, C a) =>@@ -658,18 +754,18 @@ LLVM.undef) x Monad.lift2 (,) (extract (value LLVM.zero) x)- (insert (LLVM.valueOf (fromIntegral (size x) - 1)) x0 y)+ (insert (LLVM.valueOf (size x - 1)) x0 y) shiftUpMultiIndices :: (TypeNum.Positive n) => Int -> Int -> LLVM.ConstValue (LLVM.Vector n Word32) shiftUpMultiIndices n sizev =- constCyclicVector $ fmap fromIntegral $+ constCyclicVector $ fmap P.fromIntegral $ NonEmpty.appendLeft (List.replicate n sizev) (NonEmptyC.iterate (1+) 0) shiftDownMultiIndices :: (TypeNum.Positive n) => Int -> Int -> LLVM.ConstValue (LLVM.Vector n Word32) shiftDownMultiIndices n sizev =- constCyclicVector $ fmap fromIntegral $+ constCyclicVector $ fmap P.fromIntegral $ NonEmpty.appendLeft (List.takeWhile (< sizev) $ List.iterate (1+) n) (NonEmptyC.repeat sizev)@@ -723,49 +819,47 @@ Trav.mapM (extract n) v -type PrimValue n a = LLVM.Value (LLVM.Vector n a) --lift1 :: (Tuple.VectorValueOf n a -> Tuple.VectorValueOf n b) -> T n a -> T n b+lift1 :: (Repr n a -> Repr n b) -> T n a -> T n b lift1 f (Cons a) = Cons $ f a _liftM0 :: (Monad m) =>- m (Tuple.VectorValueOf n a) ->+ m (Repr n a) -> m (T n a) _liftM0 f = Monad.lift Cons f liftM0 :: (Monad m,- Tuple.VectorValueOf n a ~ Value n a) =>- m (PrimValue n a) ->+ Repr n a ~ Value n ar) =>+ m (Value n ar) -> m (T n a) liftM0 f = Monad.lift consPrim f liftM :: (Monad m,- Tuple.VectorValueOf n a ~ Value n a,- Tuple.VectorValueOf n b ~ Value n b) =>- (PrimValue n a -> m (PrimValue n b)) ->+ Repr n a ~ Value n ar,+ Repr n b ~ Value n br) =>+ (Value n ar -> m (Value n br)) -> T n a -> m (T n b) liftM f a = Monad.lift consPrim $ f (deconsPrim a) liftM2 :: (Monad m,- Tuple.VectorValueOf n a ~ Value n a,- Tuple.VectorValueOf n b ~ Value n b,- Tuple.VectorValueOf n c ~ Value n c) =>- (PrimValue n a -> PrimValue n b -> m (PrimValue n c)) ->+ Repr n a ~ Value n ar,+ Repr n b ~ Value n br,+ Repr n c ~ Value n cr) =>+ (Value n ar -> Value n br -> m (Value n cr)) -> T n a -> T n b -> m (T n c) liftM2 f a b = Monad.lift consPrim $ f (deconsPrim a) (deconsPrim b) liftM3 :: (Monad m,- Tuple.VectorValueOf n a ~ Value n a,- Tuple.VectorValueOf n b ~ Value n b,- Tuple.VectorValueOf n c ~ Value n c,- Tuple.VectorValueOf n d ~ Value n d) =>- (PrimValue n a -> PrimValue n b -> PrimValue n c -> m (PrimValue n d)) ->+ Repr n a ~ Value n ar,+ Repr n b ~ Value n br,+ Repr n c ~ Value n cr,+ Repr n d ~ Value n dr) =>+ (Value n ar -> Value n br -> Value n cr -> m (Value n dr)) -> T n a -> T n b -> T n c -> m (T n d) liftM3 f a b c = Monad.lift consPrim $ f (deconsPrim a) (deconsPrim b) (deconsPrim c)@@ -856,23 +950,29 @@ fdiv = fdiv +scale ::+ (TypeNum.Positive n, PseudoRing a) =>+ MultiValue.T a -> T n a -> LLVM.CodeGenFunction r (T n a)+scale a v = flip mul v =<< replicate a++ type instance A.Scalar (T n a) = T n (MultiValue.Scalar a) class (MultiValue.PseudoModule v, PseudoRing (MultiValue.Scalar v), Additive v) => PseudoModule v where- scale ::+ scaleMulti :: (TypeNum.Positive n) => T n (MultiValue.Scalar v) -> T n v -> LLVM.CodeGenFunction r (T n v) instance PseudoModule Float where- scale = liftM2 A.mul+ scaleMulti = liftM2 A.mul instance PseudoModule Double where- scale = liftM2 A.mul+ scaleMulti = liftM2 A.mul instance (TypeNum.Positive n, PseudoModule a) => A.PseudoModule (T n a) where- scale = scale+ scale = scaleMulti class (MultiValue.Real a, Additive a) => Real a where@@ -893,6 +993,67 @@ abs = liftM A.abs signum = liftM A.signum +instance Real Word where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Word8 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Word16 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Word32 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Word64 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Int where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Int8 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Int16 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Int32 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++instance Real Int64 where+ min = liftM2 A.min+ max = liftM2 A.max+ abs = liftM A.abs+ signum = liftM A.signum++ instance (TypeNum.Positive n, Real a) => A.Real (T n a) where min = min max = max@@ -917,6 +1078,37 @@ fraction = fraction +class+ (TypeNum.Positive n, Repr n i ~ Value n ir,+ MultiValue.NativeInteger i ir, IsPrimitive ir, LLVM.IsInteger ir) =>+ NativeInteger n i ir where++instance (TypeNum.Positive n) => NativeInteger n Word Word where+instance (TypeNum.Positive n) => NativeInteger n Word8 Word8 where+instance (TypeNum.Positive n) => NativeInteger n Word16 Word16 where+instance (TypeNum.Positive n) => NativeInteger n Word32 Word32 where+instance (TypeNum.Positive n) => NativeInteger n Word64 Word64 where++instance (TypeNum.Positive n) => NativeInteger n Int Int where+instance (TypeNum.Positive n) => NativeInteger n Int8 Int8 where+instance (TypeNum.Positive n) => NativeInteger n Int16 Int16 where+instance (TypeNum.Positive n) => NativeInteger n Int32 Int32 where+instance (TypeNum.Positive n) => NativeInteger n Int64 Int64 where++class+ (TypeNum.Positive n, Repr n a ~ Value n ar,+ MultiValue.NativeFloating a ar, IsPrimitive ar, LLVM.IsFloating ar) =>+ NativeFloating n a ar where++instance (TypeNum.Positive n) => NativeFloating n Float Float where+instance (TypeNum.Positive n) => NativeFloating n Double Double where++fromIntegral ::+ (NativeInteger n i ir, NativeFloating n a ar) =>+ T n i -> LLVM.CodeGenFunction r (T n a)+fromIntegral = liftM LLVM.inttofp++ class (MultiValue.Algebraic a, Field a) => Algebraic a where sqrt :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a) @@ -934,7 +1126,8 @@ pi :: (TypeNum.Positive n) => LLVM.CodeGenFunction r (T n a) sin, cos, exp, log :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)- pow :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+ pow ::+ (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a) instance Transcendental Float where pi = liftM0 A.pi@@ -1001,7 +1194,7 @@ -class (MultiValue.Comparison a, C a) => Comparison a where+class (MultiValue.Comparison a, Real a) => Comparison a where cmp :: (TypeNum.Positive n) => LLVM.CmpPredicate -> T n a -> T n a ->@@ -1045,9 +1238,8 @@ class (MultiValue.Logic a, C a) => Logic a where- and :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)- or :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)- xor :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)+ and, or, xor ::+ (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a) inv :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a) instance Logic Bool where
src/LLVM/Extra/Multi/Vector/Instance.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module LLVM.Extra.Multi.Vector.Instance where import qualified LLVM.Extra.Multi.Vector as Vector import qualified LLVM.Extra.Multi.Value.Private as MultiValue+import LLVM.Extra.Multi.Value.Private (Repr, ) import qualified LLVM.Core as LLVM @@ -48,6 +48,7 @@ instance (TypeNum.Positive n, Vector.C a) => MultiValue.C (LLVM.Vector n a) where+ type Repr (LLVM.Vector n a) = Vector.Repr n a cons = toMultiValue . Vector.cons undef = toMultiValue Vector.undef zero = toMultiValue Vector.zero@@ -70,6 +71,25 @@ add = liftMultiValueM2 Vector.add sub = liftMultiValueM2 Vector.sub neg = liftMultiValueM Vector.neg++instance+ (TypeNum.Positive n, Vector.PseudoRing a) =>+ MultiValue.PseudoRing (LLVM.Vector n a) where+ mul = liftMultiValueM2 Vector.mul++instance+ (TypeNum.Positive n, Vector.Real a) =>+ MultiValue.Real (LLVM.Vector n a) where+ min = liftMultiValueM2 Vector.min+ max = liftMultiValueM2 Vector.max+ abs = liftMultiValueM Vector.abs+ signum = liftMultiValueM Vector.signum++instance+ (TypeNum.Positive n, Vector.Fraction a) =>+ MultiValue.Fraction (LLVM.Vector n a) where+ truncate = liftMultiValueM Vector.truncate+ fraction = liftMultiValueM Vector.fraction instance (TypeNum.Positive n, Vector.Logic a) =>
src/LLVM/Extra/ScalarOrVector.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {- | Support for unified handling of scalars and vectors.
src/LLVM/Extra/Storable.hs view
@@ -18,12 +18,6 @@ Store.Vector(..), Store.TupleVector(..), - -- * MultiValue support- Store.loadMultiValue,- Store.storeMultiValue,- Store.storeNextMultiValue,- Store.modifyMultiValue,- -- * Standard method implementations Store.loadNewtype, Store.storeNewtype,
src/LLVM/Extra/Storable/Array.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {- | Loops over Storable arrays. -}@@ -12,6 +13,7 @@ import LLVM.Core (CodeGenFunction, Value, CmpRet, IsInteger, IsConst, IsPrimitive) +import Foreign.Storable (Storable) import Foreign.Ptr (Ptr) import Control.Monad (liftM2)@@ -21,7 +23,7 @@ arrayLoop :: (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,- Storable.C a, Value (Ptr a) ~ ptrA) =>+ Storable a, Value (Ptr a) ~ ptrA) => Value i -> ptrA -> s -> (ptrA -> s -> CodeGenFunction r s) -> CodeGenFunction r s@@ -32,8 +34,8 @@ arrayLoop2 :: (Tuple.Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,- Storable.C a, Value (Ptr a) ~ ptrA,- Storable.C b, Value (Ptr b) ~ ptrB) =>+ Storable a, Value (Ptr a) ~ ptrA,+ Storable b, Value (Ptr b) ~ ptrB) => Value i -> ptrA -> ptrB -> s -> (ptrA -> ptrB -> s -> CodeGenFunction r s) -> CodeGenFunction r s@@ -45,7 +47,7 @@ arrayLoopMaybeCont :: (Tuple.Phi s, Tuple.Undefined s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,- Storable.C a, Value (Ptr a) ~ ptrA,+ Storable a, Value (Ptr a) ~ ptrA, Maybe.T (ptrA, s) ~ z) => Value i -> ptrA -> s ->@@ -60,8 +62,8 @@ arrayLoopMaybeCont2 :: (Tuple.Phi s, Tuple.Undefined s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,- Storable.C a, Value (Ptr a) ~ ptrA,- Storable.C b, Value (Ptr b) ~ ptrB,+ Storable a, Value (Ptr a) ~ ptrA,+ Storable b, Value (Ptr b) ~ ptrB, Maybe.T (ptrA, (ptrB, s)) ~ z) => Value i -> ptrA -> ptrB -> s ->
src/LLVM/Extra/Storable/Private.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE UndecidableInstances #-} module LLVM.Extra.Storable.Private where -import qualified LLVM.Extra.Multi.Value as MultiValue import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.ArithmeticPrivate as A import qualified LLVM.Util.Proxy as LP@@ -59,27 +58,6 @@ (al -> CodeGenFunction r al) -> Value (Ptr a) -> CodeGenFunction r () modify f ptr = flip store ptr =<< f =<< load ptr---loadMultiValue ::- (C a) => Value (Ptr a) -> CodeGenFunction r (MultiValue.T a)-loadMultiValue ptr = fmap MultiValue.Cons $ load ptr--storeMultiValue ::- (C a) => MultiValue.T a -> Value (Ptr a) -> CodeGenFunction r ()-storeMultiValue (MultiValue.Cons a) ptr = store a ptr--storeNextMultiValue ::- (C a) => MultiValue.T a -> Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))-storeNextMultiValue (MultiValue.Cons a) ptr =- store a ptr >> incrementPtr ptr--modifyMultiValue ::- (C a) =>- (MultiValue.T a -> CodeGenFunction r (MultiValue.T a)) ->- Value (Ptr a) -> CodeGenFunction r ()-modifyMultiValue f ptr =- flip storeMultiValue ptr =<< f =<< loadMultiValue ptr loadPrimitive ::
src/LLVM/Extra/Vector.hs view
@@ -102,8 +102,8 @@ (TypeNum.Positive (Size v), Tuple.Phi v, Tuple.Undefined v) => Simple v where - type Element v :: *- type Size v :: *+ type Element v+ type Size v shuffleMatch :: ConstValue (Vector (Size v) Word32) -> v -> CodeGenFunction r v@@ -227,7 +227,7 @@ class (n ~ Size (Construct n a), a ~ Element (Construct n a), C (Construct n a)) => Canonical n a where- type Construct n a :: *+ type Construct n a instance (TypeNum.Positive n, LLVM.IsPrimitive a) =>
test/LLVM/Extra/VectorAlt.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {- | This maintains old code for LLVM-2.6
test/Main.hs view
@@ -7,14 +7,19 @@ import Data.Tuple.HT (mapFst) -import qualified Test.QuickCheck as QC+import Control.Monad.IO.Class (liftIO) +import qualified Test.DocTest.Driver as DocTest + main :: IO () main = do LLVM.initializeNativeTarget - mapM_ (\(msg,prop) -> putStr (msg++": ") >> prop >>= QC.quickCheck) $+ DocTest.run $ mapM_+ (\(msg,prop) -> do+ DocTest.printPrefix (msg++": ")+ DocTest.property =<< liftIO prop) $ map (mapFst ("Storable."++)) Storable.tests ++ map (mapFst ("Vector."++)) Vector.tests ++ []
test/Test/Storable.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Test.Storable (tests) where import qualified LLVM.Extra.Storable as Storable