module Data.Massiv.Array.Manifest.BoxedNF
( N (..)
, Array(..)
, deepseqArray
, deepseqArrayP
, vectorFromArray
, vectorToArray
, castVectorToArray
) where
import Control.DeepSeq (NFData (..), deepseq)
import Control.Monad.ST (runST)
import Data.Massiv.Array.Delayed.Internal (eq, ord)
import Data.Massiv.Array.Manifest.Internal (M, toManifest)
import Data.Massiv.Array.Manifest.List as A
import Data.Massiv.Array.Mutable
import Data.Massiv.Array.Unsafe (unsafeGenerateArray,
unsafeGenerateArrayP)
import Data.Massiv.Core.Common
import Data.Massiv.Core.List
import Data.Massiv.Core.Scheduler
import qualified Data.Primitive.Array as A
import qualified Data.Vector as VB
import qualified Data.Vector.Mutable as VB
import GHC.Exts as GHC (IsList (..))
import Prelude hiding (mapM)
import System.IO.Unsafe (unsafePerformIO)
data N = N deriving Show
type instance EltRepr N ix = M
data instance Array N ix e = NArray { nComp :: Comp
, nSize :: !ix
, nData :: !(A.Array e)
}
instance (Index ix, NFData e) => NFData (Array N ix e) where
rnf (NArray comp sz arr) =
case comp of
Seq -> deepseqArray sz arr ()
ParOn wIds -> deepseqArrayP wIds sz arr ()
instance (Index ix, NFData e, Eq e) => Eq (Array N ix e) where
(==) = eq (==)
instance (Index ix, NFData e, Ord e) => Ord (Array N ix e) where
compare = ord compare
instance (Index ix, NFData e) => Construct N ix e where
getComp = nComp
setComp c arr = arr { nComp = c }
unsafeMakeArray Seq !sz f = unsafeGenerateArray sz f
unsafeMakeArray (ParOn wIds) !sz f = unsafeGenerateArrayP wIds sz f
instance (Index ix, NFData e) => Source N ix e where
unsafeLinearIndex (NArray _ _ a) = A.indexArray a
instance (Index ix, NFData e) => Size N ix e where
size = nSize
unsafeResize !sz !arr = arr { nSize = sz }
unsafeExtract !sIx !newSz !arr = unsafeExtract sIx newSz (toManifest arr)
instance ( NFData e
, Index ix
, Index (Lower ix)
, Elt M ix e ~ Array M (Lower ix) e
, Elt N ix e ~ Array M (Lower ix) e
) =>
OuterSlice N ix e where
unsafeOuterSlice arr = unsafeOuterSlice (toManifest arr)
instance ( NFData e
, Index ix
, Index (Lower ix)
, Elt M ix e ~ Array M (Lower ix) e
, Elt N ix e ~ Array M (Lower ix) e
) =>
InnerSlice N ix e where
unsafeInnerSlice arr = unsafeInnerSlice (toManifest arr)
instance (Index ix, NFData e) => Manifest N ix e where
unsafeLinearIndexM (NArray _ _ a) = A.indexArray a
uninitialized :: a
uninitialized = error "Data.Array.Massiv.Manifest.BoxedNF: uninitialized element"
instance (Index ix, NFData e) => Mutable N ix e where
data MArray s N ix e = MNArray !ix !(A.MutableArray s e)
msize (MNArray sz _) = sz
unsafeThaw (NArray _ sz a) = MNArray sz <$> A.unsafeThawArray a
unsafeFreeze comp (MNArray sz ma) = NArray comp sz <$> A.unsafeFreezeArray ma
unsafeNew sz = MNArray sz <$> A.newArray (totalElem sz) uninitialized
unsafeNewZero = unsafeNew
unsafeLinearRead (MNArray _ ma) i = A.readArray ma i
unsafeLinearWrite (MNArray _ ma) i e = e `deepseq` A.writeArray ma i e
deepseqArray :: (Index ix, NFData a) => ix -> A.Array a -> b -> b
deepseqArray sz arr b =
iter 0 (totalElem sz) 1 (<) b $ \ !i acc -> A.indexArray arr i `deepseq` acc
deepseqArrayP :: (Index ix, NFData a) => [Int] -> ix -> A.Array a -> b -> b
deepseqArrayP wIds sz arr b =
unsafePerformIO $ do
divideWork_ wIds sz $ \ !scheduler !chunkLength !totalLength !slackStart -> do
loopM_ 0 (< slackStart) (+ chunkLength) $ \ !start ->
scheduleWork scheduler $
loopM_ start (< (start + chunkLength)) (+ 1) $ \ !k ->
A.indexArray arr k `deepseq` return ()
scheduleWork scheduler $
loopM_ slackStart (< totalLength) (+ 1) $ \ !k ->
A.indexArray arr k `deepseq` return ()
return b
vectorFromArray :: Index ix => ix -> A.Array a -> VB.Vector a
vectorFromArray sz arr = runST $ do
marr <- A.unsafeThawArray arr
VB.unsafeFreeze $ VB.MVector 0 (totalElem sz) marr
vectorToArray :: VB.Vector a -> A.Array a
vectorToArray v =
runST $ do
VB.MVector start len marr <- VB.unsafeThaw v
marr' <-
if start == 0
then return marr
else A.cloneMutableArray marr start len
A.unsafeFreezeArray marr'
castVectorToArray :: VB.Vector a -> Maybe (A.Array a)
castVectorToArray v =
runST $ do
VB.MVector start _ marr <- VB.unsafeThaw v
if start == 0
then Just <$> A.unsafeFreezeArray marr
else return Nothing
instance ( NFData e
, IsList (Array L ix e)
, Nested LN ix e
, Nested L ix e
, Ragged L ix e
) =>
IsList (Array N ix e) where
type Item (Array N ix e) = Item (Array L ix e)
fromList = A.fromLists' Seq
toList = GHC.toList . toListArray