{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module LLVM.Extra.Multi.Vector (
   T(Cons), consPrim, deconsPrim,
   C(..),
   Value,
   map,
   zip, zip3, unzip, unzip3,
   replicate,
   iterate,
   take,
   takeRev,

   lift1,

   modify,
   assemble,
   dissect,
   dissectList,

   reverse,
   rotateUp,
   rotateDown,
   shiftUp,
   shiftDown,
   shiftUpMultiZero,
   shiftDownMultiZero,
   shiftUpMultiUndef,
   shiftDownMultiUndef,

   undefPrimitive,
   shufflePrimitive,
   extractPrimitive,
   insertPrimitive,

   shuffleMatchTraversable,
   insertTraversable,
   extractTraversable,

   IntegerConstant(..),
   RationalConstant(..),
   Additive(..),
   PseudoRing(..),
   Field(..),
   PseudoModule(..),
   Real(..),
   Fraction(..),
   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.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, foldM, fmap, return, (>>), (=<<), )
import Control.Applicative (liftA2, )

import Prelude
         (Float, Double, Integer, Int, Rational,
          fromIntegral, asTypeOf, (-), (+), error, )


newtype T n a = Cons (Tuple.VectorValueOf 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 = Cons

deconsPrim ::
   (Tuple.VectorValueOf n a ~ Value n a) =>
   T n a -> LLVM.Value (LLVM.Vector n a)
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


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


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
   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
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Bool8 where
   cons = consPrimitive . fmap Bool8.toBool
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Float where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Double where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Int where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Int8 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Int16 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Int32 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Int64 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Word where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Word8 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Word16 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Word32 where
   cons = consPrimitive
   undef = undefPrimitive
   zero = zeroPrimitive
   phi = phiPrimitive
   addPhi = addPhiPrimitive
   shuffle = shufflePrimitive
   extract = extractPrimitive
   insert = insertPrimitive

instance C Word64 where
   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, Tuple.VectorValueOf 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) =>
   T n a
undefPrimitive = Cons $ LLVM.value LLVM.undef

zeroPrimitive ::
   (TypeNum.Positive n, IsPrimitive al, Tuple.VectorValueOf 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) =>
   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) =>
   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) =>
   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,
    Tuple.ValueOf a ~ LLVM.Value al,
    Tuple.VectorValueOf 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) =>
   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
   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
   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
   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)

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,
    Tuple.VectorValueOf 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,
    Tuple.VectorValueOf 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 =
   foldM (\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..])


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 =
   foldM
      (\(x,v) k -> Monad.lift2 (,) (f x) (insert (valueOf k) x v))
      (x0,v0)
      (List.take (size v0) [0..])


-- * re-ordering of elements

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

{- |
Rotate one element towards the higher elements.

I don't want to call it rotateLeft or rotateRight,
because there is no prefered layout for the vector elements.
In Intel's instruction manual vector
elements are indexed like the bits,
that is from right to left.
However, when working with Haskell list and enumeration syntax,
the start index is left.
-}
rotateUp ::
   (TypeNum.Positive n, C a) =>
   T n a -> CodeGenFunction r (T n a)
rotateUp x =
   shuffleMatch
      (constCyclicVector $
       (fromIntegral (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+) (fromIntegral (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 (,)
      (extract (LLVM.valueOf (fromIntegral (size x) - 1)) 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 (fromIntegral (size x) - 1)) x0 y)

shiftUpMultiIndices ::
   (TypeNum.Positive n) => Int -> Int -> LLVM.ConstValue (LLVM.Vector n Word32)
shiftUpMultiIndices n sizev =
   constCyclicVector $ fmap 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 $
   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


-- * method implementations based on Traversable

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


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 f (Cons a) = Cons $ f a

_liftM0 ::
   (Monad m) =>
   m (Tuple.VectorValueOf 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) ->
   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)) ->
   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)) ->
   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)) ->
   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


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 ::
      (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

instance PseudoModule Double where
   scale = liftM2 A.mul

instance (TypeNum.Positive n, PseudoModule a) => A.PseudoModule (T n a) where
   scale = scale


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 (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 (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, C 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 :: (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)
   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