{-# LANGUAGE MagicHash            #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Strict boxed vector which could hold any value. For lazy variant see
-- "Data.Vector.Fixed.Boxed".
module Data.Vector.Fixed.Strict where

import Control.Applicative  (Applicative(..))
import Control.DeepSeq      (NFData(..))
import Data.Primitive.SmallArray
import Data.Monoid          (Monoid(..))
import Data.Semigroup       (Semigroup(..))
import Data.Data
import qualified Data.Foldable    as F
import qualified Data.Traversable as T
import Foreign.Storable (Storable(..))
import GHC.TypeLits
import GHC.Exts (proxy#)
import Prelude ( Show(..),Eq(..),Ord(..),Functor(..),Monad(..)
               , ($!),error,(<$>))

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


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

-- | Vector with fixed length which can hold any value. It's strict
--   and ensures that elements are evaluated to WHNF.
newtype Vec (n :: Nat) a = Vec (SmallArray a)

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

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

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


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

deriving via ViaFixed (Vec n) instance Arity n => Functor     (Vec n)
deriving via ViaFixed (Vec n) instance Arity n => Applicative (Vec n)
deriving via ViaFixed (Vec n) instance Arity n => F.Foldable  (Vec n)

instance Arity n => T.Traversable (Vec n) where
  sequence :: forall (m :: * -> *) a. Monad m => Vec n (m a) -> m (Vec n a)
sequence  = Vec n (m a) -> m (Vec n a)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Vector v (f a), Applicative f) =>
v (f a) -> f (v a)
sequence
  sequenceA :: forall (f :: * -> *) a. Applicative f => Vec n (f a) -> f (Vec n a)
sequenceA = Vec n (f a) -> f (Vec n a)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Vector v (f a), Applicative f) =>
v (f a) -> f (v a)
sequence
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vec n a -> f (Vec n b)
traverse  = (a -> f b) -> Vec n a -> f (Vec n b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v a, Vector v b, Applicative f) =>
(a -> f b) -> v a -> f (v b)
mapM
  mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vec n a -> m (Vec n b)
