X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FMarshal%2FArray.hs;h=9e8d08287da8174200729c7218dff9936277696b;hb=98daa4a448e019083d52ccec219a912021a0bfb0;hp=b6b14d6412e5b6a2804561ce47b917698453ef11;hpb=5545727d5a6a1fc6d5d00f32a92a8fdf0fb7ca77;p=ghc-base.git diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs index b6b14d6..9e8d082 100644 --- a/Foreign/Marshal/Array.hs +++ b/Foreign/Marshal/Array.hs @@ -1,24 +1,23 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -XNoImplicitPrelude #-} ----------------------------------------------------------------------------- --- +-- | -- Module : Foreign.Marshal.Array -- Copyright : (c) The FFI task force 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- --- $Id: Array.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $ --- -- 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 + -- ** Allocation -- mallocArray, -- :: Storable a => Int -> IO (Ptr a) mallocArray0, -- :: Storable a => Int -> IO (Ptr a) @@ -29,7 +28,7 @@ module Foreign.Marshal.Array ( reallocArray, -- :: Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray0, -- :: Storable a => Ptr a -> Int -> IO (Ptr a) - -- marshalling + -- ** Marshalling -- peekArray, -- :: Storable a => Int -> Ptr a -> IO [a] peekArray0, -- :: (Storable a, Eq a) => a -> Ptr a -> IO [a] @@ -37,7 +36,7 @@ module Foreign.Marshal.Array ( pokeArray, -- :: Storable a => Ptr a -> [a] -> IO () pokeArray0, -- :: Storable a => a -> Ptr a -> [a] -> IO () - -- combined allocation and marshalling + -- ** Combined allocation and marshalling -- newArray, -- :: Storable a => [a] -> IO (Ptr a) newArray0, -- :: Storable a => a -> [a] -> IO (Ptr a) @@ -45,79 +44,84 @@ module Foreign.Marshal.Array ( withArray, -- :: Storable a => [a] -> (Ptr a -> IO b) -> IO b withArray0, -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b - -- destruction - -- - destructArray, -- :: Storable a => Int -> Ptr a -> IO () - destructArray0, -- :: (Storable a, Eq a) => a -> Ptr a -> IO () + withArrayLen, -- :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b + withArrayLen0, -- :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b - -- copying (argument order: destination, source) - -- + -- ** Copying + + -- | (argument order: destination, source) copyArray, -- :: Storable a => Ptr a -> Ptr a -> Int -> IO () moveArray, -- :: Storable a => Ptr a -> Ptr a -> Int -> IO () - -- finding the length + -- ** Finding the length -- lengthArray0, -- :: (Storable a, Eq a) => a -> Ptr a -> IO Int - -- indexing + -- ** Indexing -- - advancePtr -- :: Storable a => Ptr a -> Int -> Ptr a + advancePtr, -- :: Storable a => Ptr a -> Int -> Ptr a ) where -import Control.Monad +import Foreign.Ptr (Ptr, plusPtr) +import Foreign.Storable (Storable(alignment,sizeOf,peekElemOff,pokeElemOff)) +import Foreign.Marshal.Alloc (mallocBytes, allocaBytesAligned, reallocBytes) +import Foreign.Marshal.Utils (copyBytes, moveBytes) #ifdef __GLASGOW_HASKELL__ -import Foreign.Ptr (Ptr, plusPtr) -import GHC.Storable (Storable(sizeOf,peekElemOff,pokeElemOff,destruct)) -import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes) -import Foreign.Marshal.Utils (copyBytes, moveBytes) -import GHC.IOBase import GHC.Num import GHC.List import GHC.Err import GHC.Base +#else +import Control.Monad (zipWithM_) #endif -- allocation -- ---------- --- allocate storage for the given number of elements of a storable type +-- |Allocate storage for the given number of elements of a storable type +-- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements). -- mallocArray :: Storable a => Int -> IO (Ptr a) mallocArray = doMalloc undefined where - doMalloc :: Storable a => a -> Int -> IO (Ptr a) + doMalloc :: Storable a' => a' -> Int -> IO (Ptr a') doMalloc dummy size = mallocBytes (size * sizeOf dummy) --- like `mallocArray', but add an extra element to signal the end of the array +-- |Like 'mallocArray', but add an extra position to hold a special +-- termination element. -- mallocArray0 :: Storable a => Int -> IO (Ptr a) mallocArray0 size = mallocArray (size + 1) --- temporarily allocate space for the given number of elements --- --- * see `MarshalAlloc.alloca' for the storage lifetime constraints +-- |Temporarily allocate space for the given number of elements +-- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements). -- allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray = doAlloca undefined where - doAlloca :: Storable a => a -> Int -> (Ptr a -> IO b) -> IO b - doAlloca dummy size = allocaBytes (size * sizeOf dummy) + doAlloca :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b' + doAlloca dummy size = allocaBytesAligned (size * sizeOf dummy) + (alignment dummy) --- like `allocaArray', but add an extra element to signal the end of the array +-- |Like 'allocaArray', but add an extra position to hold a special +-- termination element. -- allocaArray0 :: Storable a => Int -> (Ptr a -> IO b) -> IO b allocaArray0 size = allocaArray (size + 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 +-- |Adjust the size of an array -- reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a) reallocArray = doRealloc undefined where - doRealloc :: Storable a => a -> Ptr a -> Int -> IO (Ptr a) + doRealloc :: Storable a' => a' -> Ptr a' -> Int -> IO (Ptr a') doRealloc dummy ptr size = reallocBytes ptr (size * sizeOf dummy) --- adjust the size of an array while adding an element for the end marker +-- |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 size = reallocArray ptr (size + 1) @@ -126,41 +130,55 @@ reallocArray0 ptr size = reallocArray ptr (size + 1) -- marshalling -- ----------- --- convert an array of given length into a Haskell list +-- |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 size ptr = mapM (peekElemOff ptr) [0..size-1] - --- convert an array terminated by the given end marker into a Haskell list +peekArray size ptr | size <= 0 = return [] + | otherwise = f (size-1) [] + where + f 0 acc = do e <- peekElemOff ptr 0; return (e:acc) + f n acc = do e <- peekElemOff ptr n; f (n-1) (e: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 marker ptr = loop 0 - where - loop i = do - val <- peekElemOff ptr i - if val == marker then return [] else do - rest <- loop (i+1) - return (val:rest) +peekArray0 marker ptr = do + size <- lengthArray0 marker ptr + peekArray size ptr --- write the list elements consecutive into memory +-- |Write the list elements consecutive into memory -- -pokeArray :: Storable a => Ptr a -> [a] -> IO () -pokeArray ptr vals = zipWithM_ (pokeElemOff ptr) [0..] vals +pokeArray :: Storable a => Ptr a -> [a] -> IO () +#ifndef __GLASGOW_HASKELL__ +pokeArray ptr vals = zipWithM_ (pokeElemOff ptr) [0..] vals +#else +pokeArray ptr vals0 = go vals0 0# + where go [] _ = return () + go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) +#endif --- write the list elements consecutive into memory and terminate them with the +-- |Write the list elements consecutive into memory and terminate them with the -- given marker element -- -pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO () +pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO () +#ifndef __GLASGOW_HASKELL__ pokeArray0 marker ptr vals = do pokeArray ptr vals pokeElemOff ptr (length vals) marker +#else +pokeArray0 marker ptr vals0 = go vals0 0# + where go [] n# = pokeElemOff ptr (I# n#) marker + go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) +#endif -- combined allocation and marshalling -- ----------------------------------- --- write a list of storable elements into a newly allocated, consecutive +-- |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 vals = do @@ -168,7 +186,7 @@ newArray vals = do pokeArray ptr vals return ptr --- write a list of storable elements into a newly allocated, consecutive +-- |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) @@ -177,76 +195,67 @@ newArray0 marker vals = do pokeArray0 marker ptr vals return ptr --- temporarily store a list of storable values in memory +-- |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 vals = withArrayLen vals . const + +-- |Like 'withArray', but the action gets the number of values +-- as an additional parameter -- -withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b -withArray vals f = +withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b +withArrayLen vals f = allocaArray len $ \ptr -> do pokeArray ptr vals - res <- f ptr - destructArray len ptr + res <- f len ptr return res where len = length vals --- like `withArray', but a terminator indicates where the array ends +-- |Like 'withArray', but a terminator indicates where the array ends -- -withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b -withArray0 marker vals f = +withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b +withArray0 marker vals = withArrayLen0 marker vals . const + +-- |Like 'withArrayLen', but a terminator indicates where the array ends +-- +withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b +withArrayLen0 marker vals f = allocaArray0 len $ \ptr -> do pokeArray0 marker ptr vals - res <- f ptr - destructArray (len+1) ptr + res <- f len ptr return res where len = length vals --- destruction --- ----------- - --- destruct each element of an array (in reverse order) --- -destructArray :: Storable a => Int -> Ptr a -> IO () -destructArray size ptr = - sequence_ [destruct (ptr `advancePtr` i) - | i <- [size-1, size-2 .. 0]] - --- like `destructArray', but a terminator indicates where the array ends --- -destructArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO () -destructArray0 marker ptr = do - size <- lengthArray0 marker ptr - sequence_ [destruct (ptr `advancePtr` i) - | i <- [size, size-1 .. 0]] - - -- 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 +-- |Copy the given number of elements from the second array (source) into the +-- first array (destination); the copied areas may /not/ overlap -- copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO () copyArray = doCopy undefined where - doCopy :: Storable a => a -> Ptr a -> Ptr a -> Int -> IO () + doCopy :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO () doCopy dummy dest src size = copyBytes dest src (size * sizeOf dummy) --- copy the given number of elements from the second array (source) into the --- first array (destination); the copied areas *may* overlap +-- |Copy the given number of elements from the second array (source) into the +-- first array (destination); the copied areas /may/ overlap -- moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO () moveArray = doMove undefined where - doMove :: Storable a => a -> Ptr a -> Ptr a -> Int -> IO () + doMove :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO () doMove dummy dest src size = moveBytes dest src (size * sizeOf dummy) -- finding the length -- ------------------ --- return the number of elements in an array, excluding the terminator +-- |Return the number of elements in an array, excluding the terminator -- lengthArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO Int lengthArray0 marker ptr = loop 0 @@ -259,10 +268,10 @@ lengthArray0 marker ptr = loop 0 -- indexing -- -------- --- advance a pointer into an array by the given number of elements +-- |Advance a pointer into an array by the given number of elements -- advancePtr :: Storable a => Ptr a -> Int -> Ptr a advancePtr = doAdvance undefined where - doAdvance :: Storable a => a -> Ptr a -> Int -> Ptr a + doAdvance :: Storable a' => a' -> Ptr a' -> Int -> Ptr a' doAdvance dummy ptr i = ptr `plusPtr` (i * sizeOf dummy)