{-# 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 = 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 = forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldl (\()
r a
a -> ()
r seq :: forall a b. a -> b -> b
`seq` 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 :: forall (m :: * -> *). PrimMonad m => m (MVec n (PrimState m) a)
new = do
    MutableByteArray (PrimState m)
v <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray forall a b. (a -> b) -> a -> b
$! forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Int
arity (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
                       forall a. Num a => a -> a -> a
* forall a. Prim a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) s a. MutableByteArray s -> MVec n s a
MVec MutableByteArray (PrimState m)
v
  {-# INLINE new         #-}
  copy :: forall (m :: * -> *).
PrimMonad m =>
MVec n (PrimState m) a -> MVec n (PrimState m) a -> m ()
copy                       = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
move
  {-# INLINE copy        #-}
  move :: forall (m :: * -> *).
PrimMonad m =>
MVec n (PrimState m) a -> MVec n (PrimState m) a -> m ()
move (MVec MutableByteArray (PrimState m)
dst) (MVec MutableByteArray (PrimState m)
src) = 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 (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Int
arity (forall {k} (t :: k). Proxy t
Proxy :: Proxy n))
  {-# INLINE move        #-}
  unsafeRead :: forall (m :: * -> *).
PrimMonad m =>
MVec n (PrimState m) a -> Int -> m a
unsafeRead  (MVec MutableByteArray (PrimState m)
v) Int
i   = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray  MutableByteArray (PrimState m)
v Int
i
  {-# INLINE unsafeRead  #-}
  unsafeWrite :: forall (m :: * -> *).
PrimMonad m =>
MVec n (PrimState m) a -> Int -> a -> m ()
unsafeWrite (MVec MutableByteArray (PrimState m)
v) Int
i a
x = 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 :: forall (m :: * -> *).
PrimMonad m =>
Mutable (Vec n) (PrimState m) a -> m (Vec n a)
unsafeFreeze (MVec MutableByteArray (PrimState m)
v)   = do { ByteArray
a <- forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray (PrimState m)
v; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (n :: Nat) a. ByteArray -> Vec n a
Vec  ByteArray
a }
  unsafeThaw :: forall (m :: * -> *).
PrimMonad m =>
Vec n a -> m (Mutable (Vec n) (PrimState m) a)
unsafeThaw   (Vec  ByteArray
v)   = do { MutableByteArray (PrimState m)
a <- forall (m :: * -> *).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray   ByteArray
v; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 = 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  = forall (v :: * -> *) a.
(Arity (Dim v), IVector v a) =>
Fun (Peano (Dim v)) a (v a)
constructVec
  inspect :: forall b. Vec n a -> Fun (Peano (Dim (Vec n))) a b -> b
inspect    = 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 = 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
(==) = 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 = 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  = forall (v :: * -> *) a. Vector v a => a -> v a
replicate forall a. Monoid a => a
mempty
  mappend :: Vec n a -> Vec n a -> Vec n a
mappend = forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
zipWith 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
(<>) = forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
zipWith forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE (<>) #-}


instance (Typeable n, Arity n, Prim 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 (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 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 = forall a (v :: * -> *). Storable a => v a -> Int
defaultAlignemnt
  sizeOf :: Vec n a -> Int
sizeOf    = forall a (v :: * -> *). (Storable a, Vector v a) => v a -> Int
defaultSizeOf
  peek :: Ptr (Vec n a) -> IO (Vec n a)
peek      = 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      = forall a (v :: * -> *).
(Storable a, Vector v a) =>
Ptr (v a) -> v a -> IO ()
defaultPoke
  {-# INLINE alignment #-}
  {-# INLINE sizeOf    #-}
  {-# INLINE peek      #-}
  {-# INLINE poke      #-}