X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FMarshal%2FArray.hs;h=a3d9d1639ced5b3f9e07bccd32a130f5afb94cb9;hb=fb80d56c0b7617261c93a808e9001bbb25a7562e;hp=0cd959d95156ab9ee332da0ed5e5dae39adac8ae;hpb=6a25d2d80e3bc53c3b3869f30a0622f98bccb1b0;p=ghc-base.git

diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs
index 0cd959d..a3d9d16 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,10 +62,9 @@ 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(sizeOf,peekElemOff,pokeElemOff))
-import Foreign.Marshal.Alloc (alloca, mallocBytes, allocaBytes, reallocBytes)
+import Foreign.Ptr      (Ptr, plusPtr)
+import Foreign.Storable (Storable(sizeOf,peekElemOff,pokeElemOff))
+import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes)
 import Foreign.Marshal.Utils (copyBytes, moveBytes)
 
 #ifdef __GLASGOW_HASKELL__
@@ -76,30 +78,32 @@ import GHC.Base
 -- 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            :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b'
     doAlloca dummy size  = allocaBytes (size * sizeOf 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)
@@ -109,10 +113,10 @@ allocaArray0 size  = allocaArray (size + 1)
 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)
@@ -136,13 +140,9 @@ 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
 --
@@ -152,7 +152,7 @@ pokeArray ptr vals =  zipWithM_ (pokeElemOff ptr) [0..] vals
 #else
 pokeArray ptr vals = go vals 0#
   where go [] n#         = return ()
-	go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
+        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
@@ -166,7 +166,7 @@ pokeArray0 marker ptr vals  = do
 #else
 pokeArray0 marker ptr vals = go vals 0#
   where go [] n#         = pokeElemOff ptr (I# n#) marker
-	go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
+        go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
 #endif
 
 
@@ -175,6 +175,7 @@ pokeArray0 marker ptr vals = go vals 0#
 
 -- |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
@@ -192,23 +193,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 f  =
+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
+--
+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
@@ -223,7 +236,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
@@ -232,7 +245,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)
 
 
@@ -257,5 +270,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)