{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RoleAnnotations #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Array.Storable.Internals
-- Copyright   :  (c) The University of Glasgow 2011
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (uses Data.Array.MArray)
--
-- Actual implementation of "Data.Array.Storable".
--
-- @since 0.4.0.0
-----------------------------------------------------------------------------

module Data.Array.Storable.Internals (
    StorableArray(..),
    withStorableArray,
    touchStorableArray,
    unsafeForeignPtrToStorableArray,
  ) where

import Data.Array.Base
import Data.Array.MArray
import Foreign hiding (newArray)

-- |The array type
data StorableArray i e = StorableArray !i !i Int !(ForeignPtr e)
-- Both parameters have class-based invariants. See also #9220.
type role StorableArray nominal nominal

instance Storable e => MArray StorableArray e IO where
    getBounds :: StorableArray i e -> IO (i, i)
getBounds (StorableArray l :: i
l u :: i
u _ _) = (i, i) -> IO (i, i)
forall (m :: * -> *) a. Monad m => a -> m a
return (i
l,i
u)

    getNumElements :: StorableArray i e -> IO Int
getNumElements (StorableArray _l :: i
_l _u :: i
_u n :: Int
n _) = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

    newArray :: (i, i) -> e -> IO (StorableArray i e)
newArray (l :: i
l,u :: i
u) initialValue :: e
initialValue = do
        ForeignPtr e
fp <- Int -> IO (ForeignPtr e)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
size
        ForeignPtr e -> (Ptr e -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr e
fp ((Ptr e -> IO ()) -> IO ()) -> (Ptr e -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a :: Ptr e
a ->
            [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Ptr e -> Int -> e -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr e
a Int
i e
initialValue | Int
i <- [0..Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]]
        StorableArray i e -> IO (StorableArray i e)
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> i -> Int -> ForeignPtr e -> StorableArray i e
forall i e. i -> i -> Int -> ForeignPtr e -> StorableArray i e
StorableArray i
l i
u Int
size ForeignPtr e
fp)
        where
        size :: Int
size = (i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i
l,i
u)

    unsafeNewArray_ :: (i, i) -> IO (StorableArray i e)
unsafeNewArray_ (l :: i
l,u :: i
u) = do
        let n :: Int
n = (i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i
l,i
u)
        ForeignPtr e
fp <- Int -> IO (ForeignPtr e)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocForeignPtrArray Int
n
        StorableArray i e -> IO (StorableArray i e)
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> i -> Int -> ForeignPtr e -> StorableArray i e
forall i e. i -> i -> Int -> ForeignPtr e -> StorableArray i e
StorableArray i
l i
u Int
n ForeignPtr e
fp)

    newArray_ :: (i, i) -> IO (StorableArray i e)
newArray_ = (i, i) -> IO (StorableArray i e)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_

    unsafeRead :: StorableArray i e -> Int -> IO e
unsafeRead (StorableArray _ _ _ fp :: ForeignPtr e
fp) i :: Int
i =
        ForeignPtr e -> (Ptr e -> IO e) -> IO e
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr e
fp ((Ptr e -> IO e) -> IO e) -> (Ptr e -> IO e) -> IO e
forall a b. (a -> b) -> a -> b
$ \a :: Ptr e
a -> Ptr e -> Int -> IO e
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr e
a Int
i

    unsafeWrite :: StorableArray i e -> Int -> e -> IO ()
unsafeWrite (StorableArray _ _ _ fp :: ForeignPtr e
fp) i :: Int
i e :: e
e =
        ForeignPtr e -> (Ptr e -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr e
fp ((Ptr e -> IO ()) -> IO ()) -> (Ptr e -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \a :: Ptr e
a -> Ptr e -> Int -> e -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr e
a Int
i e
e

-- |The pointer to the array contents is obtained by 'withStorableArray'.
-- The idea is similar to 'ForeignPtr' (used internally here).
-- The pointer should be used only during execution of the 'IO' action
-- retured by the function passed as argument to 'withStorableArray'.
withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a
withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a
withStorableArray (StorableArray _ _ _ fp :: ForeignPtr e
fp) f :: Ptr e -> IO a
f = ForeignPtr e -> (Ptr e -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr e
fp Ptr e -> IO a
f

-- |If you want to use it afterwards, ensure that you
-- 'touchStorableArray' after the last use of the pointer,
-- so the array is not freed too early.
touchStorableArray :: StorableArray i e -> IO ()
touchStorableArray :: StorableArray i e -> IO ()
touchStorableArray (StorableArray _ _ _ fp :: ForeignPtr e
fp) = ForeignPtr e -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr e
fp

-- |Construct a 'StorableArray' from an arbitrary 'ForeignPtr'.  It is
-- the caller's responsibility to ensure that the 'ForeignPtr' points to
-- an area of memory sufficient for the specified bounds.
unsafeForeignPtrToStorableArray
   :: Ix i => ForeignPtr e -> (i,i) -> IO (StorableArray i e)
unsafeForeignPtrToStorableArray :: ForeignPtr e -> (i, i) -> IO (StorableArray i e)
unsafeForeignPtrToStorableArray p :: ForeignPtr e
p (l :: i
l,u :: i
u) =
   StorableArray i e -> IO (StorableArray i e)
forall (m :: * -> *) a. Monad m => a -> m a
return (i -> i -> Int -> ForeignPtr e -> StorableArray i e
forall i e. i -> i -> Int -> ForeignPtr e -> StorableArray i e
StorableArray i
l i
u ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i
l,i
u)) ForeignPtr e
p)