module Data.PrimitiveArray.Dense where
import Control.DeepSeq
import Control.Exception (assert)
import Control.Monad (liftM, forM_, zipWithM_)
import Control.Monad.Primitive (PrimState)
import Data.Aeson (ToJSON,FromJSON)
import Data.Binary (Binary)
import Data.Data
import Data.Hashable (Hashable)
import Data.Serialize (Serialize)
import Data.Typeable (Typeable)
import Data.Vector.Binary
import Data.Vector.Generic.Mutable as GM hiding (length)
import Data.Vector.Serialize
import Debug.Trace
import GHC.Generics (Generic)
import qualified Data.Vector as V
import qualified Data.Vector.Fusion.Stream.Monadic as SM
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import Data.PrimitiveArray.Class
import Data.PrimitiveArray.Index.Class
data Dense v sh e = Dense !(LimitType sh) !(v e)
type Unboxed sh e = Dense VU.Vector sh e
type Storable sh e = Dense VS.Vector sh e
type Boxed sh e = Dense V.Vector sh e
deriving instance (Eq (LimitType sh), Eq (v e) ) ⇒ Eq (Dense v sh e)
deriving instance (Generic (LimitType sh), Generic (v e)) ⇒ Generic (Dense v sh e)
deriving instance (Read (LimitType sh), Read (v e) ) ⇒ Read (Dense v sh e)
deriving instance (Show (LimitType sh), Show (v e) ) ⇒ Show (Dense v sh e)
deriving instance Typeable (Dense v sh e)
deriving instance (Data (v e), Data (LimitType sh), Data e, Data sh, Typeable sh, Typeable e, Typeable v) ⇒ Data (Dense v sh e)
instance (Binary (LimitType sh), Binary (v e), Generic (LimitType sh), Generic (v e)) => Binary (Dense v sh e)
instance (Serialize (LimitType sh), Serialize (v e), Generic (LimitType sh), Generic (v e)) => Serialize (Dense v sh e)
instance (ToJSON (LimitType sh), ToJSON (v e), Generic (LimitType sh), Generic (v e)) => ToJSON (Dense v sh e)
instance (FromJSON (LimitType sh), FromJSON (v e), Generic (LimitType sh), Generic (v e)) => FromJSON (Dense v sh e)
instance (Hashable (LimitType sh), Hashable (v e), Generic (LimitType sh), Generic (v e)) => Hashable (Dense v sh e)
instance (NFData (LimitType sh), NFData (v e)) ⇒ NFData (Dense v sh e) where
rnf (Dense h xs) = rnf h `seq` rnf xs
{-# Inline rnf #-}
data instance MutArr m (Dense v sh e) = MDense !(LimitType sh) !(VG.Mutable v (PrimState m) e)
deriving (Generic,Typeable)
instance (Show (LimitType sh), Show (VG.Mutable v (PrimState m) e), VG.Mutable v (PrimState m) e ~ mv) ⇒ Show (MutArr m (Dense v sh e)) where
show (MDense sh mv) = show (sh,mv)
instance (NFData (LimitType sh), NFData (VG.Mutable v (PrimState m) e), VG.Mutable v (PrimState m) e ~ mv) ⇒ NFData (MutArr m (Dense v sh e)) where
rnf (MDense h xs) = rnf h `seq` rnf xs
{-# Inline rnf #-}
instance
( Index sh, MutArr m (Dense v sh e) ~ mv
, GM.MVector (VG.Mutable v) e
#if ADPFUSION_DEBUGOUTPUT
, Show sh, Show (LimitType sh), Show e
#endif
) ⇒ MPrimArrayOps (Dense v) sh e where
{-# Inline upperBoundM #-}
upperBoundM (MDense h _) = h
{-# Inline fromListM #-}
fromListM h xs = do
ma ← newM h
let (MDense _ mba) = ma
SM.zipWithM_ (\k x → assert (length xs == size h) $ unsafeWrite mba k x) (SM.enumFromTo 0 (size h -1)) (SM.fromList xs)
return ma
{-# Inline newM #-}
newM h = MDense h `liftM` new (size h)
{-# Inline newWithM #-}
newWithM h def = do
ma ← newM h
let (MDense _ mba) = ma
SM.mapM_ (\k → unsafeWrite mba k def) $ SM.enumFromTo 0 (size h -1)
return ma
{-# Inline readM #-}
readM (MDense h mba) idx = assert (inBounds h idx) $ unsafeRead mba (linearIndex h idx)
{-# Inline writeM #-}
writeM (MDense h mba) idx elm =
#if ADPFUSION_DEBUGOUTPUT
(if inBounds h idx then id else traceShow ("writeM", h, idx, elm, size h, linearIndex h idx, inBounds h idx))
#endif
assert (inBounds h idx) $ unsafeWrite mba (linearIndex h idx) elm
instance (Index sh, VG.Vector v e) ⇒ PrimArrayOps (Dense v) sh e where
{-# Inline upperBound #-}
upperBound (Dense h _) = h
{-# Inline unsafeFreeze #-}
unsafeFreeze (MDense h mba) = Dense h `liftM` VG.unsafeFreeze mba
{-# Inline unsafeThaw #-}
unsafeThaw (Dense h ba) = MDense h `liftM` VG.unsafeThaw ba
{-# Inline unsafeIndex #-}
unsafeIndex (Dense h ba) idx = VG.unsafeIndex ba (linearIndex h idx)
{-# Inline transformShape #-}
transformShape tr (Dense h ba) = Dense (tr h) ba
instance (Index sh, VG.Vector v e, VG.Vector v e') ⇒ PrimArrayMap (Dense v) sh e e' where
map f (Dense h xs) = Dense h (VG.map f xs)
{-# Inline map #-}