{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Prim.Memory.PrimArray
( PrimArray(..)
, MPrimArray(..)
, Pinned(..)
, fromBytesPrimArray
, toBytesPrimArray
, castPrimArray
, fromMBytesMPrimArray
, toMBytesMPrimArray
, castMPrimArray
, allocMPrimArray
, allocPinnedMPrimArray
, allocAlignedMPrimArray
, allocUnpinnedMPrimArray
, shrinkMPrimArray
, resizeMPrimArray
, reallocMPrimArray
, isPinnedPrimArray
, isPinnedMPrimArray
, thawPrimArray
, freezeMPrimArray
, sizePrimArray
, getSizeMPrimArray
, readMPrimArray
, writeMPrimArray
, setMPrimArray
, copyPrimArrayToMPrimArray
, moveMPrimArrayToMPrimArray
) where
import Control.DeepSeq
import Control.Prim.Monad
import Foreign.Prim
import Data.Prim
import Data.Prim.Memory.Bytes
import Data.Prim.Memory.Internal
import Data.Prim.Memory.ForeignPtr
newtype PrimArray (p :: Pinned) e = PrimArray (Bytes p)
deriving (NFData, Semigroup, Monoid, MemRead)
type role PrimArray nominal nominal
newtype MPrimArray (p :: Pinned) e s = MPrimArray (MBytes p s)
deriving (NFData, MemWrite)
type role MPrimArray nominal nominal nominal
instance PtrAccess s (PrimArray 'Pin e) where
toForeignPtr = pure . toForeignPtrBytes . toBytesPrimArray
{-# INLINE toForeignPtr #-}
withPtrAccess b = withPtrBytes (toBytesPrimArray b)
{-# INLINE withPtrAccess #-}
withNoHaltPtrAccess b = withNoHaltPtrBytes (toBytesPrimArray b)
{-# INLINE withNoHaltPtrAccess #-}
instance PtrAccess s (MPrimArray 'Pin e s) where
toForeignPtr = pure . toForeignPtrMBytes . toMBytesMPrimArray
{-# INLINE toForeignPtr #-}
withPtrAccess mb = withPtrMBytes (toMBytesMPrimArray mb)
{-# INLINE withPtrAccess #-}
withNoHaltPtrAccess mb = withNoHaltPtrMBytes (toMBytesMPrimArray mb)
{-# INLINE withNoHaltPtrAccess #-}
instance Typeable p => MemAlloc (MPrimArray p e) where
type FrozenMem (MPrimArray p e) = PrimArray p e
getByteCountMem = getByteCountMem . toMBytesMPrimArray
{-# INLINE getByteCountMem #-}
allocMem = fmap fromMBytesMPrimArray . allocMBytes
{-# INLINE allocMem #-}
thawMem = thawPrimArray
{-# INLINE thawMem #-}
freezeMem = freezeMPrimArray
{-# INLINE freezeMem #-}
resizeMem mba = fmap fromMBytesMPrimArray . reallocMBytes (toMBytesMPrimArray mba)
{-# INLINE resizeMem #-}
instance (Typeable p, Prim e) => IsList (PrimArray p e) where
type Item (PrimArray p e) = e
fromList = fromListMem
fromListN n = fromListZeroMemN_ (Count n)
toList = toListMem
instance Typeable p => IsString (PrimArray p Char) where
fromString = fromListMem
instance (Show e, Prim e) => Show (PrimArray p e) where
show = show . toListPrimArray
toListPrimArray :: Prim e => PrimArray p e -> [e]
toListPrimArray = toListMem
castPrimArray :: PrimArray p e' -> PrimArray p e
castPrimArray = coerce
fromBytesPrimArray :: Bytes p -> PrimArray p e
fromBytesPrimArray = coerce
toBytesPrimArray :: PrimArray p e -> Bytes p
toBytesPrimArray = coerce
castMPrimArray :: MPrimArray p e' s -> MPrimArray p e s
castMPrimArray = coerce
fromMBytesMPrimArray :: MBytes p s -> MPrimArray p e s
fromMBytesMPrimArray = coerce
toMBytesMPrimArray :: MPrimArray p e s -> MBytes p s
toMBytesMPrimArray = coerce
sizePrimArray :: forall e p. Prim e => PrimArray p e -> Size
sizePrimArray = (coerce :: Count e -> Size) . countBytes . toBytesPrimArray
{-# INLINE sizePrimArray #-}
getSizeMPrimArray :: forall e p m s. (MonadPrim s m, Prim e) => MPrimArray p e s -> m Size
getSizeMPrimArray = fmap (coerce :: Count e -> Size) . getCountMBytes . toMBytesMPrimArray
{-# INLINE getSizeMPrimArray #-}
allocMPrimArray ::
forall e p m s . (Typeable p, Prim e, MonadPrim s m) => Size -> m (MPrimArray p e s)
allocMPrimArray sz = fromMBytesMPrimArray <$> allocMBytes (coerce sz :: Count e)
{-# INLINE allocMPrimArray #-}
allocUnpinnedMPrimArray :: forall e m s . (MonadPrim s m, Prim e) => Size -> m (MPrimArray 'Inc e s)
allocUnpinnedMPrimArray sz = fromMBytesMPrimArray <$> allocUnpinnedMBytes (coerce sz :: Count e)
{-# INLINE allocUnpinnedMPrimArray #-}
allocPinnedMPrimArray :: forall e m s . (MonadPrim s m, Prim e) => Size -> m (MPrimArray 'Pin e s)
allocPinnedMPrimArray sz = fromMBytesMPrimArray <$> allocPinnedMBytes (coerce sz :: Count e)
{-# INLINE allocPinnedMPrimArray #-}
allocAlignedMPrimArray ::
(MonadPrim s m, Prim e)
=> Count e
-> m (MPrimArray 'Pin e s)
allocAlignedMPrimArray = fmap fromMBytesMPrimArray . allocAlignedMBytes
{-# INLINE allocAlignedMPrimArray #-}
freezeMPrimArray :: MonadPrim s m => MPrimArray p e s -> m (PrimArray p e)
freezeMPrimArray = fmap fromBytesPrimArray . freezeMBytes . toMBytesMPrimArray
{-# INLINE freezeMPrimArray #-}
thawPrimArray :: MonadPrim s m => PrimArray p e -> m (MPrimArray p e s)
thawPrimArray = fmap fromMBytesMPrimArray . thawBytes . toBytesPrimArray
{-# INLINE thawPrimArray #-}
shrinkMPrimArray ::
forall e p m s. (MonadPrim s m, Prim e)
=> MPrimArray p e s
-> Size
-> m ()
shrinkMPrimArray mba sz = shrinkMBytes (toMBytesMPrimArray mba) (coerce sz :: Count e)
{-# INLINE shrinkMPrimArray #-}
resizeMPrimArray ::
forall e p m s. (MonadPrim s m, Prim e)
=> MPrimArray p e s
-> Size
-> m (MPrimArray 'Inc e s)
resizeMPrimArray mba sz =
fromMBytesMPrimArray <$>
resizeMBytes (toMBytesMPrimArray mba) (coerce sz :: Count e)
{-# INLINE resizeMPrimArray #-}
reallocMPrimArray ::
forall e p m s. (MonadPrim s m, Typeable p, Prim e)
=> MPrimArray p e s
-> Size
-> m (MPrimArray p e s)
reallocMPrimArray mba sz =
fromMBytesMPrimArray <$>
reallocMBytes (toMBytesMPrimArray mba) (coerce sz :: Count e)
{-# INLINABLE reallocMPrimArray #-}
isPinnedPrimArray :: PrimArray p e -> Bool
isPinnedPrimArray (PrimArray b) = isPinnedBytes b
{-# INLINE isPinnedPrimArray #-}
isPinnedMPrimArray :: MPrimArray p e s -> Bool
isPinnedMPrimArray (MPrimArray mb) = isPinnedMBytes mb
{-# INLINE isPinnedMPrimArray #-}
readMPrimArray :: (MonadPrim s m, Prim e) => MPrimArray p e s -> Int -> m e
readMPrimArray (MPrimArray mb) = readOffMBytes mb . coerce
{-# INLINE readMPrimArray #-}
writeMPrimArray :: (MonadPrim s m, Prim e) => MPrimArray p e s -> Int -> e -> m ()
writeMPrimArray (MPrimArray mb) o = writeOffMBytes mb (coerce o)
{-# INLINE writeMPrimArray #-}
setMPrimArray ::
forall e p m s. (MonadPrim s m, Prim e)
=> MPrimArray p e s
-> Int
-> Size
-> e
-> m ()
setMPrimArray (MPrimArray mb) off sz = setMBytes mb (coerce off) (coerce sz)
{-# INLINE setMPrimArray #-}
copyPrimArrayToMPrimArray ::
forall e p m s. (MonadPrim s m, Prim e)
=> PrimArray p e
-> Int
-> MPrimArray p e s
-> Int
-> Size
-> m ()
copyPrimArrayToMPrimArray ba srcOff mba dstOff sz =
copyMem ba (coerce srcOff) mba (coerce dstOff) (coerce sz `countForProxyTypeOf` ba)
{-# INLINE copyPrimArrayToMPrimArray #-}
moveMPrimArrayToMPrimArray ::
forall e p m s. (MonadPrim s m, Prim e)
=> MPrimArray p e s
-> Int
-> MPrimArray p e s
-> Int
-> Size
-> m ()
moveMPrimArrayToMPrimArray ba srcOff mba dstOff sz =
moveMem ba (coerce srcOff) mba (coerce dstOff) (coerce sz :: Count e)
{-# INLINE moveMPrimArrayToMPrimArray #-}