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

diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs
index 787c37d..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
@@ -62,18 +62,18 @@ 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 (mallocBytes, allocaBytes, reallocBytes)
+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 GHC.IOBase
 import GHC.Num
 import GHC.List
 import GHC.Err
 import GHC.Base
+#else
+import Control.Monad (zipWithM_)
 #endif
 
 -- allocation
@@ -101,13 +101,17 @@ 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 dummy size  = allocaBytesAligned (size * sizeOf dummy)
+                                              (alignment dummy)
 
 -- |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
 --
@@ -126,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 []
@@ -151,9 +153,9 @@ pokeArray :: Storable a => Ptr a -> [a] -> IO ()
 #ifndef __GLASGOW_HASKELL__
 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#)
+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
@@ -165,9 +167,9 @@ pokeArray0 marker ptr vals  = do
   pokeArray ptr vals
   pokeElemOff ptr (length vals) marker
 #else
-pokeArray0 marker ptr vals = go vals 0#
+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#)
+        go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
 #endif