Base.hs

module Data.Repa.Array.Material.Foreign.Base
        ( F      (..)
        , Name   (..)
        , Array  (..)
        , Buffer (..)

        -- * Conversions
        , unsafeCast
        , fromForeignPtr,       toForeignPtr
        , fromStorableVector,   toStorableVector
        , fromByteString,       toByteString)
where
import Data.Repa.Array.Meta.Delayed                             as A
import Data.Repa.Array.Meta.Window                              as A
import Data.Repa.Array.Generic.Index                            as A
import Data.Repa.Array.Internals.Target                         as A
import Data.Repa.Array.Internals.Bulk                           as A

import Foreign.ForeignPtr
import Foreign.Storable

import Control.Monad
import Control.Monad.Primitive
import Data.Word

import Data.ByteString                          (ByteString)
import qualified Data.ByteString.Internal       as BS
import qualified Data.Vector.Storable           as S
import qualified Data.Vector.Storable.Mutable   as M
#include "repa-array.h"


-- | Layout for dense Foreign arrays.
--
--   UNSAFE: Indexing into raw material arrays is not bounds checked.
--   You may want to wrap this with a Checked layout as well.
--
data F = Foreign { foreignLength :: Int }
  deriving (Show, Eq)


------------------------------------------------------------------------------
-- | Foreign arrays.
instance Layout F where
  data Name  F            = F
  type Index F            = Int
  name                    = F
  create F len            = Foreign len
  extent (Foreign len)    = len
  toIndex   _ ix          = ix
  fromIndex _ ix          = ix
  {-# INLINE_ARRAY name      #-}
  {-# INLINE_ARRAY create    #-}
  {-# INLINE_ARRAY extent    #-}
  {-# INLINE_ARRAY toIndex   #-}
  {-# INLINE_ARRAY fromIndex #-}

deriving instance Eq   (Name F)
deriving instance Show (Name F)


-------------------------------------------------------------------------------
-- | Foreign arrays.
instance Storable a => Bulk F a where
  data Array F a      = FArray !(S.Vector a)
  layout (FArray v)   = Foreign (S.length v)
  index  (FArray v) i = S.unsafeIndex v i
  {-# INLINE_ARRAY layout #-}
  {-# INLINE_ARRAY index  #-}
  {-# SPECIALIZE instance Bulk F Char    #-}
  {-# SPECIALIZE instance Bulk F Int     #-}
  {-# SPECIALIZE instance Bulk F Float   #-}
  {-# SPECIALIZE instance Bulk F Double  #-}
  {-# SPECIALIZE instance Bulk F Word8   #-}
  {-# SPECIALIZE instance Bulk F Word16  #-}
  {-# SPECIALIZE instance Bulk F Word32  #-}
  {-# SPECIALIZE instance Bulk F Word64  #-}

deriving instance (S.Storable a, Show a) => Show (Array F a)


-------------------------------------------------------------------------------
-- | Windowing Foreign arrays.
instance Storable a => Windowable F a where
  window st len (FArray vec)
         = FArray (S.unsafeSlice st len vec)
  {-# INLINE_ARRAY window #-}
  {-# SPECIALIZE instance Windowable F Char    #-}
  {-# SPECIALIZE instance Windowable F Int     #-}
  {-# SPECIALIZE instance Windowable F Float   #-}
  {-# SPECIALIZE instance Windowable F Double  #-}
  {-# SPECIALIZE instance Windowable F Word8   #-}
  {-# SPECIALIZE instance Windowable F Word16  #-}
  {-# SPECIALIZE instance Windowable F Word32  #-}
  {-# SPECIALIZE instance Windowable F Word64  #-}


-------------------------------------------------------------------------------
-- | Foreign buffers
instance Storable a => Target F a where
  data Buffer F a = FBuffer !(M.IOVector a)

  unsafeNewBuffer    (Foreign n)        = FBuffer `liftM` M.unsafeNew n
  unsafeReadBuffer   (FBuffer mv) i     = M.unsafeRead mv i
  unsafeWriteBuffer  (FBuffer mv) i a   = M.unsafeWrite mv i a
  unsafeGrowBuffer   (FBuffer mv) x     = FBuffer `liftM` M.unsafeGrow mv x
  unsafeThawBuffer   (FArray v)         = FBuffer `liftM` S.unsafeThaw v
  unsafeFreezeBuffer (FBuffer mv)       = FArray  `liftM` S.unsafeFreeze mv
  unsafeSliceBuffer i n (FBuffer mv)    = return $ FBuffer (M.unsafeSlice i n mv)
  touchBuffer (FBuffer (M.MVector _ p)) = unsafePrimToPrim $ touchForeignPtr p
  bufferLayout (FBuffer mv)             = Foreign $ M.length mv
  {-# INLINE unsafeNewBuffer    #-}
  {-# INLINE unsafeWriteBuffer  #-}
  {-# INLINE unsafeReadBuffer   #-}
  {-# INLINE unsafeGrowBuffer   #-}
  {-# INLINE unsafeThawBuffer   #-}
  {-# INLINE unsafeFreezeBuffer #-}
  {-# INLINE unsafeSliceBuffer  #-}
  {-# INLINE touchBuffer        #-}
  {-# INLINE bufferLayout       #-}


-------------------------------------------------------------------------------
-- | O(1). Cast a foreign array from one element type to another.
unsafeCast 
        :: (Storable a, Storable b)
        => Array F a -> Array F b
unsafeCast (FArray vec) 
        = FArray $ S.unsafeCast vec
{-# INLINE_ARRAY unsafeCast #-}


-- | O(1). Wrap a `ForeignPtr` as an array.
fromForeignPtr :: Storable a => Int -> ForeignPtr a -> Array F a
fromForeignPtr n p = FArray $ S.unsafeFromForeignPtr p 0 n
{-# INLINE_ARRAY fromForeignPtr #-}


-- | O(1). Unwrap a `ForeignPtr` from an array.
toForeignPtr :: Storable a => Array F a -> (Int, Int, ForeignPtr a)
toForeignPtr (FArray (S.unsafeToForeignPtr -> (p,i,n))) = (i,n,p)
{-# INLINE_ARRAY toForeignPtr #-}


-- | O(1). Convert a foreign array to a storable `Vector`.
toStorableVector :: Array F a -> S.Vector a
toStorableVector (FArray vec) = vec
{-# INLINE_ARRAY toStorableVector #-}


-- | O(1). Convert a storable `Vector` to a foreign `Array`
fromStorableVector :: S.Vector a -> Array F a 
fromStorableVector vec = FArray vec
{-# INLINE_ARRAY fromStorableVector #-}


-- | O(1). Convert a foreign 'Vector' to a `ByteString`.
toByteString :: Array F Word8 -> ByteString
toByteString (FArray (S.unsafeToForeignPtr -> (p,i,n)))
 = BS.PS p i n
{-# INLINE_ARRAY toByteString #-}


-- | O(1). Convert a `ByteString` to an foreign `Array`.
fromByteString :: ByteString -> Array F Word8
fromByteString (BS.PS p i n)
 = FArray (S.unsafeFromForeignPtr p i n)
{-# INLINE_ARRAY fromByteString #-}


instance (Eq a, Storable a) => Eq (Array F a) where
  (FArray a1) == (FArray a2) = a1 == a2
  {-# INLINE_ARRAY (==) #-}