{-# 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 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.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 = 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      #-}




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

instance (Arity n, 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, 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) => MVector (MVec n) a where
  new :: m (MVec n (PrimState m) a)
new = do
    SmallMutableArray (PrimState m) a
v <- Int -> a -> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (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)) a
forall a. a
uninitialised
    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
$ SmallMutableArray (PrimState m) a -> MVec n (PrimState m) a
forall (n :: Nat) s a. SmallMutableArray s a -> MVec n s a
MVec SmallMutableArray (PrimState m) a
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 SmallMutableArray (PrimState m) a
dst) (MVec SmallMutableArray (PrimState m) a
src) = SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
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 (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 SmallMutableArray (PrimState m) a
v) Int
i   = SmallMutableArray (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray  SmallMutableArray (PrimState m) a
v Int
i
  {-# INLINE unsafeRead  #-}
  unsafeWrite :: MVec n (PrimState m) a -> Int -> a -> m ()
unsafeWrite (MVec SmallMutableArray (PrimState m) a
v) Int
i a
x = SmallMutableArray (PrimState m) a -> Int -> a -> m ()
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 :: Mutable (Vec n) (PrimState m) a -> m (Vec n a)
unsafeFreeze (MVec v)   = do { SmallArray a
a <- SmallMutableArray (PrimState m) a -> m (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray (PrimState m) a
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
$! SmallArray a -> Vec n a
forall (n :: Nat) a. SmallArray a -> Vec n a
Vec  SmallArray a
a }
  unsafeThaw :: Vec n a -> m (Mutable (Vec n) (PrimState m) a)
unsafeThaw   (Vec  SmallArray a
v)   = do { SmallMutableArray (PrimState m) a
a <- SmallArray a -> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> m (SmallMutableArray (PrimState m) a)
unsafeThawSmallArray   SmallArray a
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
$! SmallMutableArray (PrimState m) a -> MVec n (PrimState m) a
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 = SmallArray a -> Int -> a
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  = 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) => VectorN Vec n a

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

instance Arity n => F.Foldable (Vec n) where
  foldr :: (a -> b -> b) -> b -> Vec n a -> b
foldr = (a -> b -> b) -> b -> Vec n a -> b
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 :: 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)
sequenceA
  traverse :: (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)
traverse
  {-# INLINE sequenceA #-}
  {-# INLINE traverse #-}

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