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 <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
