{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, ScopedTypeVariables #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Foreign.Marshal.Array
-- Copyright   :  (c) The FFI task force 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  ffi@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Marshalling support: routines allocating, storing, and retrieving Haskell
-- lists that are represented as arrays in the foreign language
--
-----------------------------------------------------------------------------

module Foreign.Marshal.Array (
  -- * Marshalling arrays

  -- ** Allocation
  --
  mallocArray,
  mallocArray0,

  allocaArray,
  allocaArray0,

  reallocArray,
  reallocArray0,

  callocArray,
  callocArray0,

  -- ** Marshalling
  --
  peekArray,
  peekArray0,

  pokeArray,
  pokeArray0,

  -- ** Combined allocation and marshalling
  --
  newArray,
  newArray0,

  withArray,
  withArray0,

  withArrayLen,
  withArrayLen0,

  -- ** Copying

  -- | (argument order: destination, source)
  copyArray,
  moveArray,

  -- ** Finding the length
  --
  lengthArray0,

  -- ** Indexing
  --
  advancePtr,
) where

import Foreign.Ptr      (Ptr, plusPtr)
import Foreign.Storable (Storable(alignment,sizeOf,peekElemOff,pokeElemOff))
import Foreign.Marshal.Alloc (mallocBytes, callocBytes, allocaBytesAligned, reallocBytes)
import Foreign.Marshal.Utils (copyBytes, moveBytes)

import GHC.Num
import GHC.List
import GHC.Base

-- allocation
-- ----------

-- |Allocate storage for the given number of elements of a storable type
-- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements).
--
mallocArray :: forall a . Storable a => Int -> IO (Ptr a)
mallocArray :: Int -> IO (Ptr a)
mallocArray  Int
size = Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))

-- |Like 'mallocArray', but add an extra position to hold a special
-- termination element.
--
mallocArray0      :: Storable a => Int -> IO (Ptr a)
mallocArray0 :: Int -> IO (Ptr a)
mallocArray0 Int
size  = Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- |Like 'mallocArray', but allocated memory is filled with bytes of value zero.
--
callocArray :: forall a . Storable a => Int -> IO (Ptr a)
callocArray :: Int -> IO (Ptr a)
callocArray Int
size = Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
callocBytes (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))

-- |Like 'callocArray0', but allocated memory is filled with bytes of value
-- zero.
--
callocArray0 :: Storable a => Int -> IO (Ptr a)
callocArray0 :: Int -> IO (Ptr a)
callocArray0 Int
size  = Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
callocArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- |Temporarily allocate space for the given number of elements
-- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements).
--
allocaArray :: forall a b . Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray :: Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size = Int -> Int -> (Ptr a -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
                                      (a -> Int
forall a. Storable a => a -> Int
alignment (a
forall a. HasCallStack => a
undefined :: a))

-- |Like 'allocaArray', but add an extra position to hold a special
-- termination element.
--
allocaArray0      :: Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 :: Int -> (Ptr a -> IO b) -> IO b
allocaArray0 Int
size  = Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE allocaArray0 #-}
  -- needed to get allocaArray to inline into withCString, for unknown
  -- reasons --SDM 23/4/2010, see #4004 for benchmark

-- |Adjust the size of an array
--
reallocArray :: forall a . Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray :: Ptr a -> Int -> IO (Ptr a)
reallocArray Ptr a
ptr Int
size = Ptr a -> Int -> IO (Ptr a)
forall a. Ptr a -> Int -> IO (Ptr a)
reallocBytes Ptr a
ptr (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))

-- |Adjust the size of an array including an extra position for the end marker.
--
reallocArray0          :: Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray0 :: Ptr a -> Int -> IO (Ptr a)
reallocArray0 Ptr a
ptr Int
size  = Ptr a -> Int -> IO (Ptr a)
forall a. Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray Ptr a
ptr (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)


-- marshalling
-- -----------

-- |Convert an array of given length into a Haskell list.  The implementation
-- is tail-recursive and so uses constant stack space.
--
peekArray          :: Storable a => Int -> Ptr a -> IO [a]
peekArray :: Int -> Ptr a -> IO [a]
peekArray Int
size Ptr a
ptr | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                 | Bool
otherwise = Int -> [a] -> IO [a]
f (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) []
  where
    f :: Int -> [a] -> IO [a]
f Int
0 [a]
acc = do a
e <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
0; [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
    f Int
n [a]
acc = do a
e <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
n; Int -> [a] -> IO [a]
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)

-- |Convert an array terminated by the given end marker into a Haskell list
--
peekArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 :: a -> Ptr a -> IO [a]
peekArray0 a
marker Ptr a
ptr  = do
  Int
size <- a -> Ptr a -> IO Int
forall a. (Storable a, Eq a) => a -> Ptr a -> IO Int
lengthArray0 a
marker Ptr a
ptr
  Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
size Ptr a
ptr

-- |Write the list elements consecutive into memory
--
pokeArray :: Storable a => Ptr a -> [a] -> IO ()
pokeArray :: Ptr a -> [a] -> IO ()
pokeArray Ptr a
ptr [a]
vals0 = [a] -> Int# -> IO ()
go [a]
vals0 Int#
0#
  where go :: [a] -> Int# -> IO ()
