{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module LLVM.Extra.Multi.Vector (
T(Cons), consPrim, deconsPrim,
C(..),
Value,
map,
zip, zip3, unzip, unzip3,
replicate,
iterate,
take,
takeRev,
sum,
dotProduct,
cumulate,
cumulate1,
lift1,
modify,
assemble,
dissect,
dissectList,
assemble1,
dissect1,
dissectList1,
assembleFromVector,
reverse,
rotateUp,
rotateDown,
shiftUp,
shiftDown,
shiftUpMultiZero,
shiftDownMultiZero,
shiftUpMultiUndef,
shiftDownMultiUndef,
undefPrimitive,
shufflePrimitive,
extractPrimitive,
insertPrimitive,
shuffleMatchTraversable,
insertTraversable,
extractTraversable,
IntegerConstant(..),
RationalConstant(..),
Additive(..),
PseudoRing(..),
Field(..),
scale,
PseudoModule(..),
Real(..),
Fraction(..),
NativeInteger, NativeFloating, fromIntegral,
Algebraic(..),
Transcendental(..),
FloatingComparison(..),
Select(..),
Comparison(..),
Logic(..),
BitShift(..),
) where
import qualified LLVM.Extra.Multi.Value.Private as MultiValue
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Core as LLVM
import LLVM.Core (CodeGenFunction, IsPrimitive, valueOf, value, )
import qualified Type.Data.Num.Decimal as TypeNum
import qualified Foreign.Storable.Record.Tuple as StoreTuple
import qualified Data.Traversable as Trav
import qualified Data.NonEmpty.Class as NonEmptyC
import qualified Data.NonEmpty as NonEmpty
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, )
import Data.Maybe (maybe, )
import Data.Ord ((<), )
import Data.Word (Word8, Word16, Word32, Word64, Word)
import Data.Int (Int8, Int16, Int32, Int64, )
import Data.Bool8 (Bool8)
import Data.Bool (Bool, )
import qualified Control.Monad.HT as Monad
import qualified Control.Applicative as App
import qualified Control.Functor.HT as FuncHT
import Control.Monad.HT ((<=<), )
import Control.Monad (Monad, join, fmap, return, (>>), (=<<))
import Control.Applicative (liftA2, (<$>))
import qualified Prelude as P
import Prelude
(Float, Double, Integer, Int, Rational, asTypeOf, (-), (+), (*), error)
newtype T n a = Cons (Repr n a)
type Value n a = LLVM.Value (LLVM.Vector n a)
consPrim :: (Repr n a ~ Value n ar) => Value n ar -> T n a
consPrim = Cons
deconsPrim :: (Repr n a ~ Value n ar) => T n a -> Value n ar
deconsPrim (Cons a) = a
instance (TypeNum.Positive n, C a) => Tuple.Undefined (T n a) where
undef = undef
instance (TypeNum.Positive n, C a) => Tuple.Zero (T n a) where
zero = zero
instance (TypeNum.Positive n, C a) => Tuple.Phi (T n a) where
phi = phi
addPhi = addPhi
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)
zip3 :: T n a -> T n b -> T n c -> T n (a,b,c)
zip3 (Cons a) (Cons b) (Cons c) = Cons (a,b,c)
unzip :: T n (a,b) -> (T n a, T n b)
unzip (Cons (a,b)) = (Cons a, Cons b)
unzip3 :: T n (a,b,c) -> (T n a, T n b, T n c)
unzip3 (Cons (a,b,c)) = (Cons a, Cons b, Cons c)
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
phi ::
(TypeNum.Positive n) =>
LLVM.BasicBlock -> T n a -> LLVM.CodeGenFunction r (T n a)
addPhi ::
(TypeNum.Positive n) =>
LLVM.BasicBlock -> T n a -> T n a -> LLVM.CodeGenFunction r ()
shuffle ::
(TypeNum.Positive n, TypeNum.Positive m) =>
LLVM.ConstValue (LLVM.Vector m Word32) -> T n a -> T n a ->
CodeGenFunction r (T m a)
extract ::
(TypeNum.Positive n) =>
LLVM.Value Word32 -> T n a -> CodeGenFunction r (MultiValue.T a)
insert ::
(TypeNum.Positive n) =>
LLVM.Value Word32 -> MultiValue.T a ->
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
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
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
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Float where
type Repr n Float = LLVM.Value (LLVM.Vector n Float)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Double where
type Repr n Double = LLVM.Value (LLVM.Vector n Double)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Int where
type Repr n Int = LLVM.Value (LLVM.Vector n Int)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Int8 where
type Repr n Int8 = LLVM.Value (LLVM.Vector n Int8)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Int16 where
type Repr n Int16 = LLVM.Value (LLVM.Vector n Int16)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Int32 where
type Repr n Int32 = LLVM.Value (LLVM.Vector n Int32)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Int64 where
type Repr n Int64 = LLVM.Value (LLVM.Vector n Int64)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Word where
type Repr n Word = LLVM.Value (LLVM.Vector n Word)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Word8 where
type Repr n Word8 = LLVM.Value (LLVM.Vector n Word8)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Word16 where
type Repr n Word16 = LLVM.Value (LLVM.Vector n Word16)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Word32 where
type Repr n Word32 = LLVM.Value (LLVM.Vector n Word32)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
instance C Word64 where
type Repr n Word64 = LLVM.Value (LLVM.Vector n Word64)
cons = consPrimitive
undef = undefPrimitive
zero = zeroPrimitive
phi = phiPrimitive
addPhi = addPhiPrimitive
shuffle = shufflePrimitive
extract = extractPrimitive
insert = insertPrimitive
consPrimitive ::
(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,
Repr n a ~ Value n al) =>
T n a
undefPrimitive = Cons $ LLVM.value LLVM.undef
zeroPrimitive ::
(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, 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, 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,
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) =
fmap Cons $ LLVM.shufflevector u v k
extractPrimitive ::
(TypeNum.Positive n, IsPrimitive 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,
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) =
fmap Cons $ LLVM.insertelement v a k
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
phi bb a =
case unzip a of
(a0,a1) ->
Monad.lift2 zip (phi bb a0) (phi bb a1)
addPhi bb a b =
case (unzip a, unzip b) of
((a0,a1), (b0,b1)) ->
addPhi bb a0 b0 >>
addPhi bb a1 b1
shuffle is u v =
case (unzip u, unzip v) of
((u0,u1), (v0,v1)) ->
Monad.lift2 zip
(shuffle is u0 v0)
(shuffle is u1 v1)
extract k v =
case unzip v of
(v0,v1) ->
Monad.lift2 MultiValue.zip
(extract k v0)
(extract k v1)
insert k a v =
case (MultiValue.unzip a, unzip v) of
((a0,a1), (v0,v1)) ->
Monad.lift2 zip
(insert k a0 v0)
(insert k a1 v1)
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
phi bb a =
case unzip3 a of
(a0,a1,a2) ->
Monad.lift3 zip3 (phi bb a0) (phi bb a1) (phi bb a2)
addPhi bb a b =
case (unzip3 a, unzip3 b) of
((a0,a1,a2), (b0,b1,b2)) ->
addPhi bb a0 b0 >>
addPhi bb a1 b1 >>
addPhi bb a2 b2
shuffle is u v =
case (unzip3 u, unzip3 v) of
((u0,u1,u2), (v0,v1,v2)) ->
Monad.lift3 zip3
(shuffle is u0 v0)
(shuffle is u1 v1)
(shuffle is u2 v2)
extract k v =
case unzip3 v of
(v0,v1,v2) ->
Monad.lift3 MultiValue.zip3
(extract k v0)
(extract k v1)
(extract k v2)
insert k a v =
case (MultiValue.unzip3 a, unzip3 v) of
((a0,a1,a2), (v0,v1,v2)) ->
Monad.lift3 zip3
(insert k a0 v0)
(insert k a1 v1)
(insert k a2 v2)
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 = 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
untuple :: T n (StoreTuple.Tuple tuple) -> T n tuple
untuple (Cons a) = Cons a
class (MultiValue.IntegerConstant a, C a) => IntegerConstant a where
fromInteger' :: (TypeNum.Positive n) => Integer -> T n a
class
(MultiValue.RationalConstant a, IntegerConstant a) =>
RationalConstant a where
fromRational' :: (TypeNum.Positive n) => Rational -> T n a
instance IntegerConstant Float where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Double where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Word where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Word8 where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Word16 where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Word32 where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Word64 where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Int where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Int8 where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Int16 where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Int32 where fromInteger' = fromIntegerPrimitive
instance IntegerConstant Int64 where fromInteger' = fromIntegerPrimitive
fromIntegerPrimitive ::
(TypeNum.Positive n, IsPrimitive a, SoV.IntegerConstant a,
Repr n a ~ Value n a) =>
Integer -> T n a
fromIntegerPrimitive = Cons . LLVM.value . SoV.constFromInteger
instance RationalConstant Float where fromRational' = fromRationalPrimitive
instance RationalConstant Double where fromRational' = fromRationalPrimitive
fromRationalPrimitive ::
(TypeNum.Positive n, IsPrimitive a, SoV.RationalConstant a,
Repr n a ~ Value n a) =>
Rational -> T n a
fromRationalPrimitive = Cons . LLVM.value . SoV.constFromRational
instance
(TypeNum.Positive n, IntegerConstant a) =>
A.IntegerConstant (T n a) where
fromInteger' = fromInteger'
instance
(TypeNum.Positive n, RationalConstant a) =>
A.RationalConstant (T n a) where
fromRational' = fromRational'
modify ::
(TypeNum.Positive n, C a) =>
LLVM.Value Word32 ->
(MultiValue.T a -> CodeGenFunction r (MultiValue.T a)) ->
(T n a -> CodeGenFunction r (T n a))
modify k f v =
flip (insert k) v =<< f =<< extract k v
assemble ::
(TypeNum.Positive n, C a) =>
[MultiValue.T a] -> CodeGenFunction r (T n a)
assemble =
foldlM (\v (k,x) -> insert (valueOf k) x v) undef .
List.zip [0..]
dissect ::
(TypeNum.Positive n, C a) =>
T n a -> LLVM.CodeGenFunction r [MultiValue.T a]
dissect = sequence . dissectList
dissectList ::
(TypeNum.Positive n, C a) =>
T n a -> [LLVM.CodeGenFunction r (MultiValue.T a)]
dissectList x =
List.map
(flip extract x . LLVM.valueOf)
(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)) ->
(T n a -> CodeGenFunction r (T n b))
map f = assemble <=< mapM f <=< dissect
singleton :: (C a) => MultiValue.T a -> CodeGenFunction r (T TypeNum.D1 a)
singleton x = insert (LLVM.value LLVM.zero) x undef
replicate ::
(TypeNum.Positive n, C a) =>
MultiValue.T a -> CodeGenFunction r (T n a)
replicate x = do
single <- singleton x
shuffle (constCyclicVector $ NonEmpty.singleton 0) single undef
iterate ::
(TypeNum.Positive n, C a) =>
(MultiValue.T a -> CodeGenFunction r (MultiValue.T a)) ->
MultiValue.T a -> CodeGenFunction r (T n a)
iterate f x = fmap snd $ iterateCore f x Tuple.undef
iterateCore ::
(TypeNum.Positive n, C a) =>
(MultiValue.T a -> CodeGenFunction r (MultiValue.T a)) ->
MultiValue.T a -> T n a ->
CodeGenFunction r (MultiValue.T a, T n a)
iterateCore f x0 v0 =
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)
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)
constCyclicVector ::
(LLVM.IsConst a, TypeNum.Positive n) =>
NonEmpty.T [] a -> LLVM.ConstValue (LLVM.Vector n a)
constCyclicVector =
LLVM.constCyclicVector . fmap LLVM.constOf
shuffleMatch ::
(TypeNum.Positive n, C a) =>
LLVM.ConstValue (LLVM.Vector n Word32) -> T n a ->
CodeGenFunction r (T n a)
shuffleMatch k v = shuffle k v undef
rotateUp ::
(TypeNum.Positive n, C a) =>
T n a -> CodeGenFunction r (T n a)
rotateUp x =
shuffleMatch (constCyclicVector $ (size x - 1) !: [0..]) x
rotateDown ::
(TypeNum.Positive n, C a) =>
T n a -> CodeGenFunction r (T n a)
rotateDown x =
shuffleMatch
(constCyclicVector $
NonEmpty.snoc (List.take (size x - 1) [1..]) 0) x
reverse ::
(TypeNum.Positive n, C a) =>
T n a -> CodeGenFunction r (T n a)
reverse x =
shuffleMatch
(constCyclicVector $
maybe (error "vector size must be positive") NonEmpty.reverse $
NonEmpty.fetch $
List.take (size x) [0..])
x
take ::
(TypeNum.Positive n, TypeNum.Positive m, C a) =>
T n a -> CodeGenFunction r (T m a)
take u = shuffle (constCyclicVector $ NonEmptyC.iterate (1+) 0) u undef
takeRev ::
(TypeNum.Positive n, TypeNum.Positive m, C a) =>
T n a -> CodeGenFunction r (T m a)
takeRev u = do
let v0 = zero
v <-
shuffle
(constCyclicVector $ NonEmptyC.iterate (1+) (size u - size v0))
u undef
return $ v `asTypeOf` v0
shiftUp ::
(TypeNum.Positive n, C a) =>
MultiValue.T a -> T n a -> CodeGenFunction r (MultiValue.T a, T n a)
shiftUp x0 x = do
y <-
shuffleMatch
(LLVM.constCyclicVector $ LLVM.undef !: List.map LLVM.constOf [0..]) x
Monad.lift2 (,) (last x) (insert (value LLVM.zero) x0 y)
shiftDown ::
(TypeNum.Positive n, C a) =>
MultiValue.T a -> T n a -> CodeGenFunction r (MultiValue.T a, T n a)
shiftDown x0 x = do
y <-
shuffleMatch
(LLVM.constCyclicVector $
NonEmpty.snoc
(List.map LLVM.constOf $ List.take (size x - 1) [1..])
LLVM.undef) x
Monad.lift2 (,)
(extract (value LLVM.zero) x)
(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 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 P.fromIntegral $
NonEmpty.appendLeft
(List.takeWhile (< sizev) $ List.iterate (1+) n)
(NonEmptyC.repeat sizev)
shiftUpMultiZero ::
(TypeNum.Positive n, C a) =>
Int -> T n a -> LLVM.CodeGenFunction r (T n a)
shiftUpMultiZero n v =
shuffle (shiftUpMultiIndices n (size v)) v zero
shiftDownMultiZero ::
(TypeNum.Positive n, C a) =>
Int -> T n a -> LLVM.CodeGenFunction r (T n a)
shiftDownMultiZero n v =
shuffle (shiftDownMultiIndices n (size v)) v zero
shiftUpMultiUndef ::
(TypeNum.Positive n, C a) =>
Int -> T n a -> LLVM.CodeGenFunction r (T n a)
shiftUpMultiUndef n v =
shuffle (shiftUpMultiIndices n (size v)) v undef
shiftDownMultiUndef ::
(TypeNum.Positive n, C a) =>
Int -> T n a -> LLVM.CodeGenFunction r (T n a)
shiftDownMultiUndef n v =
shuffle (shiftDownMultiIndices n (size v)) v undef
shuffleMatchTraversable ::
(TypeNum.Positive n, C a, Trav.Traversable f) =>
LLVM.ConstValue (LLVM.Vector n Word32) ->
f (T n a) -> CodeGenFunction r (f (T n a))
shuffleMatchTraversable is v =
Trav.mapM (shuffleMatch is) v
insertTraversable ::
(TypeNum.Positive n, C a, Trav.Traversable f, App.Applicative f) =>
LLVM.Value Word32 -> f (MultiValue.T a) ->
f (T n a) -> CodeGenFunction r (f (T n a))
insertTraversable n a v =
Trav.sequence (liftA2 (insert n) a v)
extractTraversable ::
(TypeNum.Positive n, C a, Trav.Traversable f) =>
LLVM.Value Word32 -> f (T n a) ->
CodeGenFunction r (f (MultiValue.T a))
extractTraversable n v =
Trav.mapM (extract n) v
lift1 :: (Repr n a -> Repr n b) -> T n a -> T n b
lift1 f (Cons a) = Cons $ f a
_liftM0 ::
(Monad m) =>
m (Repr n a) ->
m (T n a)
_liftM0 f = Monad.lift Cons f
liftM0 ::
(Monad m,
Repr n a ~ Value n ar) =>
m (Value n ar) ->
m (T n a)
liftM0 f = Monad.lift consPrim f
liftM ::
(Monad m,
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,
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,
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)
class (MultiValue.Additive a, C a) => Additive a where
add ::
(TypeNum.Positive n) =>
T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
sub ::
(TypeNum.Positive n) =>
T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
neg ::
(TypeNum.Positive n) =>
T n a -> LLVM.CodeGenFunction r (T n a)
instance Additive Float where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Double where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Int where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Int8 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Int16 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Int32 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Int64 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Word where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Word8 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Word16 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Word32 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance Additive Word64 where
add = liftM2 LLVM.add; sub = liftM2 LLVM.sub; neg = liftM LLVM.neg
instance (TypeNum.Positive n, Additive a) => A.Additive (T n a) where
zero = zero
add = add
sub = sub
neg = neg
class (MultiValue.PseudoRing a, Additive a) => PseudoRing a where
mul ::
(TypeNum.Positive n) =>
T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
instance PseudoRing Float where
mul = liftM2 LLVM.mul
instance PseudoRing Double where
mul = liftM2 LLVM.mul
instance (TypeNum.Positive n, PseudoRing a) => A.PseudoRing (T n a) where
mul = mul
class (MultiValue.Field a, PseudoRing a) => Field a where
fdiv ::
(TypeNum.Positive n) =>
T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
instance Field Float where
fdiv = liftM2 LLVM.fdiv
instance Field Double where
fdiv = liftM2 LLVM.fdiv
instance (TypeNum.Positive n, Field a) => A.Field (T n a) where
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
scaleMulti ::
(TypeNum.Positive n) =>
T n (MultiValue.Scalar v) -> T n v -> LLVM.CodeGenFunction r (T n v)
instance PseudoModule Float where
scaleMulti = liftM2 A.mul
instance PseudoModule Double where
scaleMulti = liftM2 A.mul
instance (TypeNum.Positive n, PseudoModule a) => A.PseudoModule (T n a) where
scale = scaleMulti
class (MultiValue.Real a, Additive a) => Real a where
min :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
max :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
abs :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)
signum :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)
instance Real Float where
min = liftM2 A.min
max = liftM2 A.max
abs = liftM A.abs
signum = liftM A.signum
instance Real Double where
min = liftM2 A.min
max = liftM2 A.max
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
abs = abs
signum = signum
class (MultiValue.Fraction a, Real a) => Fraction a where
truncate :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)
fraction :: (TypeNum.Positive n) => T n a -> LLVM.CodeGenFunction r (T n a)
instance Fraction Float where
truncate = liftM A.truncate
fraction = liftM A.fraction
instance Fraction Double where
truncate = liftM A.truncate
fraction = liftM A.fraction
instance (TypeNum.Positive n, Fraction a) => A.Fraction (T n a) where
truncate = truncate
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)
instance Algebraic Float where
sqrt = liftM A.sqrt
instance Algebraic Double where
sqrt = liftM A.sqrt
instance (TypeNum.Positive n, Algebraic a) => A.Algebraic (T n a) where
sqrt = sqrt
class (MultiValue.Transcendental a, Algebraic a) => Transcendental a where
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)
instance Transcendental Float where
pi = liftM0 A.pi
sin = liftM A.sin
cos = liftM A.cos
exp = liftM A.exp
log = liftM A.log
pow = liftM2 A.pow
instance Transcendental Double where
pi = liftM0 A.pi
sin = liftM A.sin
cos = liftM A.cos
exp = liftM A.exp
log = liftM A.log
pow = liftM2 A.pow
instance (TypeNum.Positive n, Transcendental a) => A.Transcendental (T n a) where
pi = pi
sin = sin
cos = cos
exp = exp
log = log
pow = pow
class (MultiValue.Select a, C a) => Select a where
select ::
(TypeNum.Positive n) =>
T n Bool -> T n a -> T n a ->
LLVM.CodeGenFunction r (T n a)
instance Select Float where select = liftM3 LLVM.select
instance Select Double where select = liftM3 LLVM.select
instance Select Bool where select = liftM3 LLVM.select
instance Select Word where select = liftM3 LLVM.select
instance Select Word8 where select = liftM3 LLVM.select
instance Select Word16 where select = liftM3 LLVM.select
instance Select Word32 where select = liftM3 LLVM.select
instance Select Word64 where select = liftM3 LLVM.select
instance Select Int where select = liftM3 LLVM.select
instance Select Int8 where select = liftM3 LLVM.select
instance Select Int16 where select = liftM3 LLVM.select
instance Select Int32 where select = liftM3 LLVM.select
instance Select Int64 where select = liftM3 LLVM.select
instance (Select a, Select b) => Select (a,b) where
select x y0 y1 =
case (unzip y0, unzip y1) of
((a0,b0), (a1,b1)) ->
Monad.lift2 zip
(select x a0 a1)
(select x b0 b1)
instance (Select a, Select b, Select c) => Select (a,b,c) where
select x y0 y1 =
case (unzip3 y0, unzip3 y1) of
((a0,b0,c0), (a1,b1,c1)) ->
Monad.lift3 zip3
(select x a0 a1)
(select x b0 b1)
(select x c0 c1)
class (MultiValue.Comparison a, Real a) => Comparison a where
cmp ::
(TypeNum.Positive n) =>
LLVM.CmpPredicate -> T n a -> T n a ->
LLVM.CodeGenFunction r (T n Bool)
instance Comparison Float where cmp = liftM2 . LLVM.cmp
instance Comparison Double where cmp = liftM2 . LLVM.cmp
instance Comparison Word where cmp = liftM2 . LLVM.cmp
instance Comparison Word8 where cmp = liftM2 . LLVM.cmp
instance Comparison Word16 where cmp = liftM2 . LLVM.cmp
instance Comparison Word32 where cmp = liftM2 . LLVM.cmp
instance Comparison Word64 where cmp = liftM2 . LLVM.cmp
instance Comparison Int where cmp = liftM2 . LLVM.cmp
instance Comparison Int8 where cmp = liftM2 . LLVM.cmp
instance Comparison Int16 where cmp = liftM2 . LLVM.cmp
instance Comparison Int32 where cmp = liftM2 . LLVM.cmp
instance Comparison Int64 where cmp = liftM2 . LLVM.cmp
instance (TypeNum.Positive n, Comparison a) => A.Comparison (T n a) where
type CmpResult (T n a) = T n Bool
cmp = cmp
class
(MultiValue.FloatingComparison a, Comparison a) =>
FloatingComparison a where
fcmp ::
(TypeNum.Positive n) =>
LLVM.FPPredicate -> T n a -> T n a ->
LLVM.CodeGenFunction r (T n Bool)
instance FloatingComparison Float where
fcmp = liftM2 . LLVM.fcmp
instance
(TypeNum.Positive n, FloatingComparison a) =>
A.FloatingComparison (T n a) where
fcmp = fcmp
class (MultiValue.Logic a, C a) => Logic a where
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
and = liftM2 LLVM.and; or = liftM2 LLVM.or
xor = liftM2 LLVM.xor; inv = liftM LLVM.inv
instance Logic Word8 where
and = liftM2 LLVM.and; or = liftM2 LLVM.or
xor = liftM2 LLVM.xor; inv = liftM LLVM.inv
instance Logic Word16 where
and = liftM2 LLVM.and; or = liftM2 LLVM.or
xor = liftM2 LLVM.xor; inv = liftM LLVM.inv
instance Logic Word32 where
and = liftM2 LLVM.and; or = liftM2 LLVM.or
xor = liftM2 LLVM.xor; inv = liftM LLVM.inv
instance Logic Word64 where
and = liftM2 LLVM.and; or = liftM2 LLVM.or
xor = liftM2 LLVM.xor; inv = liftM LLVM.inv
instance (TypeNum.Positive n, Logic a) => A.Logic (T n a) where
and = and
or = or
xor = xor
inv = inv
class (MultiValue.BitShift a, C a) => BitShift a where
shl :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
shr :: (TypeNum.Positive n) => T n a -> T n a -> LLVM.CodeGenFunction r (T n a)
instance BitShift Word where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr
instance BitShift Word8 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr
instance BitShift Word16 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr
instance BitShift Word32 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr
instance BitShift Word64 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.lshr
instance BitShift Int where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr
instance BitShift Int8 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr
instance BitShift Int16 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr
instance BitShift Int32 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr
instance BitShift Int64 where
shl = liftM2 LLVM.shl; shr = liftM2 LLVM.ashr