[commit: stm] master: add a channel benchmark (0af2ce3)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/stm

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/0af2ce3b67e0964e93435930fba3fef07a74adcd

>---------------------------------------------------------------

commit 0af2ce3b67e0964e93435930fba3fef07a74adcd
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Jun 15 10:09:34 2012 +0100

    add a channel benchmark

>---------------------------------------------------------------

 bench/chanbench.hs |   53 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 53 insertions(+), 0 deletions(-)

diff --git a/bench/chanbench.hs b/bench/chanbench.hs
new file mode 100644
index 0000000..05ab909
--- /dev/null
+++ b/bench/chanbench.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE CPP, RankNTypes #-}
+import Control.Concurrent.Async
+import Control.Monad
+import System.Environment
+
+import Control.Concurrent.Chan
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TQueue
+
+-- Using CPP rather than a runtime choice between channel types,
+-- because we want the compiler to be able to optimise the calls.
+
+#define CHAN
+-- #define TCHAN
+-- #define TQUEUE
+
+#ifdef CHAN
+newc = newChan
+readc c = readChan c
+writec c x = writeChan c x
+#elif defined(TCHAN)
+newc = newTChanIO
+readc c = atomically $ readTChan c
+writec c x = atomically $ writeTChan c x
+#elif defined(TQUEUE)
+newc = newTQueueIO
+readc c = atomically $ readTQueue c
+writec c x = atomically $ writeTQueue c x
+#endif
+
+main = do
+  [stest,sn] <- getArgs -- 2000000 is a good number
+  let n = read sn :: Int
+      test = read stest :: Int
+  runtest n test
+
+runtest :: Int -> Int -> IO ()
+runtest n test = do
+  c <- newc
+  case test of
+    0 -> do
+      a <- async $ replicateM_ n $ writec c (1 :: Int)
+      b <- async $ replicateM_ n $ readc c
+      waitBoth a b
+      return ()
+    1 -> do
+      replicateM_ n $ writec c (1 :: Int)
+      replicateM_ n $ readc c
+    2 -> do
+      let n10 = n `quot` 10
+      replicateM_ 10 $ do
+        replicateM_ n10 $ writec c (1 :: Int)
+        replicateM_ n10 $ readc c