4.23. MarshalArray

The module MarshalArray provides operations for marshalling Haskell lists into monolithic arrays and vice versa. Most functions come in two flavours: one for arrays terminated by a special termination element and one where an explicit length parameter is used to determine the extent of an array. The typical example for the former case are C's NUL terminated strings. However, please note that C strings should usually be marshalled with the functions provided by CString (Section 4.9) as these functions take care of the Unicode encoding, which is ignored by the functions in the present module. All functions specifically operating on arrays that are terminated by a special termination element have a name ending on 0 - e.g., mallocArray allocates space for an array of the given size, whereas mallocArray0 allows for one more element.

The following six functions allocate storage for arrays.

mallocArray    :: Storable a => Int -> IO (Ptr a)
mallocArray0   :: Storable a => Int -> IO (Ptr a)

allocaArray    :: Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0   :: Storable a => Int -> (Ptr a -> IO b) -> IO b

reallocArray   :: Storable a => Ptr a -> Int -> IO (Ptr a)
reallocArray0  :: Storable a => Ptr a -> Int -> IO (Ptr a)

The semantics of mallocArray, allocaArray, and reallocArray is like that of the functions malloc, alloca, and realloc provided by the module MarshalAlloc (Section 4.24), respectively, except that they allocate enough storage for a sequence of elements whose length is explicitly given. The functions mallocArray0, allocaArray0, and reallocArray0 allocate storage for one additional element to allow for a termination indicator.

The next four functions marshal lists into arrays and vice versa.

peekArray  :: Storable a =>         Int -> Ptr a -> IO [a]
peekArray0 :: (Storable a, Eq a) => a   -> Ptr a -> IO [a]

pokeArray  :: Storable a =>      Ptr a -> [a] -> IO ()
pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO ()

The functions peekArray and peekArray0 correspond to Storable.peek and the functions pokeArray and pokeArray0 correspond to Storable.poke (cf. Section 4.35). The first argument of peekArray0 and pokeArray0 is the element value indicating termination of the array. This element will not be included in the Haskell list representation of the marshalled value.

The next four functions combine allocation and marshalling.

newArray       :: Storable a =>      [a] -> IO (Ptr a)
newArray0      :: Storable a => a -> [a] -> IO (Ptr a)

withArray      :: Storable a =>      [a] -> (Ptr a -> IO b) -> IO b
withArray0     :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b

destructArray  :: Storable a => Int -> Ptr a -> IO ()
destructArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO ()

The functions newArray and newArray0 correspond to MarshalUtils.new, the functions withArray and withArray0 correspond to MarshalUtils.with, and the functions destructArray and destructArray0 correspond to Storable.destruct (cf. Section 4.25, Section 4.35).

copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()

The two functions copyArray and moveArray copy entire arrays and behave like the routines MarshalUtils.copyBytes and MarshalUtils.moveBytes, respectively. In particular, moveArray allows the source and destination array to overlap, whereas copyArray does not allow overlapping arrays. Both functions take a reference to the destination array as their first, and a reference to the source as their second argument. However, the count argument here is in number of array elements (whose type is specified by the parametrised pointer arguments) instead of number of bytes.

lengthArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO Int

lengthArray0 finds the length of an array whose end is marked by a distinguished value. The length is measured in array elements (not bytes) and doesn't include the terminator.

advancePtr :: Storable a => Ptr a -> Int -> Ptr a

Finally, advancePtr, given a reference to an array, advances that reference by as many array elements (not bytes) as specified.