From fe795ee9b1e71666d408879ce30fe6d4ca80830e Mon Sep 17 00:00:00 2001
From: Alberto Ruiz <aruiz@um.es>
Date: Thu, 19 Jun 2008 17:25:58 +0000
Subject: ST bug fixed with NOINLINE newVector/Matrix

---
 examples/inplace.hs   | 27 +++++++++++++++++++++++++++
 lib/Data/Packed/ST.hs |  2 ++
 2 files changed, 29 insertions(+)

diff --git a/examples/inplace.hs b/examples/inplace.hs
index 29fac6f..9f23e0c 100644
--- a/examples/inplace.hs
+++ b/examples/inplace.hs
@@ -18,6 +18,7 @@ main = sequence_[
     test5,
     test6,
     print test7,
+    test8,
     test0]
 
 -- helper functions
@@ -112,3 +113,29 @@ test0 = do
     print m
     --print hv
     --print hm
+
+-------------------------------------------------
+
+histogram n ds = runSTVector $ do
+    h <- newVector (0::Double) n -- number of bins
+    let inc k = modifyVector h k (+1)
+    mapM_ inc ds
+    return h
+
+-- check that newVector is really called with a fresh new array
+histoCheck ds = runSTVector $ do
+    h <- newVector (0::Double) 15 -- > constant for this test
+    let inc k = modifyVector h k (+1)
+    mapM_ inc ds
+    return h
+
+
+test8 = do
+    let ds = [0..14]
+    print $ histogram 15 ds
+    print $ histogram 15 ds
+    print $ histogram 15 ds
+    print $ histoCheck ds
+    print $ histoCheck ds
+    print $ histoCheck ds
+    putStrLn "----------------------"
diff --git a/lib/Data/Packed/ST.hs b/lib/Data/Packed/ST.hs
index 1311ff9..ed0a05e 100644
--- a/lib/Data/Packed/ST.hs
+++ b/lib/Data/Packed/ST.hs
@@ -89,6 +89,7 @@ readVector = safeIndexV unsafeReadVector
 writeVector :: Storable t => STVector s t -> Int -> t -> ST s ()
 writeVector = safeIndexV unsafeWriteVector
 
+{-# NOINLINE newVector #-}
 newVector :: Element t => t -> Int -> ST s (STVector s t)
 newVector v = unsafeThawVector . constant v
 
@@ -154,5 +155,6 @@ readMatrix = safeIndexM unsafeReadMatrix
 writeMatrix :: Storable t => STMatrix s t -> Int -> Int -> t -> ST s ()
 writeMatrix = safeIndexM unsafeWriteMatrix
 
+{-# NOINLINE newMatrix #-}
 newMatrix :: Element t => t -> Int -> Int -> ST s (STMatrix s t)
 newMatrix v r c = unsafeThawMatrix . reshape c . constant v $ r*c
-- 
cgit v1.2.3