{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module LLVM.Extra.Nice.Value.Vector (
   cons,
   fst, snd,
   fst3, snd3, thd3,
   zip, zip3,
   unzip, unzip3,

   swap,
   mapFst, mapSnd,
   mapFst3, mapSnd3, mapThd3,

   extract, insert,
   replicate,
   iterate,
   dissect,
   dissect1,
   select,
   cmp,
   take, takeRev,

   NativeInteger,
   NativeFloating,
   fromIntegral,
   truncateToInt,
   splitFractionToInt,
   ) where

import qualified LLVM.Extra.Nice.Vector.Instance as Inst
import qualified LLVM.Extra.Nice.Vector as NiceVector
import qualified LLVM.Extra.Nice.Value.Private as NiceValue
import qualified LLVM.Extra.ScalarOrVector as SoV
import LLVM.Extra.Nice.Vector.Instance (NVVector)

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 (Word8, Word16, Word32, Word64, Word)
import Data.Int (Int8, Int16, Int32, Int64, Int)

import Prelude (Float, Double, Bool, fmap, (.))


cons ::
   (TypeNum.Positive n, NiceVector.C a) =>
   LLVM.Vector n a -> NVVector n a
cons :: forall n a. (Positive n, C a) => Vector n a -> NVVector n a
cons = T n a -> NVVector n a
forall n a. T n a -> NVVector n a
Inst.toNiceValue (T n a -> NVVector n a)
-> (Vector n a -> T n a) -> Vector n a -> NVVector n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector n a -> T n a
forall n. Positive n => Vector n a -> T n a
forall a n. (C a, Positive n) => Vector n a -> T n a
NiceVector.cons

fst :: NVVector n (a,b) -> NVVector n a
fst :: forall n a b. NVVector n (a, b) -> NVVector n a
fst = (Repr (Vector n (a, b)) -> Repr (Vector n a))
-> T (Vector n (a, b)) -> T (Vector n a)
forall a b. (Repr a -> Repr b) -> T a -> T b
NiceValue.lift1 (Repr n a, Repr n b) -> Repr n a
Repr (Vector n (a, b)) -> Repr (Vector n a)
forall a b. (a, b) -> a
Tuple.fst

snd :: NVVector n (a,b) -> NVVector n b
snd :: forall n a b. NVVector n (a, b) -> NVVector n b
snd = (Repr (Vector n (a, b)) -> Repr (Vector n b))
-> T (Vector n (a, b)) -> T (Vector n b)
forall a b. (Repr a -> Repr b) -> T a -> T b
NiceValue.lift1 (Repr n a, Repr n b) -> Repr n b
Repr (Vector n (a, b)) -> Repr (Vector n b)
forall a b. (a, b) -> b
Tuple.snd

swap :: NVVector n (a,b) -> NVVector n (b,a)
swap :: forall n a b. NVVector n (a, b) -> NVVector n (b, a)
swap = (Repr (Vector n (a, b)) -> Repr (Vector n (b, a)))
-> T (Vector n (a, b)) -> T (Vector n (b, a))
forall a b. (Repr a -> Repr b) -> T a -> T b
NiceValue.lift1 (Repr n a, Repr n b) -> (Repr n b, Repr n a)
Repr (Vector n (a, b)) -> Repr (Vector n (b, a))
forall a b. (a, b) -> (b, a)
TupleHT.swap

mapFst ::
   (NVVector n a0 -> NVVector n a1) ->
   NVVector n (a0,b) -> NVVector n (a1,b)
mapFst :: forall n a0 a1 b.
(NVVector n a0 -> NVVector n a1)
-> NVVector n (a0, b) -> NVVector n (a1, b)
mapFst NVVector n a0 -> NVVector n a1
f = (NVVector n a1 -> NVVector n b -> NVVector n (a1, b))
-> (NVVector n a1, NVVector n b) -> NVVector n (a1, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tuple.uncurry NVVector n a1 -> NVVector n b -> NVVector n (a1, b)
forall n a b. NVVector n a -> NVVector n b -> NVVector n (a, b)
zip ((NVVector n a1, NVVector n b) -> NVVector n (a1, b))
-> (NVVector n (a0, b) -> (NVVector n a1, NVVector n b))
-> NVVector n (a0, b)
-> NVVector n (a1, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NVVector n a0 -> NVVector n a1)
-> (NVVector n a0, NVVector n b) -> (NVVector n a1, NVVector n b)
forall a c b. (a -> c) -> (a, b) -> (c, b)
TupleHT.mapFst NVVector n a0 -> NVVector n a1
f ((NVVector n a0, NVVector n b) -> (NVVector n a1, NVVector n b))
-> (NVVector n (a0, b) -> (NVVector n a0, NVVector n b))
-> NVVector n (a0, b)
-> (NVVector n a1, NVVector n b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVVector n (a0, b) -> (NVVector n a0, NVVector n b)
forall n a b. NVVector n (a, b) -> (NVVector n a, NVVector n b)
unzip

mapSnd ::
   (NVVector n b0 -> NVVector n b1) ->
   NVVector n (a,b0) -> NVVector n (a,b1)
mapSnd :: forall n b0 b1 a.
(NVVector n b0 -> NVVector n b1)
-> NVVector n (a, b0) -> NVVector n (a, b1)
mapSnd NVVector n b0 -> NVVector n b1
f = (NVVector n a -> NVVector n b1 -> NVVector n (a, b1))
-> (NVVector n a, NVVector n b1) -> NVVector n (a, b1)
forall a b c. (a -> b -> c) -> (a, b) -> c
Tuple.uncurry NVVector n a -> NVVector n b1 -> NVVector n (a, b1)
forall n a b. NVVector n a -> NVVector n b -> NVVector n (a, b)
zip ((NVVector n a, NVVector n b1) -> NVVector n (a, b1))
-> (NVVector n (a, b0) -> (NVVector n a, NVVector n b1))
-> NVVector n (a, b0)
-> NVVector n (a, b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NVVector n b0 -> NVVector n b1)
-> (NVVector n a, NVVector n b0) -> (NVVector n a, NVVector n b1)
forall b c a. (b -> c) -> (a, b) -> (a, c)
TupleHT.mapSnd NVVector n b0 -> NVVector n b1
f ((NVVector n a, NVVector n b0) -> (NVVector n a, NVVector n b1))
-> (NVVector n (a, b0) -> (NVVector n a, NVVector n b0))
-> NVVector n (a, b0)
-> (NVVector n a, NVVector n b1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVVector n (a, b0) -> (NVVector n a, NVVector n b0)
forall n a b. NVVector n (a, b) -> (NVVector n a, NVVector n b)
unzip


fst3 :: NVVector n (a,b,c) -> NVVector n a
fst3 :: forall n a b c. NVVector n (a, b, c) -> NVVector n a
fst3 = (Repr (Vector n (a, b, c)) -> Repr (Vector n a))
-> T (Vector n (a, b, c)) -> T (Vector n a)
forall a b. (Repr a -> Repr b) -> T a -> T b
NiceValue.lift1 (Repr n a, Repr n b, Repr n c) -> Repr n a
Repr (Vector n (a, b, c)) -> Repr (Vector n a)
forall a b c. (a, b, c) -> a
TupleHT.fst3

snd3 :: NVVector n (a,b,c) -> NVVector n b
snd3 :: forall n a b c. NVVector n (a, b, c) -> NVVector n b
snd3 = (Repr (Vector n (a, b, c)) -> Repr (Vector n b))
-> T (Vector n (a, b, c)) -> T (Vector n b)
forall a b. (Repr a -> Repr b) -> T a -> T b
NiceValue.lift1 (Repr n a, Repr n b, Repr n c) -> Repr n b
Repr (Vector n (a, b, c)) -> Repr (Vector n b)
forall a b c. (a, b, c) -> b
TupleHT.snd3

thd3 :: NVVector n (a,b,c) -> NVVector n c
thd3 :: forall n a b c. NVVector n (a, b, c) -> NVVector n c
thd3 = (Repr (Vector n (a, b, c)) -> Repr (Vector n c))
-> T (Vector n (a, b, c)) -> T (Vector n c)
forall a b. (Repr a -> Repr b) -> T a -> T b
NiceValue.lift1 (Repr n a, Repr n b, Repr n c) -> Repr n c
Repr (Vector n (a, b, c)) -> Repr (Vector n c)
forall a b c. (a, b, c) -> c
TupleHT.thd3

mapFst3 ::
   (NVVector n a0 -> NVVector n a1) ->
   NVVector n (a0,b,c) -> NVVector n (a1,b,c)
mapFst3 :: forall n a0 a1 b c.
(NVVector n a0 -> NVVector n a1)
-> NVVector n (a0, b, c) -> NVVector n (a1, b, c)
mapFst3 NVVector n a0 -> NVVector n a1
f = (NVVector n a1
 -> NVVector n b -> NVVector n c -> NVVector n (a1, b, c))
-> (NVVector n a1, NVVector n b, NVVector n c)
-> NVVector n (a1, b, c)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 NVVector n a1
-> NVVector n b -> NVVector n c -> NVVector n (a1, b, c)
forall n a b c.
NVVector n a
-> NVVector n b -> NVVector n c -> NVVector n (a, b, c)
zip3 ((NVVector n a1, NVVector n b, NVVector n c)
 -> NVVector n (a1, b, c))
-> (NVVector n (a0, b, c)
    -> (NVVector n a1, NVVector n b, NVVector n c))
-> NVVector n (a0, b, c)
-> NVVector n (a1, b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NVVector n a0 -> NVVector n a1)
-> (NVVector n a0, NVVector n b, NVVector n c)
-> (NVVector n a1, NVVector n b, NVVector n c)
forall a d b c. (a -> d) -> (a, b, c) -> (d, b, c)
TupleHT.mapFst3 NVVector n a0 -> NVVector n a1
f ((NVVector n a0, NVVector n b, NVVector n c)
 -> (NVVector n a1, NVVector n b, NVVector n c))
-> (NVVector n (a0, b, c)
    -> (NVVector n a0, NVVector n b, NVVector n c))
-> NVVector n (a0, b, c)
-> (NVVector n a1, NVVector n b, NVVector n c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVVector n (a0, b, c)
-> (NVVector n a0, NVVector n b, NVVector n c)
forall n a b c.
NVVector n (a, b, c) -> (NVVector n a, NVVector n b, NVVector n c)
unzip3

mapSnd3 ::
   (NVVector n b0 -> NVVector n b1) ->
   NVVector n (a,b0,c) -> NVVector n (a,b1,c)
mapSnd3 :: forall n b0 b1 a c.
(NVVector n b0 -> NVVector n b1)
-> NVVector n (a, b0, c) -> NVVector n (a, b1, c)
mapSnd3 NVVector n b0 -> NVVector n b1
f = (NVVector n a
 -> NVVector n b1 -> NVVector n c -> NVVector n (a, b1, c))
-> (NVVector n a, NVVector n b1, NVVector n c)
-> NVVector n (a, b1, c)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 NVVector n a
-> NVVector n b1 -> NVVector n c -> NVVector n (a, b1, c)
forall n a b c.
NVVector n a
-> NVVector n b -> NVVector n c -> NVVector n (a, b, c)
zip3 ((NVVector n a, NVVector n b1, NVVector n c)
 -> NVVector n (a, b1, c))
-> (NVVector n (a, b0, c)
    -> (NVVector n a, NVVector n b1, NVVector n c))
-> NVVector n (a, b0, c)
-> NVVector n (a, b1, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NVVector n b0 -> NVVector n b1)
-> (NVVector n a, NVVector n b0, NVVector n c)
-> (NVVector n a, NVVector n b1, NVVector n c)
forall b d a c. (b -> d) -> (a, b, c) -> (a, d, c)
TupleHT.mapSnd3 NVVector n b0 -> NVVector n b1
f ((NVVector n a, NVVector n b0, NVVector n c)
 -> (NVVector n a, NVVector n b1, NVVector n c))
-> (NVVector n (a, b0, c)
    -> (NVVector n a, NVVector n b0, NVVector n c))
-> NVVector n (a, b0, c)
-> (NVVector n a, NVVector n b1, NVVector n c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVVector n (a, b0, c)
-> (NVVector n a, NVVector n b0, NVVector n c)
forall n a b c.
NVVector n (a, b, c) -> (NVVector n a, NVVector n b, NVVector n c)
unzip3

mapThd3 ::
   (NVVector n c0 -> NVVector n c1) ->
   NVVector n (a,b,c0) -> NVVector n (a,b,c1)
mapThd3 :: forall n c0 c1 a b.
(NVVector n c0 -> NVVector n c1)
-> NVVector n (a, b, c0) -> NVVector n (a, b, c1)
mapThd3 NVVector n c0 -> NVVector n c1
f = (NVVector n a
 -> NVVector n b -> NVVector n c1 -> NVVector n (a, b, c1))
-> (NVVector n a, NVVector n b, NVVector n c1)
-> NVVector n (a, b, c1)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
TupleHT.uncurry3 NVVector n a
-> NVVector n b -> NVVector n c1 -> NVVector n (a, b, c1)
forall n a b c.
NVVector n a
-> NVVector n b -> NVVector n c -> NVVector n (a, b, c)
zip3 ((NVVector n a, NVVector n b, NVVector n c1)
 -> NVVector n (a, b, c1))
-> (NVVector n (a, b, c0)
    -> (NVVector n a, NVVector n b, NVVector n c1))
-> NVVector n (a, b, c0)
-> NVVector n (a, b, c1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NVVector n c0 -> NVVector n c1)
-> (NVVector n a, NVVector n b, NVVector n c0)
-> (NVVector n a, NVVector n b, NVVector n c1)
forall c d a b. (c -> d) -> (a, b, c) -> (a, b, d)
TupleHT.mapThd3 NVVector n c0 -> NVVector n c1
f ((NVVector n a, NVVector n b, NVVector n c0)
 -> (NVVector n a, NVVector n b, NVVector n c1))
-> (NVVector n (a, b, c0)
    -> (NVVector n a, NVVector n b, NVVector n c0))
-> NVVector n (a, b, c0)
-> (NVVector n a, NVVector n b, NVVector n c1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVVector n (a, b, c0)
-> (NVVector n a, NVVector n b, NVVector n c0)
forall n a b c.
NVVector n (a, b, c) -> (NVVector n a, NVVector n b, NVVector n c)
unzip3


zip :: NVVector n a -> NVVector n b -> NVVector n (a,b)
zip :: forall n a b. NVVector n a -> NVVector n b -> NVVector n (a, b)
zip (NiceValue.Cons Repr (Vector n a)
a) (NiceValue.Cons Repr (Vector n b)
b) = Repr (Vector n (a, b)) -> T (Vector n (a, b))
forall a. Repr a -> T a
NiceValue.Cons (Repr (Vector n a)
Repr n a
a,Repr (Vector n b)
Repr n b
b)

zip3 :: NVVector n a -> NVVector n b -> NVVector n c -> NVVector n (a,b,c)
zip3 :: forall n a b c.
NVVector n a
-> NVVector n b -> NVVector n c -> NVVector n (a, b, c)
zip3 (NiceValue.Cons Repr (Vector n a)
a) (NiceValue.Cons Repr (Vector n b)
b) (NiceValue.Cons Repr (Vector n c)
c) =
   Repr (Vector n (a, b, c)) -> T (Vector n (a, b, c))
forall a. Repr a -> T a
NiceValue.Cons (Repr (Vector n a)
Repr n a
a,Repr (Vector n b)
Repr n b
b,Repr (Vector n c)
Repr n c
c)

unzip :: NVVector n (a,b) -> (NVVector n a, NVVector n b)
unzip :: forall n a b. NVVector n (a, b) -> (NVVector n a, NVVector n b)
unzip (NiceValue.Cons (Repr n a
a,Repr n b
b)) = (Repr (Vector n a) -> T (Vector n a)
forall a. Repr a -> T a
NiceValue.Cons Repr (Vector n a)
Repr n a
a, Repr (Vector n b) -> T (Vector n b)
forall a. Repr a -> T a
NiceValue.Cons Repr (Vector n b)
Repr n b
b)

unzip3 :: NVVector n (a,b,c) -> (NVVector n a, NVVector n b, NVVector n c)
unzip3 :: forall n a b c.
NVVector n (a, b, c) -> (NVVector n a, NVVector n b, NVVector n c)
unzip3 (NiceValue.Cons (Repr n a
a,Repr n b
b,Repr n c
c)) =
   (Repr (Vector n a) -> T (Vector n a)
forall a. Repr a -> T a
NiceValue.Cons Repr (Vector n a)
Repr n a
a, Repr (Vector n b) -> T (Vector n b)
forall a. Repr a -> T a
NiceValue.Cons Repr (Vector n b)
Repr n b
b, Repr (Vector n c) -> T (Vector n c)
forall a. Repr a -> T a
NiceValue.Cons Repr (Vector n c)
Repr n c
c)


extract ::
   (TypeNum.Positive n, NiceVector.C a) =>
   LLVM.Value Word32 -> NVVector n a ->
   LLVM.CodeGenFunction r (NiceValue.T a)
extract :: forall n a r.
(Positive n, C a) =>
Value Word32 -> NVVector n a -> CodeGenFunction r (T a)
extract Value Word32
k NVVector n a
v = Value Word32 -> T n a -> CodeGenFunction r (T a)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T n a -> CodeGenFunction r (T a)
forall n r.
Positive n =>
Value Word32 -> T n a -> CodeGenFunction r (T a)
NiceVector.extract Value Word32
k (NVVector n a -> T n a
forall n a. NVVector n a -> T n a
Inst.fromNiceValue NVVector n a
v)

insert ::
   (TypeNum.Positive n, NiceVector.C a) =>
   LLVM.Value Word32 -> NiceValue.T a ->
   NVVector n a -> LLVM.CodeGenFunction r (NVVector n a)
insert :: forall n a r.
(Positive n, C a) =>
Value Word32
-> T a -> NVVector n a -> CodeGenFunction r (NVVector n a)
insert Value Word32
k T a
a = (T n a -> CodeGenFunction r (T n a))
-> NVVector n a -> CodeGenFunction r (NVVector n a)
forall (f :: * -> *) n a m b.
Functor f =>
(T n a -> f (T m b)) -> NVVector n a -> f (NVVector m b)
Inst.liftNiceValueM (Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
forall n r.
Positive n =>
Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
NiceVector.insert Value Word32
k T a
a)


replicate ::
   (TypeNum.Positive n, NiceVector.C a) =>
   NiceValue.T a -> LLVM.CodeGenFunction r (NVVector n a)
replicate :: forall n a r.
(Positive n, C a) =>
T a -> CodeGenFunction r (NVVector n a)
replicate = (T n a -> NVVector n a)
-> CodeGenFunction r (T n a) -> CodeGenFunction r (NVVector n a)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T n a -> NVVector n a
forall n a. T n a -> NVVector n a
Inst.toNiceValue (CodeGenFunction r (T n a) -> CodeGenFunction r (NVVector n a))
-> (T a -> CodeGenFunction r (T n a))
-> T a
-> CodeGenFunction r (NVVector n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> CodeGenFunction r (T n a)
forall n a r. (Positive n, C a) => T a -> CodeGenFunction r (T n a)
NiceVector.replicate

iterate ::
   (TypeNum.Positive n, NiceVector.C a) =>
   (NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T a)) ->
   NiceValue.T a -> LLVM.CodeGenFunction r (NVVector n a)
iterate :: forall n a r.
(Positive n, C a) =>
(T a -> CodeGenFunction r (T a))
-> T a -> CodeGenFunction r (NVVector n a)
iterate T a -> CodeGenFunction r (T a)
f = (T n a -> NVVector n a)
-> CodeGenFunction r (T n a) -> CodeGenFunction r (NVVector n a)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T n a -> NVVector n a
forall n a. T n a -> NVVector n a
Inst.toNiceValue (CodeGenFunction r (T n a) -> CodeGenFunction r (NVVector n a))
-> (T a -> CodeGenFunction r (T n a))
-> T a
-> CodeGenFunction r (NVVector n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a -> CodeGenFunction r (T a))
-> T a -> CodeGenFunction r (T n a)
forall n a r.
(Positive n, C a) =>
(T a -> CodeGenFunction r (T a))
-> T a -> CodeGenFunction r (T n a)
NiceVector.iterate T a -> CodeGenFunction r (T a)
f

take ::
   (TypeNum.Positive n, TypeNum.Positive m, NiceVector.C a) =>
   NVVector n a -> LLVM.CodeGenFunction r (NVVector m a)
take :: forall n m a r.
(Positive n, Positive m, C a) =>
NVVector n a -> CodeGenFunction r (NVVector m a)
take = (T n a -> CodeGenFunction r (T m a))
-> NVVector n a -> CodeGenFunction r (NVVector m a)
forall (f :: * -> *) n a m b.
Functor f =>
(T n a -> f (T m b)) -> NVVector n a -> f (NVVector m b)
Inst.liftNiceValueM T n a -> CodeGenFunction r (T m a)
forall n m a r.
(Positive n, Positive m, C a) =>
T n a -> CodeGenFunction r (T m a)
NiceVector.take

takeRev ::
   (TypeNum.Positive n, TypeNum.Positive m, NiceVector.C a) =>
   NVVector n a -> LLVM.CodeGenFunction r (NVVector m a)
takeRev :: forall n m a r.
(Positive n, Positive m, C a) =>
NVVector n a -> CodeGenFunction r (NVVector m a)
takeRev = (T n a -> CodeGenFunction r (T m a))
-> NVVector n a -> CodeGenFunction r (NVVector m a)
forall (f :: * -> *) n a m b.
Functor f =>
(T n a -> f (T m b)) -> NVVector n a -> f (NVVector m b)
Inst.liftNiceValueM T n a -> CodeGenFunction r (T m a)
forall n m a r.
(Positive n, Positive m, C a) =>
T n a -> CodeGenFunction r (T m a)
NiceVector.takeRev


dissect ::
   (TypeNum.Positive n, NiceVector.C a) =>
   NVVector n a -> LLVM.CodeGenFunction r [NiceValue.T a]
dissect :: forall n a r.
(Positive n, C a) =>
NVVector n a -> CodeGenFunction r [T a]
dissect = T n a -> CodeGenFunction r [T a]
forall n a r. (Positive n, C a) => T n a -> CodeGenFunction r [T a]
NiceVector.dissect (T n a -> CodeGenFunction r [T a])
-> (NVVector n a -> T n a)
-> NVVector n a
-> CodeGenFunction r [T a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVVector n a -> T n a
forall n a. NVVector n a -> T n a
Inst.fromNiceValue

dissect1 ::
   (TypeNum.Positive n, NiceVector.C a) =>
   NVVector n a -> LLVM.CodeGenFunction r (NonEmpty.T [] (NiceValue.T a))
dissect1 :: forall n a r.
(Positive n, C a) =>
NVVector n a -> CodeGenFunction r (T [] (T a))
dissect1 = T n a -> CodeGenFunction r (T [] (T a))
forall n a r.
(Positive n, C a) =>
T n a -> CodeGenFunction r (T [] (T a))
NiceVector.dissect1 (T n a -> CodeGenFunction r (T [] (T a)))
-> (NVVector n a -> T n a)
-> NVVector n a
-> CodeGenFunction r (T [] (T a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NVVector n a -> T n a
forall n a. NVVector n a -> T n a
Inst.fromNiceValue

select ::
   (TypeNum.Positive n, NiceVector.Select a) =>
   NVVector n Bool ->
   NVVector n a -> NVVector n a ->
   LLVM.CodeGenFunction r (NVVector n a)
select :: forall n a r.
(Positive n, Select a) =>
NVVector n Bool
-> NVVector n a -> NVVector n a -> CodeGenFunction r (NVVector n a)
select = (T n Bool -> T n a -> T n a -> CodeGenFunction r (T n a))
-> NVVector n Bool
-> NVVector n a
-> NVVector n a
-> CodeGenFunction r (NVVector n a)
forall (f :: * -> *) n a m b c k d.
Functor f =>
(T n a -> T m b -> T m c -> f (T k d))
-> NVVector n a -> NVVector m b -> NVVector m c -> f (NVVector k d)
Inst.liftNiceValueM3 T n Bool -> T n a -> T n a -> CodeGenFunction r (T n a)
forall a n r.
(Select a, Positive n) =>
T n Bool -> T n a -> T n a -> CodeGenFunction r (T n a)
forall n r.
Positive n =>
T n Bool -> T n a -> T n a -> CodeGenFunction r (T n a)
NiceVector.select

cmp ::
   (TypeNum.Positive n, NiceVector.Comparison a) =>
   LLVM.CmpPredicate ->
   NVVector n a -> NVVector n a ->
   LLVM.CodeGenFunction r (NVVector n Bool)
cmp :: forall n a r.
(Positive n, Comparison a) =>
CmpPredicate
-> NVVector n a
-> NVVector n a
-> CodeGenFunction r (NVVector n Bool)
cmp = (T n a -> T n a -> CodeGenFunction r (T n Bool))
-> NVVector n a
-> NVVector n a
-> CodeGenFunction r (NVVector n Bool)
forall (f :: * -> *) n a m b k c.
Functor f =>
(T n a -> T m b -> f (T k c))
-> NVVector n a -> NVVector m b -> f (NVVector k c)
Inst.liftNiceValueM2 ((T n a -> T n a -> CodeGenFunction r (T n Bool))
 -> NVVector n a
 -> NVVector n a
 -> CodeGenFunction r (NVVector n Bool))
-> (CmpPredicate -> T n a -> T n a -> CodeGenFunction r (T n Bool))
-> CmpPredicate
-> NVVector n a
-> NVVector n a
-> CodeGenFunction r (NVVector n Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmpPredicate -> T n a -> T n a -> CodeGenFunction r (T n Bool)
forall a n r.
(Comparison a, Positive n) =>
CmpPredicate -> T n a -> T n a -> CodeGenFunction r (T n Bool)
forall n r.
Positive n =>
CmpPredicate -> T n a -> T n a -> CodeGenFunction r (T n Bool)
NiceVector.cmp


{-
ToDo: make this a super-class of NiceValue.NativeInteger
problem: we need NiceValue.Repr, which provokes an import cycle
maybe we should break the cycle using a ConstraintKind,
i.e. define class NativeIntegerVec in NiceValue,
and define NativeInteger = NiceValue.NativeIntegerVec here
and export only NiceValueVec.NativeInteger constraint synonym.
-}
class
   (NiceValue.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,
    NiceVector.NativeInteger n i ir,
    NiceValue.NativeInteger i ir) =>
      NativeInteger (LLVM.Vector n i) (LLVM.Vector m ir) where


class
   (NiceValue.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,
    NiceVector.NativeFloating n a ar,
    NiceValue.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) =>
   NiceValue.T i -> LLVM.CodeGenFunction r (NiceValue.T a)
fromIntegral :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar,
 ShapeOf ir ~ ShapeOf ar) =>
T i -> CodeGenFunction r (T a)
fromIntegral = (Repr i -> CodeGenFunction r (Repr a))
-> T i -> CodeGenFunction r (T a)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
NiceValue.liftM Value ir -> CodeGenFunction r (Value ar)
Repr i -> CodeGenFunction r (Repr a)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsFloating b,
 ShapeOf a ~ ShapeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.inttofp


truncateToInt ::
   (NativeInteger i ir, NativeFloating a ar,
    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>
   NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T i)
truncateToInt :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar,
 ShapeOf ir ~ ShapeOf ar) =>
T a -> CodeGenFunction r (T i)
truncateToInt = (Repr a -> CodeGenFunction r (Repr i))
-> T a -> CodeGenFunction r (T i)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
NiceValue.liftM Value ar -> CodeGenFunction r (Value ir)
Repr a -> CodeGenFunction r (Repr i)
forall (value :: * -> *) a b r.
(ValueCons value, IsFloating a, IsInteger b,
 ShapeOf a ~ ShapeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.fptoint

splitFractionToInt ::
   (NativeInteger i ir, NativeFloating a ar,
    LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) =>
   NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T (i,a))
splitFractionToInt :: forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar,
 ShapeOf ir ~ ShapeOf ar) =>
T a -> CodeGenFunction r (T (i, a))
splitFractionToInt = (Repr a -> CodeGenFunction r (Repr (i, a)))
-> T a -> CodeGenFunction r (T (i, a))
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
NiceValue.liftM Value ar -> CodeGenFunction r (Value ir, Value ar)
Repr a -> CodeGenFunction r (Repr (i, a))
forall a i r.
(IsFloating a, CmpRet a, IsInteger i, IntegerConstant i, CmpRet i,
 CmpResult a ~ CmpResult i, ShapeOf a ~ ShapeOf i) =>
Value a -> CodeGenFunction r (Value i, Value a)
SoV.splitFractionToInt