X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FMarshal%2FArray.hs;h=9e8d08287da8174200729c7218dff9936277696b;hb=98daa4a448e019083d52ccec219a912021a0bfb0;hp=16a3e47bb3567d322067da7c3bb07f3a69934e95;hpb=f7a485978f04e84b086f1974b88887cc72d832d0;p=ghc-base.git

diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs
index 16a3e47..9e8d082 100644
--- a/Foreign/Marshal/Array.hs
+++ b/Foreign/Marshal/Array.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Foreign.Marshal.Array
@@ -44,6 +44,9 @@ 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
 
+  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)
@@ -59,60 +62,66 @@ module Foreign.Marshal.Array (
   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))
-import Foreign.Marshal.Alloc (alloca, 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 'Foreign.Marshal.Alloc.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
 --
 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)
@@ -121,10 +130,8 @@ reallocArray0 ptr size  = reallocArray ptr (size + 1)
 -- marshalling
 -- -----------
 
--- |Convert an array of given length into a Haskell list.  This version
--- traverses the array backwards using an accumulating parameter,
--- which uses constant stack space.  The previous version using mapM
--- needed linear stack space.
+-- |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 | size <= 0 = return []
@@ -136,26 +143,34 @@ peekArray size ptr | size <= 0 = return []
 -- |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
 --
-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
 -- 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
@@ -163,6 +178,7 @@ pokeArray0 marker ptr vals  = do
 
 -- |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
@@ -180,23 +196,35 @@ newArray0 marker vals  = do
   return 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 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
+      res <- f len ptr
       return res
   where
     len = length vals
 
 -- |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
+      res <- f len ptr
       return res
   where
     len = length vals
@@ -211,7 +239,7 @@ withArray0 marker vals f  =
 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
@@ -220,7 +248,7 @@ copyArray  = doCopy undefined
 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)
 
 
@@ -245,5 +273,5 @@ lengthArray0 marker ptr  = loop 0
 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)