git.iko.soy/distributed-process
on master help sign in
Generalize throughput test
e55bb2dEdsko de Vries
distributed-process/benchmarks/Throughput.hs+40−10
compare with master
unifiedsplit
@@ -1,29 +1,59 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
1import System.Environment
2import System.Environment
2import Control.Monad
3import Control.Monad
3import Control.Applicative
4import Control.Applicative
4import Control.Distributed.Process
5import Control.Distributed.Process
5import Control.Distributed.Process.Node
6import Control.Distributed.Process.Node
6import Network.Transport.TCP (createTransport, defaultTCPParameters)
7import Network.Transport.TCP (createTransport, defaultTCPParameters)
7−import Data.Binary (encode, decode)
8+import Data.Binary
8import qualified Data.ByteString.Lazy as BSL
9import qualified Data.ByteString.Lazy as BSL
10+import Data.Typeable
11+
12+data SizedList a = SizedList { size :: Int , elems :: [a] }
13+ deriving (Typeable)
14+
15+instance Binary a => Binary (SizedList a) where
16+ put (SizedList sz xs) = put sz >> mapM_ put xs
17+ get = do
18+ sz <- get
19+ xs <- getMany sz
20+ return (SizedList sz xs)
21+
22+-- Copied from Data.Binary
23+getMany :: Binary a => Int -> Get [a]
24+getMany n = go [] n
25+ where
26+ go xs 0 = return $! reverse xs
27+ go xs i = do x <- get
28+ x `seq` go (x:xs) (i-1)
29+{-# INLINE getMany #-}
30+
31+nats :: Int -> SizedList Int
32+nats = \n -> SizedList n (aux n)
33+ where
34+ aux 0 = []
35+ aux n = n : aux (n - 1)
9
36
10counter :: Process ()
37counter :: Process ()
11counter = go 0
38counter = go 0
12 where
39 where
13 go :: Int -> Process ()
40 go :: Int -> Process ()
14 go !n = do
41 go !n = do
15− b <- expect
42+ msg <- receiveWait
43+ [ match $ \xs -> return . Left . size $ (xs :: SizedList Int)
44+ , match $ \them -> return . Right $ them
45+ ]
16− case b of
46+ case msg of
17− Nothing -> go (n + 1)
47+ Left n' -> go (n + n')
18− Just them -> send them n >> go 0
48+ Right them -> send them n >> go 0
19
49
20−count :: Int -> ProcessId -> Process ()
50+count :: (Int, Int) -> ProcessId -> Process ()
21−count n them = do
51+count (packets, size) them = do
22 us <- getSelfPid
52 us <- getSelfPid
23− replicateM_ n $ send them (Nothing :: Maybe ProcessId)
53+ replicateM_ packets $ send them (nats size)
24− send them (Just us)
54+ send them us
25 n' <- expect
55 n' <- expect
26− liftIO $ print (n == n')
56+ liftIO $ print (packets * size, n' == packets * size)
27
57
28initialProcess :: String -> Process ()
58initialProcess :: String -> Process ()
29initialProcess "SERVER" = do
59initialProcess "SERVER" = do