module Data.Yarr.Repr.Foreign (
F, Storable, L,
newEmpty,
toForeignPtr, unsafeFromForeignPtr,
FS,
) where
import Foreign
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.MissingAlloc
import Data.Yarr.Base as B
import Data.Yarr.Repr.Delayed
import Data.Yarr.Repr.Separate
import Data.Yarr.Shape
import Data.Yarr.Utils.Storable
import Data.Yarr.Utils.FixedVector as V
data F
instance Shape sh => Regular F L sh a where
data UArray F L sh a =
ForeignArray
!sh
!(ForeignPtr a)
!(Ptr a)
extent (ForeignArray sh _ _) = sh
touchArray (ForeignArray _ fptr _) = touchForeignPtr fptr
instance Shape sh => NFData (UArray F L sh a) where
rnf (ForeignArray sh fptr ptr) = sh `deepseq` fptr `seq` ptr `seq` ()
instance (Shape sh, Storable a) => USource F L sh a where
linearIndex (ForeignArray _ _ ptr) i = peekElemOff ptr i
instance DefaultFusion F D L
data FS
instance Shape sh => Regular FS L sh e where
data UArray FS L sh e =
ForeignSlice
!sh
!Int
!(ForeignPtr e)
!(Ptr e)
extent (ForeignSlice sh _ _ _) = sh
touchArray (ForeignSlice _ _ fptr _) = touchForeignPtr fptr
instance Shape sh => NFData (UArray FS L sh e) where
rnf (ForeignSlice sh vsize fptr ptr) =
sh `deepseq` vsize `seq` fptr `seq` ptr `seq` ()
instance (Shape sh, Storable e) => USource FS L sh e where
linearIndex (ForeignSlice _ vsize _ ptr) i = peekByteOff ptr (i * vsize)
instance DefaultFusion FS D L
instance (Shape sh, Vector v e, Storable e) => VecRegular F FS L sh v e where
slices (ForeignArray sh fptr ptr) =
let esize = sizeOf (undefined :: e)
vsize = sizeOf (undefined :: (v e))
eptr = castPtr ptr
feptr = castForeignPtr fptr
in V.generate $ \i ->
ForeignSlice sh vsize feptr (eptr `plusPtr` (i * esize))
instance (Shape sh, Vector v e, Storable e) => UVecSource F FS L sh v e
instance (Shape sh, Vector v e, Storable e) => UVecSource (SE F) F L sh v e
instance (Shape sh, Storable a) => UTarget F L sh a where
linearWrite (ForeignArray _ _ ptr) i x = pokeElemOff ptr i x
instance (Shape sh, Storable a) => Manifest F F L sh a where
new sh = do
arr <- internalNew mallocBytes sh
arr `deepseq` return ()
return arr
freeze = return
thaw = return
newEmpty :: (Shape sh, Storable a, Integral a) => sh -> IO (UArray F L sh a)
newEmpty sh = do
arr <- internalNew callocBytes sh
arr `deepseq` return ()
return arr
internalNew
:: forall sh a. (Shape sh, Storable a)
=> (Int -> IO (Ptr a)) -> sh -> IO (UArray F L sh a)
internalNew allocBytes sh = do
let len = size sh
ptr <- allocBytes (len * sizeOf (undefined :: a))
fptr <- newForeignPtr finalizerFree (castPtr ptr)
return $ ForeignArray sh fptr ptr
instance (Shape sh, Storable e) => UTarget FS L sh e where
linearWrite (ForeignSlice _ vsize _ ptr) i x =
pokeByteOff ptr (i * vsize) x
instance (Shape sh, Vector v e, Storable e) => UVecTarget F FS L sh v e
toForeignPtr :: Shape sh => UArray F L sh a -> ForeignPtr a
toForeignPtr (ForeignArray _ fptr _) = fptr
unsafeFromForeignPtr :: Shape sh => sh -> ForeignPtr a -> IO (UArray F L sh a)
unsafeFromForeignPtr sh fptr =
withForeignPtr fptr (\ptr -> return $ ForeignArray sh fptr ptr)