mapM      = (a -> m b) -> Vec n a -> m (Vec n b)
forall (v :: * -> *) a b (f :: * -> *).
(Vector v a, Vector v b, Applicative f) =>
(a -> f b) -> v a -> f (v b)
mapM
  {-# INLINE sequence  #-}
  {-# INLINE sequenceA #-}
  {-# INLINE mapM      #-}
  {-# INLINE traverse  #-}

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

instance (Arity n) => MVector (MVec n) a where
  basicNew :: forall s. ST s (MVec n s a)
basicNew =
    SmallMutableArray s a -> MVec n s a
forall (n :: Nat) s a. SmallMutableArray s a -> MVec n s a
MVec (SmallMutableArray s a -> MVec n s a)
-> ST s (SmallMutableArray s a) -> ST s (MVec n s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (Proxy# (Peano n) -> Int
forall (n :: PeanoNum). ArityPeano n => Proxy# n -> Int
peanoToInt (forall {k} (a :: k). Proxy# a
forall (a :: PeanoNum). Proxy# a
proxy# @(Peano n))) a
forall a. a
uninitialised
  basicReplicate :: forall s. a -> ST s (MVec n s a)
basicReplicate a
a =
    SmallMutableArray s a -> MVec n s a
forall (n :: Nat) s a. SmallMutableArray s a -> MVec n s a
MVec (SmallMutableArray s a -> MVec n s a)
-> ST s (SmallMutableArray s a) -> ST s (MVec n s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (Proxy# (Peano n) -> Int
forall (n :: PeanoNum). ArityPeano n => Proxy# n -> Int
peanoToInt (forall {k} (a :: k). Proxy# a
forall (a :: PeanoNum). Proxy# a
proxy# @(Peano n))) a
a
  basicCopy :: forall s. MVec n s a -> MVec n s a -> ST s ()
basicCopy (MVec SmallMutableArray s a
dst) (MVec SmallMutableArray s a
src) =
    SmallMutableArray (PrimState (ST s)) a
-> Int
-> SmallMutableArray (PrimState (ST s)) a
-> Int
-> Int
-> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
dst Int
0 SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
src Int
0 (Proxy# (Peano n) -> Int
forall (n :: PeanoNum). ArityPeano n => Proxy# n -> Int
peanoToInt (forall {k} (a :: k). Proxy# a
forall (a :: PeanoNum). Proxy# a
proxy# @(Peano n)))
  basicClone :: forall s. MVec n s a -> ST s (MVec n s a)
basicClone (MVec SmallMutableArray s a
src) =
    SmallMutableArray s a -> MVec n s a
forall (n :: Nat) s a. SmallMutableArray s a -> MVec n s a
MVec (SmallMutableArray s a -> MVec n s a)
-> ST s (SmallMutableArray s a) -> ST s (MVec n s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SmallMutableArray (PrimState (ST s)) a
-> Int -> Int -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
src Int
0 (Proxy# (Peano n) -> Int
forall (n :: PeanoNum). ArityPeano n => Proxy# n -> Int
peanoToInt (forall {k} (a :: k). Proxy# a
forall (a :: PeanoNum). Proxy# a
proxy# @(Peano n)))
  basicUnsafeRead :: forall s. MVec n s a -> Int -> ST s a
basicUnsafeRead  (MVec SmallMutableArray s a
v) Int
i    = SmallMutableArray (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray  SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
v Int
i
  basicUnsafeWrite :: forall s. MVec n s a -> Int -> a -> ST s ()
basicUnsafeWrite (MVec SmallMutableArray s a
v) Int
i !a
x = SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
v Int
i a
x
  {-# INLINE basicNew         #-}
  {-# INLINE basicReplicate   #-}
  {-# INLINE basicCopy        #-}
  {-# INLINE basicClone       #-}
  {-# INLINE basicUnsafeRead  #-}
  {-# INLINE basicUnsafeWrite #-}

instance (Arity n) => IVector (Vec n) a where
  basicUnsafeFreeze :: forall s. Mutable (Vec n) s a -> ST s (Vec n a)
basicUnsafeFreeze (MVec SmallMutableArray s a
v) = do { SmallArray a
a <- SmallMutableArray (PrimState (ST s)) a -> ST s (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
v; Vec n a -> ST s (Vec n a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vec n a -> ST s (Vec n a)) -> Vec n a -> ST s (Vec n a)
forall a b. (a -> b) -> a -> b
$! SmallArray a -> Vec n a
forall (n :: Nat) a. SmallArray a -> Vec n a
Vec  SmallArray a
a }
  basicThaw :: forall s. Vec n a -> ST s (Mutable (Vec n) s a)
basicThaw         (Vec  SmallArray a
v) =
    SmallMutableArray s a -> MVec n s a
forall (n :: Nat) s a. SmallMutableArray s a -> MVec n s a
MVec (SmallMutableArray s a -> MVec n s a)
-> ST s (SmallMutableArray s a) -> ST s (MVec n s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SmallArray a
-> Int -> Int -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray SmallArray a
v Int
0 (Proxy# (Peano n) -> Int
forall (n :: PeanoNum). ArityPeano n => Proxy# n -> Int
peanoToInt (forall {k} (a :: k). Proxy# a
forall (a :: PeanoNum). Proxy# a
proxy# @(Peano n)))
  unsafeIndex :: Vec n a -> Int -> a
unsafeIndex  (Vec  SmallArray a
v) Int
i = SmallArray a -> Int -> a
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
v Int
i
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicThaw         #-}
  {-# INLINE unsafeIndex       #-}

instance (Arity n) => Vector (Vec n) a where
  construct :: Fun (Dim (Vec n)) a (Vec n a)
construct  = Fun (Dim (Vec n)) a (Vec n a)
forall (v :: * -> *) a.
(ArityPeano (Dim v), IVector v a) =>
Fun (Dim v) a (v a)
constructVec
  inspect :: forall b. Vec n a -> Fun (Dim (Vec n)) a b -> b
inspect    = Vec n a -> Fun (Dim (Vec n)) a b -> b
forall (v :: * -> *) a b.
(ArityPeano (Dim v), IVector v a) =>
v a -> Fun (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 (Typeable n, Arity n, 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.Strict.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

uninitialised :: a
uninitialised :: forall a. a
uninitialised = String -> a
forall a. HasCallStack => String -> a
error String
"Data.Vector.Fixed.Strict: uninitialised element"