From bca302fae9561944280d2230699bdf252d0375fc Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@galois.com>
Date: Mon, 9 Jun 2008 18:49:50 +0000
Subject: Use mallocPlainForeignPtrBytes if available

As for bytestrings, use PlainForeignPtrs if supported, which
have less overhead, as values are allocated on the Haskell
heap without any wasted finalisers needed. Should mean
less resources used if many small  vectors are created.
---
 lib/Data/Packed/Internal/Vector.hs | 29 ++++++++++++++++++++++++-----
 1 file changed, 24 insertions(+), 5 deletions(-)

(limited to 'lib/Data')

diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs
index 7d6e3d5..8723367 100644
--- a/lib/Data/Packed/Internal/Vector.hs
+++ b/lib/Data/Packed/Internal/Vector.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
+{-# LANGUAGE MagicHash, CPP, UnboxedTuples #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Packed.Internal.Vector
@@ -21,13 +21,20 @@ import Foreign
 import Complex
 import Control.Monad(when)
 
+#if __GLASGOW_HASKELL__ >= 605
+import GHC.ForeignPtr           (mallocPlainForeignPtrBytes)
+#else
+import Foreign.ForeignPtr       (mallocForeignPtrBytes)
+#endif
+
 import GHC.Base
 import GHC.IOBase
 
 -- | A one-dimensional array of objects stored in a contiguous memory block.
-data Vector t = V { dim  :: {-# UNPACK #-} !Int              -- ^ number of elements
-                  , fptr :: {-# UNPACK #-}!(ForeignPtr t)    -- ^ foreign pointer to the memory block
-                  }
+data Vector t =
+    V { dim  :: {-# UNPACK #-} !Int               -- ^ number of elements
+      , fptr :: {-# UNPACK #-} !(ForeignPtr t)    -- ^ foreign pointer to the memory block
+      }
 
 vec = withVector
 
@@ -40,8 +47,20 @@ withVector (V n fp) f = withForeignPtr fp $ \p -> do
 createVector :: Storable a => Int -> IO (Vector a)
 createVector n = do
     when (n <= 0) $ error ("trying to createVector of dim "++show n)
-    fp <- mallocForeignPtrArray n
+    fp <- doMalloc undefined
     return $ V n fp
+  where
+    --
+    -- Use the much cheaper Haskell heap allocated storage
+    -- for foreign pointer space we control
+    --
+    doMalloc :: Storable b => b -> IO (ForeignPtr b)
+    doMalloc dummy = do
+#if __GLASGOW_HASKELL__ >= 605
+        mallocPlainForeignPtrBytes (n * sizeOf dummy)
+#else
+        mallocForeignPtrBytes      (n * sizeOf dummy)
+#endif
 
 {- | creates a Vector from a list:
 
-- 
cgit v1.2.3