add fib/forkIO benchmark from haskell-cafe
authorSimon Marlow <marlowsd@gmail.com>
Wed, 7 Jan 2009 15:57:13 +0000 (15:57 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Wed, 7 Jan 2009 15:57:13 +0000 (15:57 +0000)
parallel/threadfib/threadfib.hs [new file with mode: 0644]

diff --git a/parallel/threadfib/threadfib.hs b/parallel/threadfib/threadfib.hs
new file mode 100644 (file)
index 0000000..3544cb7
--- /dev/null
@@ -0,0 +1,23 @@
+module Main(main) where
+
+-- A program posted by Paul Keir on haskell-cafe (19/12/2008).  Shows
+-- up bad behaviour in the parallel GC.
+
+import Control.Concurrent
+import GHC.Conc
+
+heavytask :: MVar Integer -> Integer -> IO ()
+heavytask m n = putMVar m $! (fibs !! 70000)
+  where
+    fibs = n : (n+1) : zipWith (+) fibs (tail fibs)
+
+-- so now fibs is not globally shared but is used per-heavytask
+-- it is also evaluated by heavy task rather than just putting a thunk
+-- into the MVar
+
+main = do ms <- sequence $ replicate 8 newEmptyMVar
+          sequence_
+            [ forkOnIO (fromIntegral n) (heavytask m n)
+            | (m, n) <- zip ms [0..] ]
+          ms' <- mapM takeMVar ms
+          mapM_ print ms'