go [] Int#
_          = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go (a
val:[a]
vals) Int#
n# = do Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr (Int# -> Int
I# Int#
n#) a
val; [a] -> Int# -> IO ()
go [a]
vals (Int#
n# Int# -> Int# -> Int#
+# Int#
1#)

-- |Write the list elements consecutive into memory and terminate them with the
-- given marker element
--
pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 :: a -> Ptr a -> [a] -> IO ()
pokeArray0 a
marker Ptr a
ptr [a]
vals0 = [a] -> Int# -> IO ()
go [a]
vals0 Int#
0#
  where go :: [a] -> Int# -> IO ()
go [] Int#
n#         = Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr (Int# -> Int
I# Int#
n#) a
marker
        go (a
val:[a]
vals) Int#
n# = do Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr (Int# -> Int
I# Int#
n#) a
val; [a] -> Int# -> IO ()
go [a]
vals (Int#
n# Int# -> Int# -> Int#
+# Int#
1#)

-- combined allocation and marshalling
-- -----------------------------------

-- |Write a list of storable elements into a newly allocated, consecutive
-- sequence of storable values
-- (like 'Foreign.Marshal.Utils.new', but for multiple elements).
--
newArray      :: Storable a => [a] -> IO (Ptr a)
newArray :: [a] -> IO (Ptr a)
newArray [a]
vals  = do
  Ptr a
ptr <- Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray ([a] -> Int
forall a. [a] -> Int
length [a]
vals)
  Ptr a -> [a] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr a
ptr [a]
vals
  Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
ptr

-- |Write a list of storable elements into a newly allocated, consecutive
-- sequence of storable values, where the end is fixed by the given end marker
--
newArray0             :: Storable a => a -> [a] -> IO (Ptr a)
newArray0 :: a -> [a] -> IO (Ptr a)
newArray0 a
marker [a]
vals  = do
  Ptr a
ptr <- Int -> IO (Ptr a)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray0 ([a] -> Int
forall a. [a] -> Int
length [a]
vals)
  a -> Ptr a -> [a] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 a
marker Ptr a
ptr [a]
vals
  Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
ptr

-- |Temporarily store a list of storable values in memory
-- (like 'Foreign.Marshal.Utils.with', but for multiple elements).
--
withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray :: [a] -> (Ptr a -> IO b) -> IO b
withArray [a]
vals = [a] -> (Int -> Ptr a -> IO b) -> IO b
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
vals ((Int -> Ptr a -> IO b) -> IO b)
-> ((Ptr a -> IO b) -> Int -> Ptr a -> IO b)
-> (Ptr a -> IO b)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr a -> IO b) -> Int -> Ptr a -> IO b
forall a b. a -> b -> a
const

-- |Like 'withArray', but the action gets the number of values
-- as an additional parameter
--
withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen :: [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
vals Int -> Ptr a -> IO b
f  =
  Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
len ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
      Ptr a -> [a] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr a
ptr [a]
vals
      Int -> Ptr a -> IO b
f Int
len Ptr a
ptr
  where
    len :: Int
len = [a] -> Int
forall a. [a] -> Int
length [a]
vals

-- |Like 'withArray', but a terminator indicates where the array ends
--
withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 :: a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 a
marker [a]
vals = a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
forall a b.
Storable a =>
a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 a
marker [a]
vals ((Int -> Ptr a -> IO b) -> IO b)
-> ((Ptr a -> IO b) -> Int -> Ptr a -> IO b)
-> (Ptr a -> IO b)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr a -> IO b) -> Int -> Ptr a -> IO b
forall a b. a -> b -> a
const

-- |Like 'withArrayLen', but a terminator indicates where the array ends
--
withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 :: a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 a
marker [a]
vals Int -> Ptr a -> IO b
f  =
  Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 Int
len ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
      a -> Ptr a -> [a] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 a
marker Ptr a
ptr [a]
vals
      b
res <- Int -> Ptr a -> IO b
f Int
len Ptr a
ptr
      b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
  where
    len :: Int
len = [a] -> Int
forall a. [a] -> Int
length [a]
vals


-- copying (argument order: destination, source)
-- -------

-- |Copy the given number of elements from the second array (source) into the
-- first array (destination); the copied areas may /not/ overlap
--
copyArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray :: Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
dest Ptr a
src Int
size = Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr a
dest Ptr a
src (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))

-- |Copy the given number of elements from the second array (source) into the
-- first array (destination); the copied areas /may/ overlap
--
moveArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
moveArray :: Ptr a -> Ptr a -> Int -> IO ()
moveArray  Ptr a
dest Ptr a
src Int
size = Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
moveBytes Ptr a
dest Ptr a
src (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))


-- finding the length
-- ------------------

-- |Return the number of elements in an array, excluding the terminator
--
lengthArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO Int
lengthArray0 :: a -> Ptr a -> IO Int
lengthArray0 a
marker Ptr a
ptr  = Int -> IO Int
loop Int
0
  where
    loop :: Int -> IO Int
loop Int
i = do
        a
val <- Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
ptr Int
i
        if a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
marker then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i else Int -> IO Int
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)


-- indexing
-- --------

-- |Advance a pointer into an array by the given number of elements
--
advancePtr :: forall a . Storable a => Ptr a -> Int -> Ptr a
advancePtr :: Ptr a -> Int -> Ptr a
advancePtr Ptr a
ptr Int
i = Ptr a
ptr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))