{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
-- |
-- Unboxed vectors with fixed length. Vectors from
-- "Data.Vector.Fixed.Unboxed" provide more flexibility at no
-- performeance cost.
module Data.Vector.Fixed.Primitive (
    -- * Immutable
    Vec
  , Vec1
  , Vec2
  , Vec3
  , Vec4
  , Vec5
    -- * Mutable
  , MVec
    -- * Type classes
  , Prim
  ) where

import Control.Monad
import Control.DeepSeq (NFData(..))
import Data.Data
import Data.Monoid              (Monoid(..))
import Data.Semigroup           (Semigroup(..))
import Data.Primitive.ByteArray
import Data.Primitive
import qualified Foreign.Storable as Foreign (Storable(..))
import GHC.TypeLits
import Prelude (Show(..),Eq(..),Ord(..),Num(..))
import Prelude (($),($!),undefined,seq)


import Data.Vector.Fixed hiding (index)
import Data.Vector.Fixed.Mutable (Mutable, MVector(..), IVector(..), DimM, constructVec, inspectVec, arity, index)
import qualified Data.Vector.Fixed.Cont     as C
import qualified Data.Vector.Fixed.Internal as I



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

-- | Unboxed vector with fixed length
newtype Vec (n :: Nat) a = Vec ByteArray

-- | Mutable unboxed vector with fixed length
newtype MVec (n :: Nat) s a = MVec (MutableByteArray s)

deriving instance Typeable Vec
deriving instance Typeable MVec

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



----------------------------------------------------------------
-- Instances
----------------------------------------------------------------

instance (Arity n, Prim a, Show a) => Show (Vec n a) where
  showsPrec :: Int -> Vec n a -> ShowS
showsPrec = Int -> Vec n a -> ShowS
forall (v :: * -> *) a. (Vector v a, Show a) => Int -> v a -> ShowS
I.showsPrec

instance (Arity n, Prim a, NFData a) => NFData (Vec n a) where
  rnf :: Vec n a -> ()
rnf = (() -> a -> ()) -> () -> Vec n a -> ()
forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldl (\()
r a
a -> ()
r () -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a) ()
  {-# INLINE rnf #-}

type instance Mutable (Vec n) = MVec n

instance (Arity n, Prim a) => MVector (MVec n) a where
  new :: m (MVec n (PrimState m) a)
new = do
    MutableByteArray (PrimState m)
v <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> m (MutableByteArray (PrimState m)))
-> Int -> m (MutableByteArray (PrimState m))
forall a b. (a -> b) -> a -> b
$! Proxy n -> Int
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Int
arity (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
                       Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Prim a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
    MVec n (PrimState m) a -> m (MVec n (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVec n (PrimState m) a -> m (MVec n (PrimState m) a))
-> MVec n (PrimState m) a -> m (MVec n (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MutableByteArray (PrimState m) -> MVec n (PrimState m) a
forall (n :: Nat) s a. MutableByteArray s -> MVec n s a
MVec MutableByteArray (PrimState m)
v
  {-# INLINE new         #-}
  copy :: MVec n (PrimState m) a -> MVec n (PrimState m) a -> m ()
copy                       = MVec n (PrimState m) a -> MVec n (PrimState m) a -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
move
  {-# INLINE copy        #-}
  move :: MVec n (PrimState m) a -> MVec n (PrimState m) a -> m ()
move (MVec MutableByteArray (PrimState m)
dst) (MVec MutableByteArray (PrimState m)
src) = MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray (PrimState m)
dst Int
0 MutableByteArray (PrimState m)
src Int
0 (Proxy n -> Int
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Int
arity (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n))
  {-# INLINE move        #-}
  unsafeRead :: MVec n (PrimState m) a -> Int -> m a
unsafeRead  (MVec MutableByteArray (PrimState m)
v) Int
i   = MutableByteArray (PrimState m) -> Int -> m a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray  MutableByteArray (PrimState m)
v Int
i
  {-# INLINE unsafeRead  #-}
  unsafeWrite :: MVec n (PrimState m) a -> Int -> a -> m ()
unsafeWrite (MVec MutableByteArray (PrimState m)
v) Int
i a
x = MutableByteArray (PrimState m) -> Int -> a -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
v Int
i a
x
  {-# INLINE unsafeWrite #-}

instance (Arity n, Prim a) => IVector (Vec n) a where
  unsafeFreeze :: Mutable (Vec n) (PrimState m) a -> m (Vec n a)
unsafeFreeze (MVec v)   = do { ByteArray
a <- MutableByteArray (PrimState m) -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray (PrimState m)
v; Vec n a -> m (Vec n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vec n a -> m (Vec n a)) -> Vec n a -> m (Vec n a)
forall a b. (a -> b) -> a -> b
$! ByteArray -> Vec n a
forall (n :: Nat) a. ByteArray -> Vec n a
Vec  ByteArray
a }
  unsafeThaw :: Vec n a -> m (Mutable (Vec n) (PrimState m) a)
unsafeThaw   (Vec  ByteArray
v)   = do { MutableByteArray (PrimState m)
a <- ByteArray -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray   ByteArray
v; MVec n (PrimState m) a -> m (MVec n (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVec n (PrimState m) a -> m (MVec n (PrimState m) a))
-> MVec n (PrimState m) a -> m (MVec n (PrimState m) a)
forall a b. (a -> b) -> a -> b
$! MutableByteArray (PrimState m) -> MVec n (PrimState m) a
forall (n :: Nat) s a. MutableByteArray s -> MVec n s a
MVec MutableByteArray (PrimState m)
a }
  unsafeIndex :: Vec n a -> Int -> a
unsafeIndex  (Vec  ByteArray
v) Int
i = ByteArray -> Int -> a
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
v Int
i
  {-# INLINE unsafeFreeze #-}
  {-# INLINE unsafeThaw   #-}
  {-# INLINE unsafeIndex  #-}



type instance Dim  (Vec  n) = n
type instance DimM (MVec n) = n

instance (Arity n, Prim a) => Vector (Vec n) a where
  construct :: Fun (Peano (Dim (Vec n))) a (Vec n a)
construct  = Fun (Peano (Dim (Vec n))) a (Vec n a)
forall (v :: * -> *) a.
(Arity (Dim v), IVector v a) =>
Fun (Peano (Dim v)) a (v a)
constructVec
  inspect :: Vec n a -> Fun (Peano (Dim (Vec n))) a b -> b
inspect    = Vec n a -> Fun (Peano (Dim (Vec n))) a b -> b
forall (v :: * -> *) a b.
(Arity (Dim v), IVector v a) =>
v a -> Fun (Peano (Dim v)) a b -> b
inspectVec
  basicIndex :: Vec n a -> Int -> a
basicIndex = Vec n a -> Int -> a
forall (v :: * -> *) a. IVector v a => v a -> Int -> a
index
  {-# INLINE construct  #-}
  {-# INLINE inspect    #-}
  {-# INLINE basicIndex #-}
instance (Arity n, Prim a) => VectorN Vec n a

instance (Arity n, Prim a, Eq a) => Eq (Vec n a) where
  == :: Vec n a -> Vec n a -> Bool
(==) = Vec n a -> Vec n a -> Bool
forall (v :: * -> *) a. (Vector v a, Eq a) => v a -> v a -> Bool
eq
  {-# INLINE (==) #-}
instance (Arity n, Prim a, Ord a) => Ord (Vec n a) where
  compare :: Vec n a -> Vec n a -> Ordering
compare = Vec n a -> Vec n a -> Ordering
forall (v :: * -> *) a.
(Vector v a, Ord a) =>
v a -> v a -> Ordering
ord
  {-# INLINE compare #-}

instance (Arity n, Prim a, Monoid a) => Monoid (Vec n a) where
  mempty :: Vec n a
mempty  = a -> Vec n a
forall (v :: * -> *) a. Vector v a => a -> v a
replicate a
forall a. Monoid a => a
mempty
  mappend :: Vec n a -> Vec n a -> Vec n a
mappend = (a -> a -> a) -> Vec n a -> Vec n a -> Vec n a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
zipWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
  {-# INLINE mempty  #-}
  {-# INLINE mappend #-}

instance (Arity n, Prim a, Semigroup a) => Semigroup (Vec n a) where
  <> :: Vec n a -> Vec n a -> Vec n a
(<>) = (a -> a -> a) -> Vec n a -> Vec n a -> Vec n a
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
zipWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE (<>) #-}


instance (Typeable n, Arity n, Prim a, Data a) => Data (Vec n a) where
  gfoldl :: (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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> 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 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.Primitive.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

instance (Foreign.Storable a, Prim a, Arity n) => Foreign.Storable (Vec n a) where
  alignment :: Vec n a -> Int
alignment = Vec n a -> Int
forall a (v :: * -> *). Storable a => v a -> Int
defaultAlignemnt
  sizeOf :: Vec n a -> Int
sizeOf    = Vec n a -> Int
forall a (v :: * -> *). (Storable a, Vector v a) => v a -> Int
defaultSizeOf
  peek :: Ptr (Vec n a) -> IO (Vec n a)
peek      = Ptr (Vec n a) -> IO (Vec n a)
forall a (v :: * -> *).
(Storable a, Vector v a) =>
Ptr (v a) -> IO (v a)
defaultPeek
  poke :: Ptr (Vec n a) -> Vec n a -> IO ()
poke      = Ptr (Vec n a) -> Vec n a -> IO ()
forall a (v :: * -> *).
(Storable a, Vector v a) =>
Ptr (v a) -> v a -> IO ()
defaultPoke
  {-# INLINE alignment #-}
  {-# INLINE sizeOf    #-}
  {-# INLINE peek      #-}
  {-# INLINE poke      #-}