{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
-- |
-- Vector which could hold any value.
module Data.Vector.Fixed.Boxed (
    -- * Immutable
    Vec
  , Vec1
  , Vec2
  , Vec3
  , Vec4
  , Vec5
    -- * Mutable
  , MVec
  ) 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 Prelude ( Show(..),Eq(..),Ord(..),Functor(..),Monad(..)
               , ($),($!),error,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
----------------------------------------------------------------

-- | Vector with fixed length which can hold any value.
newtype Vec (n :: Nat) a = Vec (SmallArray a)

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

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


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 (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.Boxed.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 (Storable a, Arity n) => 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      #-}




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

instance (Arity n, 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, 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) => MVector (MVec n) a where
  new :: forall (m :: * -> *). PrimMonad m => m (MVec n (PrimState m) a)
new = do
    SmallMutableArray (PrimState m) a
v <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Int
arity (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)) forall a. a
uninitialised
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) s a. SmallMutableArray s a -> MVec n s a
MVec SmallMutableArray (PrimState m) a
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 SmallMutableArray (PrimState m) a
dst) (MVec SmallMutableArray (PrimState m) a
src) = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray (PrimState m) a
dst Int
0 SmallMutableArray (PrimState m) a
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 SmallMutableArray (PrimState m) a
v) Int
i   = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray  SmallMutableArray (PrimState m) a
v Int
i
  {-# INLINE unsafeRead  #-}
  unsafeWrite :: forall (m :: * -> *).
PrimMonad m =>
MVec n (PrimState m) a -> Int -> a -> m ()
unsafeWrite (MVec SmallMutableArray (PrimState m) a
v) Int
i a
x = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) a
v Int
i a
x
  {-# INLINE unsafeWrite #-}

instance (Arity n) => IVector (Vec n) a where
  unsafeFreeze :: forall (m :: * -> *).
PrimMonad m =>
Mutable (Vec n) (PrimState m) a -> m (Vec n a)
unsafeFreeze (MVec SmallMutableArray (PrimState m) a
v)   = do { SmallArray a
a <- forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray (PrimState m) a
v; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (n :: Nat) a. SmallArray a -> Vec n a
Vec  SmallArray a
a }
  unsafeThaw :: forall (m :: * -> *).
PrimMonad m =>
Vec n a -> m (Mutable (Vec n) (PrimState m) a)
unsafeThaw   (Vec  SmallArray a
v)   = do { SmallMutableArray (PrimState m) a
a <- forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> m (SmallMutableArray (PrimState m) a)
unsafeThawSmallArray   SmallArray a
v; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (n :: Nat) s a. SmallMutableArray s a -> MVec n s a
MVec SmallMutableArray (PrimState m) a
a }
  unsafeIndex :: Vec n a -> Int -> a
unsafeIndex  (Vec  SmallArray a
v) Int
i = forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
v Int
i
  {-# INLINE unsafeFreeze #-}
  {-# INLINE unsafeThaw   #-}
  {-# INLINE unsafeIndex  #-}



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

instance (Arity n) => 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) => VectorN Vec n a

instance (Arity n, 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, 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, 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, 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 Arity n => Functor (Vec n) where
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> Vec n a -> Vec n b
fmap = forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
map

instance Arity n => Applicative (Vec n) where
  pure :: forall a. a -> Vec n a
pure  = forall (v :: * -> *) a. Vector v a => a -> v a
replicate
  <*> :: forall a b. Vec n (a -> b) -> Vec n a -> Vec n b
(<*>) = 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 b. (a -> b) -> a -> b
($)
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}

instance Arity n => F.Foldable (Vec n) where
  foldr :: forall a b. (a -> b -> b) -> b -> Vec n a -> b
foldr = forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
foldr
  {-# INLINE foldr #-}

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

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