{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UnboxedTuples         #-}
{-# LANGUAGE UndecidableInstances  #-}
-- |
-- Adaptive array type which picks vector representation from type of
-- element of array. For example arrays of @Double@ are backed by
-- @ByteArray@, arrays of @Bool@ are represented as bit-vector, arrays
-- of tuples are products of arrays. 'Unbox' type class is used to
-- describe representation of an array.
module Data.Vector.Fixed.Unboxed(
    -- * Data type
    Vec(..)
  , Vec1
  , Vec2
  , Vec3
  , Vec4
  , Vec5
    -- * Type classes & derivation
  , Unbox
  , UnboxViaPrim
    -- * Concrete representations
  , BitVec
  , T2(..)
  , T3(..)
  ) where

import Control.Applicative   (Const(..))
import Control.DeepSeq       (NFData(..))
import Data.Bits
import Data.Complex
import Data.Coerce
import Data.Data
import Data.Kind
import Data.Functor.Identity (Identity(..))
import Data.Int              (Int8, Int16, Int32, Int64 )
import Data.Monoid           (Monoid(..),Dual(..),Sum(..),Product(..),All(..),Any(..))
import Data.Semigroup        (Semigroup(..))
import Data.Ord              (Down(..))
import Data.Word             (Word,Word8,Word16,Word32,Word64)
import Foreign.Storable      (Storable(..))
import GHC.TypeLits
import GHC.Exts              (Proxy#, proxy#)
import Prelude               ( Show(..),Eq(..),Ord(..),Num(..),Applicative(..)
                             , Int,Double,Float,Char,Bool(..),($),id)

import Data.Vector.Fixed           (Dim,Vector(..),ViaFixed(..))
import Data.Vector.Fixed           qualified as F
import Data.Vector.Fixed.Cont      qualified as C
import Data.Vector.Fixed.Cont      (Peano,Arity,ArityPeano,Fun(..),curryFirst)
import Data.Vector.Fixed.Primitive qualified as P



----------------------------------------------------------------
-- Data type
----------------------------------------------------------------

-- | Adaptive array of dimension @n@ and containing elements of type
--   @a@.
newtype Vec (n :: Nat) a = Vec { forall (n :: Nat) a. Vec n a -> VecRepr n a (EltRepr a)
getVecRepr :: VecRepr n a (EltRepr a) }

type Vec1 = Vec 1
type Vec2 = Vec 2
type Vec3 = Vec 3
type Vec4 = Vec 4
type Vec5 = Vec 5

-- | Type class which selects internal representation of unboxed vector.
--
--   Crucial design constraint is this type class must be
--   GND-derivable. And this rules out anything mentioning 'Fun',
--   since all it's parameters has @nominal@ role. Thus 'Vector' is
--   not GND-derivable and we have to take somewhat roundabout
--   approach.
class ( Dim    (VecRepr n a) ~ Peano n
      , Vector (VecRepr n a) (EltRepr a)
      ) => Unbox n a where
  -- | Vector data type to use as a representation.
  type VecRepr n a :: Type -> Type
  -- | Element data type to use as a representation.
  type EltRepr   a :: Type
  -- | Convert element to its representation
  toEltRepr   :: Proxy# n -> a -> EltRepr a
  -- | Convert element from its representation
  fromEltRepr :: Proxy# n -> EltRepr a -> a

type instance Dim (Vec n) = Peano n

instance (Arity n, Unbox n a) => Vector (Vec n) a where
  inspect :: forall b. Vec n a -> Fun (Dim (Vec n)) a b -> b
inspect (Vec VecRepr n a (EltRepr a)
v) Fun (Dim (Vec n)) a b
f
    = VecRepr n a (EltRepr a)
-> Fun (Dim (VecRepr n a)) (EltRepr a) b -> b
forall b.
VecRepr n a (EltRepr a)
-> Fun (Dim (VecRepr n a)) (EltRepr a) b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect VecRepr n a (EltRepr a)
v
      ((EltRepr a -> a)
-> (b -> b) -> Fun (Peano n) a b -> Fun (Peano n) (EltRepr a) b
forall (n :: PeanoNum) a b c d.
ArityPeano n =>
(a -> b) -> (c -> d) -> Fun n b c -> Fun n a d
C.dimapFun (Proxy# n -> EltRepr a -> a
forall (n :: Nat) a. Unbox n a => Proxy# n -> EltRepr a -> a
fromEltRepr (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n)) b -> b
forall a. a -> a
id Fun (Dim (Vec n)) a b
Fun (Peano n) a b
f)
  construct :: Fun (Dim (Vec n)) a (Vec n a)
construct
    = (a -> EltRepr a)
-> (VecRepr n a (EltRepr a) -> Vec n a)
-> Fun (Peano n) (EltRepr a) (VecRepr n a (EltRepr a))
-> Fun (Peano n) a (Vec n a)
forall (n :: PeanoNum) a b c d.
ArityPeano n =>
(a -> b) -> (c -> d) -> Fun n b c -> Fun n a d
C.dimapFun (Proxy# n -> a -> EltRepr a
forall (n :: Nat) a. Unbox n a => Proxy# n -> a -> EltRepr a
toEltRepr (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @n)) VecRepr n a (EltRepr a) -> Vec n a
forall (n :: Nat) a. VecRepr n a (EltRepr a) -> Vec n a
Vec
      (forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct @(VecRepr n a) @(EltRepr a))
  {-# INLINE inspect   #-}
  {-# INLINE construct #-}



----------------------------------------------------------------
-- Generic instances
----------------------------------------------------------------

deriving via ViaFixed (Vec n) a instance (Unbox n a, Show      a) => Show      (Vec n a)
deriving via ViaFixed (Vec n) a instance (Unbox n a, Eq        a) => Eq        (Vec n a)
deriving via ViaFixed (Vec n) a instance (Unbox n a, Ord       a) => Ord       (Vec n a)
deriving via ViaFixed (Vec n) a instance (Unbox n a, NFData    a) => NFData    (Vec n a)
deriving via ViaFixed (Vec n) a instance (Unbox n a, Semigroup a) => Semigroup (Vec n a)
deriving via ViaFixed (Vec n) a instance (Unbox n a, Monoid    a) => Monoid    (Vec n a)
deriving via ViaFixed (Vec n) a instance (Unbox n a, Storable  a) => Storable  (Vec n a)

instance (Typeable n, Unbox n a, Data a) => Data (Vec n a) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vec n a -> c (Vec n a)
gfoldl       = (forall x y. Data x => c (x -> y) -> x -> c y)
-> (forall x. x -> c x) -> Vec n a -> c (Vec n a)
forall (c :: * -> *) (v :: * -> *) a.
(Vector v a, Data a) =>
(forall x y. Data x => c (x -> y) -> x -> c y)
-> (forall x. x -> c x) -> v a -> c (v a)
C.gfoldl
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Vec n a)
gunfold      = (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Vec n a)
forall con (c :: * -> *) (v :: * -> *) a.
(Vector v a, Data a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> con -> c (v a)
C.gunfold
  toConstr :: Vec n a -> Constr
toConstr   Vec n a
_ = Constr
con_Vec
  dataTypeOf :: Vec n a -> DataType
dataTypeOf Vec n a
_ = DataType
ty_Vec

ty_Vec :: DataType
ty_Vec :: DataType
ty_Vec  = String -> [Constr] -> DataType
mkDataType String
"Data.Vector.Fixed.Unboxed.Vec" [Constr
con_Vec]

con_Vec :: Constr
con_Vec :: Constr
con_Vec = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
ty_Vec String
"Vec" [] Fixity
Prefix


----------------------------------------------------------------
-- Data instances
----------------------------------------------------------------

instance F.Arity n => Unbox n () where
  type VecRepr n () = VecUnit n
  type EltRepr   () = ()
  toEltRepr :: Proxy# n -> () -> EltRepr ()
toEltRepr   Proxy# n
_ = () -> ()
() -> EltRepr ()
forall a. a -> a
id
  fromEltRepr :: Proxy# n -> EltRepr () -> ()
fromEltRepr Proxy# n
_ = () -> ()
EltRepr () -> ()
forall a. a -> a
id
  {-# INLINE toEltRepr   #-}
  {-# INLINE fromEltRepr #-}

data VecUnit (n :: Nat) a = VecUnit

type instance Dim (VecUnit n) = Peano n

instance F.Arity n => Vector (VecUnit n) () where
  inspect :: forall b. VecUnit n () -> Fun (Dim (VecUnit n)) () b -> b
inspect VecUnit n ()
_ Fun (Dim (VecUnit n)) () b
fun
    = Fun (Peano n) () b -> ContVec (Peano n) () -> b
forall (n :: PeanoNum) a r. Fun n a r -> ContVec n a -> r
C.runContVec Fun (Dim (VecUnit n)) () b
Fun (Peano n) () b
fun
    (ContVec (Peano n) () -> b) -> ContVec (Peano n) () -> b
forall a b. (a -> b) -> a -> b
$ (forall (k :: PeanoNum). Proxy ('S k) -> ((), Proxy k))
-> Proxy (Peano n) -> ContVec (Peano n) ()
forall (n :: PeanoNum) (t :: PeanoNum -> *) a.
ArityPeano n =>
(forall (k :: PeanoNum). t ('S k) -> (a, t k))
-> t n -> ContVec n a
C.apply (\Proxy ('S k)
Proxy -> ((),Proxy k
forall {k} (t :: k). Proxy t
Proxy)) Proxy (Peano n)
forall {k} (t :: k). Proxy t
Proxy
  construct :: Fun (Dim (VecUnit n)) () (VecUnit n ())
construct
    = VecUnit n () -> Fun (Peano n) () (VecUnit n ())
forall a. a -> Fun (Peano n) () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VecUnit n ()
forall (n :: Nat) a. VecUnit n a
VecUnit
  {-# INLINE inspect   #-}
  {-# INLINE construct #-}



----------------------------------------------------------------
-- Boolean

-- | Bit vector represented as 64-bit word. This puts upper limit on
--   length of vector. It's not a big problem. 64-element will strain
--   GHC quite a bit.
data BitVec (n :: Nat) a = BitVec Word64

type instance Dim (BitVec n) = Peano n

instance (n <= 64, Arity n, a ~ Bool) => Vector (BitVec n) a where
  inspect :: forall b. BitVec n a -> Fun (Dim (BitVec n)) a b -> b
inspect (BitVec Word64
w) = ContVec (Peano n) a -> Fun (Dim (ContVec (Peano n))) a b -> b
forall b.
ContVec (Peano n) a -> Fun (Dim (ContVec (Peano n))) a b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect ((Int -> a) -> ContVec (Peano n) a
forall (n :: PeanoNum) a. ArityPeano n => (Int -> a) -> ContVec n a
C.generate (Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
w))
  construct :: Fun (Dim (BitVec n)) a (BitVec n a)
construct = (forall (k :: PeanoNum).
 Const (Int, Word64) ('S k) -> a -> Const (Int, Word64) k)
-> (Const (Int, Word64) 'Z -> BitVec n a)
-> Const (Int, Word64) (Peano n)
-> Fun (Peano n) a (BitVec n a)
forall (n :: PeanoNum) (t :: PeanoNum -> *) a b.
ArityPeano n =>
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t n -> Fun n a b
forall (t :: PeanoNum -> *) a b.
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t (Peano n) -> Fun (Peano n) a b
C.accum
    (\(Const (Int
i,Word64
w)) -> \case
          a
Bool
True  -> (Int, Word64) -> Const (Int, Word64) k
forall {k} a (b :: k). a -> Const a b
Const (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
setBit Word64
w Int
i)
          a
Bool
False -> (Int, Word64) -> Const (Int, Word64) k
forall {k} a (b :: k). a -> Const a b
Const (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Word64
w))
    (\(Const (Int
_,Word64
w)) -> Word64 -> BitVec n a
forall (n :: Nat) a. Word64 -> BitVec n a
BitVec Word64
w)
    ((Int, Word64) -> Const (Int, Word64) (Peano n)
forall {k} a (b :: k). a -> Const a b
Const (Int
0,Word64
0))

instance (n <= 64, Arity n) => Unbox n Bool where
  type VecRepr n Bool = BitVec n
  type EltRepr   Bool = Bool
  toEltRepr :: Proxy# n -> Bool -> EltRepr Bool
toEltRepr   Proxy# n
_ = Bool -> Bool
Bool -> EltRepr Bool
forall a. a -> a
id
  fromEltRepr :: Proxy# n -> EltRepr Bool -> Bool
fromEltRepr Proxy# n
_ = Bool -> Bool
EltRepr Bool -> Bool
forall a. a -> a
id
  {-# INLINE toEltRepr   #-}
  {-# INLINE fromEltRepr #-}



----------------------------------------------------------------
-- Primitive wrappers
----------------------------------------------------------------

-- | Wrapper for deriving 'Unbox' for data types which are instances
--   of 'P.Prim' type class:
--
-- > deriving via UnboxViaPrim Word instance (C.Arity n) => Unbox n Word
newtype UnboxViaPrim a = UnboxViaPrim a
  deriving newtype Addr# -> Int# -> UnboxViaPrim a
ByteArray# -> Int# -> UnboxViaPrim a
Proxy (UnboxViaPrim a) -> Int#
UnboxViaPrim a -> Int#
(Proxy (UnboxViaPrim a) -> Int#)
-> (UnboxViaPrim a -> Int#)
-> (Proxy (UnboxViaPrim a) -> Int#)
-> (UnboxViaPrim a -> Int#)
-> (ByteArray# -> Int# -> UnboxViaPrim a)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, UnboxViaPrim a #))
-> (forall s.
    MutableByteArray# s
    -> Int# -> UnboxViaPrim a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s)
-> (Addr# -> Int# -> UnboxViaPrim a)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, UnboxViaPrim a #))
-> (forall s.
    Addr# -> Int# -> UnboxViaPrim a -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s)
-> Prim (UnboxViaPrim a)
forall s.
Addr# -> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
forall s.
Addr# -> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
forall s. Addr# -> Int# -> UnboxViaPrim a -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
forall s.
MutableByteArray# s
-> Int# -> UnboxViaPrim a -> State# s -> State# s
forall a. Prim a => Addr# -> Int# -> UnboxViaPrim a
forall a. Prim a => ByteArray# -> Int# -> UnboxViaPrim a
forall a. Prim a => Proxy (UnboxViaPrim a) -> Int#
forall a. Prim a => UnboxViaPrim a -> Int#
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
forall a s.
Prim a =>
Addr# -> Int# -> UnboxViaPrim a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> UnboxViaPrim a -> State# s -> State# s
forall a.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
$csizeOfType# :: forall a. Prim a => Proxy (UnboxViaPrim a) -> Int#
sizeOfType# :: Proxy (UnboxViaPrim a) -> Int#
$csizeOf# :: forall a. Prim a => UnboxViaPrim a -> Int#
sizeOf# :: UnboxViaPrim a -> Int#
$calignmentOfType# :: forall a. Prim a => Proxy (UnboxViaPrim a) -> Int#
alignmentOfType# :: Proxy (UnboxViaPrim a) -> Int#
$calignment# :: forall a. Prim a => UnboxViaPrim a -> Int#
alignment# :: UnboxViaPrim a -> Int#
$cindexByteArray# :: forall a. Prim a => ByteArray# -> Int# -> UnboxViaPrim a
indexByteArray# :: ByteArray# -> Int# -> UnboxViaPrim a
$creadByteArray# :: forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
$cwriteByteArray# :: forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> UnboxViaPrim a -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s
-> Int# -> UnboxViaPrim a -> State# s -> State# s
$csetByteArray# :: forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
$cindexOffAddr# :: forall a. Prim a => Addr# -> Int# -> UnboxViaPrim a
indexOffAddr# :: Addr# -> Int# -> UnboxViaPrim a
$creadOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
readOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, UnboxViaPrim a #)
$cwriteOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> UnboxViaPrim a -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> UnboxViaPrim a -> State# s -> State# s
$csetOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> UnboxViaPrim a -> State# s -> State# s
P.Prim

instance (C.Arity n, P.Prim a) => Unbox n (UnboxViaPrim a) where
  type VecRepr n (UnboxViaPrim a) = P.Vec n
  type EltRepr   (UnboxViaPrim a) = a
  toEltRepr :: Proxy# n -> UnboxViaPrim a -> EltRepr (UnboxViaPrim a)
toEltRepr   Proxy# n
_ = UnboxViaPrim a -> a
UnboxViaPrim a -> EltRepr (UnboxViaPrim a)
forall a b. Coercible a b => a -> b
coerce
  fromEltRepr :: Proxy# n -> EltRepr (UnboxViaPrim a) -> UnboxViaPrim a
fromEltRepr Proxy# n
_ = a -> UnboxViaPrim a
EltRepr (UnboxViaPrim a) -> UnboxViaPrim a
forall a b. Coercible a b => a -> b
coerce
  
deriving via UnboxViaPrim Int    instance (C.Arity n) => Unbox n Int 
deriving via UnboxViaPrim Int8   instance (C.Arity n) => Unbox n Int8
deriving via UnboxViaPrim Int16  instance (C.Arity n) => Unbox n Int16
deriving via UnboxViaPrim Int32  instance (C.Arity n) => Unbox n Int32
deriving via UnboxViaPrim Int64  instance (C.Arity n) => Unbox n Int64
deriving via UnboxViaPrim Word   instance (C.Arity n) => Unbox n Word 
deriving via UnboxViaPrim Word8  instance (C.Arity n) => Unbox n Word8
deriving via UnboxViaPrim Word16 instance (C.Arity n) => Unbox n Word16
deriving via UnboxViaPrim Word32 instance (C.Arity n) => Unbox n Word32
deriving via UnboxViaPrim Word64 instance (C.Arity n) => Unbox n Word64

deriving via UnboxViaPrim Char   instance (C.Arity n) => Unbox n Char
deriving via UnboxViaPrim Float  instance (C.Arity n) => Unbox n Float
deriving via UnboxViaPrim Double instance (C.Arity n) => Unbox n Double


----------------------------------------------------------------
-- Newtypes
----------------------------------------------------------------

deriving newtype instance (Unbox n a) => Unbox n (Const a b)
deriving newtype instance (Unbox n a) => Unbox n (Identity a)
deriving newtype instance (Unbox n a) => Unbox n (Down a)
deriving newtype instance (Unbox n a) => Unbox n (Dual a)
deriving newtype instance (Unbox n a) => Unbox n (Sum  a)
deriving newtype instance (Unbox n a) => Unbox n (Product a)

deriving newtype instance (n <= 64, Arity n) => Unbox n All
deriving newtype instance (n <= 64, Arity n) => Unbox n Any


----------------------------------------------------------------
-- Tuples
----------------------------------------------------------------

-- | Representation for vector of 2-tuple as two vectors.
data T2 n a b x = T2 !(Vec n a) !(Vec n b)

type instance Dim (T2 n a b) = Peano n

instance (Arity n, Unbox n a, Unbox n b) => Vector (T2 n a b) (a,b) where
  inspect :: forall b. T2 n a b (a, b) -> Fun (Dim (T2 n a b)) (a, b) b -> b
inspect (T2 Vec n a
vA Vec n b
vB)
    = ContVec (Peano n) (a, b)
-> Fun (Dim (ContVec (Peano n))) (a, b) b -> b
forall b.
ContVec (Peano n) (a, b)
-> Fun (Dim (ContVec (Peano n))) (a, b) b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect ((a -> b -> (a, b))
-> ContVec (Peano n) a
-> ContVec (Peano n) b
-> ContVec (Peano n) (a, b)
forall (n :: PeanoNum) a b c.
ArityPeano n =>
(a -> b -> c) -> ContVec n a -> ContVec n b -> ContVec n c
C.zipWith (,) ContVec (Peano n) a
cvA ContVec (Peano n) b
cvB)
    where
      cvA :: ContVec (Peano n) a
cvA = (forall r. Fun (Peano n) a r -> r) -> ContVec (Peano n) a
forall (n :: PeanoNum) a. (forall r. Fun n a r -> r) -> ContVec n a
C.ContVec ((forall r. Fun (Peano n) a r -> r) -> ContVec (Peano n) a)
-> (forall r. Fun (Peano n) a r -> r) -> ContVec (Peano n) a
forall a b. (a -> b) -> a -> b
$ Vec n a -> Fun (Dim (Vec n)) a r -> r
forall b. Vec n a -> Fun (Dim (Vec n)) a b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect Vec n a
vA
      cvB :: ContVec (Peano n) b
cvB = (forall r. Fun (Peano n) b r -> r) -> ContVec (Peano n) b
forall (n :: PeanoNum) a. (forall r. Fun n a r -> r) -> ContVec n a
C.ContVec ((forall r. Fun (Peano n) b r -> r) -> ContVec (Peano n) b)
-> (forall r. Fun (Peano n) b r -> r) -> ContVec (Peano n) b
forall a b. (a -> b) -> a -> b
$ Vec n b -> Fun (Dim (Vec n)) b r -> r
forall b. Vec n b -> Fun (Dim (Vec n)) b b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect Vec n b
vB
  construct :: Fun (Dim (T2 n a b)) (a, b) (T2 n a b (a, b))
construct = (Vec n a -> Vec n b -> T2 n a b (a, b))
-> Fun (Peano n) a (Vec n a)
-> Fun (Peano n) b (Vec n b)
-> Fun (Peano n) (a, b) (T2 n a b (a, b))
forall (n :: PeanoNum) x y z a b.
ArityPeano n =>
(x -> y -> z) -> Fun n a x -> Fun n b y -> Fun n (a, b) z
pairF Vec n a -> Vec n b -> T2 n a b (a, b)
forall (n :: Nat) a b x. Vec n a -> Vec n b -> T2 n a b x
T2 Fun (Dim (Vec n)) a (Vec n a)
Fun (Peano n) a (Vec n a)
forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct Fun (Dim (Vec n)) b (Vec n b)
Fun (Peano n) b (Vec n b)
forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

pairF
  :: ArityPeano n
  => (x -> y -> z)
  -> Fun n a x
  -> Fun n b y
  -> Fun n (a,b) z
{-# INLINE pairF #-}
pairF :: forall (n :: PeanoNum) x y z a b.
ArityPeano n =>
(x -> y -> z) -> Fun n a x -> Fun n b y -> Fun n (a, b) z
pairF x -> y -> z
g Fun n a x
funA Fun n b y
funB = (forall (k :: PeanoNum).
 T_pair a b x y ('S k) -> (a, b) -> T_pair a b x y k)
-> (T_pair a b x y 'Z -> z) -> T_pair a b x y n -> Fun n (a, b) z
forall (n :: PeanoNum) (t :: PeanoNum -> *) a b.
ArityPeano n =>
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t n -> Fun n a b
forall (t :: PeanoNum -> *) a b.
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t n -> Fun n a b
C.accum
  (\(T_pair Fun ('S k) a x
fA Fun ('S k) b y
fB) (a
a,b
b) -> Fun k a x -> Fun k b y -> T_pair a b x y k
forall a b x y (n :: PeanoNum).
Fun n a x -> Fun n b y -> T_pair a b x y n
T_pair (Fun ('S k) a x -> a -> Fun k a x
forall (n :: PeanoNum) a b. Fun ('S n) a b -> a -> Fun n a b
curryFirst Fun ('S k) a x
fA a
a) (Fun ('S k) b y -> b -> Fun k b y
forall (n :: PeanoNum) a b. Fun ('S n) a b -> a -> Fun n a b
curryFirst Fun ('S k) b y
fB b
b))
  (\(T_pair (Fun Fn 'Z a x
x) (Fun Fn 'Z b y
y)) -> x -> y -> z
g x
Fn 'Z a x
x y
Fn 'Z b y
y)
  (Fun n a x -> Fun n b y -> T_pair a b x y n
forall a b x y (n :: PeanoNum).
Fun n a x -> Fun n b y -> T_pair a b x y n
T_pair Fun n a x
funA Fun n b y
funB)

data T_pair a b x y n = T_pair (Fun n a x) (Fun n b y)


-- | Representation for vector of 2-tuple as two vectors.
data T3 n a b c x = T3 !(Vec n a) !(Vec n b) !(Vec n c)

type instance Dim (T3 n a b c) = Peano n

instance (Arity n, Unbox n a, Unbox n b, Unbox n c) => Vector (T3 n a b c) (a,b,c) where
  inspect :: forall b.
T3 n a b c (a, b, c) -> Fun (Dim (T3 n a b c)) (a, b, c) b -> b
inspect (T3 Vec n a
vA Vec n b
vB Vec n c
vC)
    = ContVec (Peano n) (a, b, c)
-> Fun (Dim (ContVec (Peano n))) (a, b, c) b -> b
forall b.
ContVec (Peano n) (a, b, c)
-> Fun (Dim (ContVec (Peano n))) (a, b, c) b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect ((a -> b -> c -> (a, b, c))
-> ContVec (Peano n) a
-> ContVec (Peano n) b
-> ContVec (Peano n) c
-> ContVec (Peano n) (a, b, c)
forall (n :: PeanoNum) a b c d.
ArityPeano n =>
(a -> b -> c -> d)
-> ContVec n a -> ContVec n b -> ContVec n c -> ContVec n d
C.zipWith3 (,,) ContVec (Peano n) a
cvA ContVec (Peano n) b
cvB ContVec (Peano n) c
cvC)
    where
      cvA :: ContVec (Peano n) a
cvA = (forall r. Fun (Peano n) a r -> r) -> ContVec (Peano n) a
forall (n :: PeanoNum) a. (forall r. Fun n a r -> r) -> ContVec n a
C.ContVec ((forall r. Fun (Peano n) a r -> r) -> ContVec (Peano n) a)
-> (forall r. Fun (Peano n) a r -> r) -> ContVec (Peano n) a
forall a b. (a -> b) -> a -> b
$ Vec n a -> Fun (Dim (Vec n)) a r -> r
forall b. Vec n a -> Fun (Dim (Vec n)) a b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect Vec n a
vA
      cvB :: ContVec (Peano n) b
cvB = (forall r. Fun (Peano n) b r -> r) -> ContVec (Peano n) b
forall (n :: PeanoNum) a. (forall r. Fun n a r -> r) -> ContVec n a
C.ContVec ((forall r. Fun (Peano n) b r -> r) -> ContVec (Peano n) b)
-> (forall r. Fun (Peano n) b r -> r) -> ContVec (Peano n) b
forall a b. (a -> b) -> a -> b
$ Vec n b -> Fun (Dim (Vec n)) b r -> r
forall b. Vec n b -> Fun (Dim (Vec n)) b b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect Vec n b
vB
      cvC :: ContVec (Peano n) c
cvC = (forall r. Fun (Peano n) c r -> r) -> ContVec (Peano n) c
forall (n :: PeanoNum) a. (forall r. Fun n a r -> r) -> ContVec n a
C.ContVec ((forall r. Fun (Peano n) c r -> r) -> ContVec (Peano n) c)
-> (forall r. Fun (Peano n) c r -> r) -> ContVec (Peano n) c
forall a b. (a -> b) -> a -> b
$ Vec n c -> Fun (Dim (Vec n)) c r -> r
forall b. Vec n c -> Fun (Dim (Vec n)) c b -> b
forall (v :: * -> *) a b. Vector v a => v a -> Fun (Dim v) a b -> b
inspect Vec n c
vC
  construct :: Fun (Dim (T3 n a b c)) (a, b, c) (T3 n a b c (a, b, c))
construct = (Vec n a -> Vec n b -> Vec n c -> T3 n a b c (a, b, c))
-> Fun (Peano n) a (Vec n a)
-> Fun (Peano n) b (Vec n b)
-> Fun (Peano n) c (Vec n c)
-> Fun (Peano n) (a, b, c) (T3 n a b c (a, b, c))
forall (n :: PeanoNum) x y z r a b c.
ArityPeano n =>
(x -> y -> z -> r)
-> Fun n a x -> Fun n b y -> Fun n c z -> Fun n (a, b, c) r
pair3F Vec n a -> Vec n b -> Vec n c -> T3 n a b c (a, b, c)
forall (n :: Nat) a b c x.
Vec n a -> Vec n b -> Vec n c -> T3 n a b c x
T3 Fun (Dim (Vec n)) a (Vec n a)
Fun (Peano n) a (Vec n a)
forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct Fun (Dim (Vec n)) b (Vec n b)
Fun (Peano n) b (Vec n b)
forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct Fun (Dim (Vec n)) c (Vec n c)
Fun (Peano n) c (Vec n c)
forall (v :: * -> *) a. Vector v a => Fun (Dim v) a (v a)
construct
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

pair3F
  :: ArityPeano n
  => (x -> y -> z -> r)
  -> Fun n a x
  -> Fun n b y
  -> Fun n c z
  -> Fun n (a,b,c) r
{-# INLINE pair3F #-}
pair3F :: forall (n :: PeanoNum) x y z r a b c.
ArityPeano n =>
(x -> y -> z -> r)
-> Fun n a x -> Fun n b y -> Fun n c z -> Fun n (a, b, c) r
pair3F x -> y -> z -> r
g Fun n a x
funA Fun n b y
funB Fun n c z
funC = (forall (k :: PeanoNum).
 T_pair3 a b c x y z ('S k) -> (a, b, c) -> T_pair3 a b c x y z k)
-> (T_pair3 a b c x y z 'Z -> r)
-> T_pair3 a b c x y z n
-> Fun n (a, b, c) r
forall (n :: PeanoNum) (t :: PeanoNum -> *) a b.
ArityPeano n =>
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t n -> Fun n a b
forall (t :: PeanoNum -> *) a b.
(forall (k :: PeanoNum). t ('S k) -> a -> t k)
-> (t 'Z -> b) -> t n -> Fun n a b
C.accum
  (\(T_pair3 Fun ('S k) a x
fA Fun ('S k) b y
fB Fun ('S k) c z
fC) (a
a,b
b,c
c) -> Fun k a x -> Fun k b y -> Fun k c z -> T_pair3 a b c x y z k
forall a b c x y z (n :: PeanoNum).
Fun n a x -> Fun n b y -> Fun n c z -> T_pair3 a b c x y z n
T_pair3 (Fun ('S k) a x -> a -> Fun k a x
forall (n :: PeanoNum) a b. Fun ('S n) a b -> a -> Fun n a b
curryFirst Fun ('S k) a x
fA a
a)
                                          (Fun ('S k) b y -> b -> Fun k b y
forall (n :: PeanoNum) a b. Fun ('S n) a b -> a -> Fun n a b
curryFirst Fun ('S k) b y
fB b
b)
                                          (Fun ('S k) c z -> c -> Fun k c z
forall (n :: PeanoNum) a b. Fun ('S n) a b -> a -> Fun n a b
curryFirst Fun ('S k) c z
fC c
c))
  (\(T_pair3 (Fun Fn 'Z a x
x) (Fun Fn 'Z b y
y) (Fun Fn 'Z c z
z)) -> x -> y -> z -> r
g x
Fn 'Z a x
x y
Fn 'Z b y
y z
Fn 'Z c z
z)
  (Fun n a x -> Fun n b y -> Fun n c z -> T_pair3 a b c x y z n
forall a b c x y z (n :: PeanoNum).
Fun n a x -> Fun n b y -> Fun n c z -> T_pair3 a b c x y z n
T_pair3 Fun n a x
funA Fun n b y
funB Fun n c z
funC)

data T_pair3 a b c x y z n = T_pair3 (Fun n a x) (Fun n b y) (Fun n c z)



instance (Unbox n a, Unbox n b) => Unbox n (a,b) where
  type VecRepr n (a,b) = T2 n a b
  type EltRepr   (a,b) = (a,b)
  toEltRepr :: Proxy# n -> (a, b) -> EltRepr (a, b)
toEltRepr   Proxy# n
_ = (a, b) -> (a, b)
(a, b) -> EltRepr (a, b)
forall a. a -> a
id
  fromEltRepr :: Proxy# n -> EltRepr (a, b) -> (a, b)
fromEltRepr Proxy# n
_ = (a, b) -> (a, b)
EltRepr (a, b) -> (a, b)
forall a. a -> a
id

instance (Unbox n a) => Unbox n (Complex a) where
  -- NOTE: It would be nice to have ability to use single buffer say
  --       for `Complex Double`. But buffers seems to be opaque
  type VecRepr n (Complex a) = T2 n a a
  type EltRepr   (Complex a) = (a,a)
  toEltRepr :: Proxy# n -> Complex a -> EltRepr (Complex a)
toEltRepr   Proxy# n
_ (a
r :+ a
i) = (a
r,a
i)
  fromEltRepr :: Proxy# n -> EltRepr (Complex a) -> Complex a
fromEltRepr Proxy# n
_ (a
r,a
i)    = a
r a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
i
  {-# INLINE toEltRepr   #-}
  {-# INLINE fromEltRepr #-}