git.iko.soy/distributed-process
on master help sign in
Start writing microbenchmarks
188f6aaEdsko de Vries
distributed-process/benchmarks/Throughput.hsnew file+46
@@ -0,0 +1,46 @@
1+import System.Environment
2+import Control.Monad
3+import Control.Applicative
4+import Control.Distributed.Process
5+import Control.Distributed.Process.Node
6+import Network.Transport.TCP (createTransport, defaultTCPParameters)
7+import Data.Binary (encode, decode)
8+import qualified Data.ByteString.Lazy as BSL
9+
10+counter :: Process ()
11+counter = go 0
12+ where
13+ go :: Int -> Process ()
14+ go !n = do
15+ b <- expect
16+ case b of
17+ Nothing -> go (n + 1)
18+ Just them -> send them n
19+
20+count :: Int -> ProcessId -> Process ()
21+count n them = do
22+ us <- getSelfPid
23+ replicateM_ n $ send them (Nothing :: Maybe ProcessId)
24+ send them (Just us)
25+ n' <- expect
26+ liftIO $ print (n == n')
27+
28+main :: IO ()
29+main = do
30+ args <- getArgs
31+ case args of
32+ ["server", host, port] -> do
33+ Right transport <- createTransport host port defaultTCPParameters
34+ node <- newLocalNode transport initRemoteTable
35+ runProcess node $ do
36+ us <- getSelfPid
37+ liftIO $ BSL.writeFile "counter.pid" (encode us)
38+ counter
39+ ["client", host, port, n] -> do
40+ Right transport <- createTransport host port defaultTCPParameters
41+ node <- newLocalNode transport initRemoteTable
42+ runProcess node $ do
43+ them <- liftIO $ decode <$> BSL.readFile "counter.pid"
44+ count (read n) them
45+ _ -> error "Invalid arguments"
46+
distributed-process/distributed-process.cabal+17
@@ -33,6 +33,10 @@ flag th
33 description: Build with Template Haskell support
33 description: Build with Template Haskell support
34 default: True
34 default: True
35
35
36+flag benchmarks
37+ description: Build benchmarks
38+ default: False
39+
36Library
40Library
37 Build-Depends: base >= 4.4 && < 5,
41 Build-Depends: base >= 4.4 && < 5,
38 binary >= 0.5 && < 0.6,
42 binary >= 0.5 && < 0.6,
@@ -113,3 +117,16 @@ Test-Suite TestClosure
113 ScopedTypeVariables
117 ScopedTypeVariables
114 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
118 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
115 HS-Source-Dirs: tests
119 HS-Source-Dirs: tests
120+
121+Executable distributed-process-throughput
122+ if flag(benchmarks)
123+ Build-Depends: base >= 4.4 && < 5,
124+ distributed-process >= 0.3 && < 0.4,
125+ network-transport-tcp >= 0.3 && < 0.4,
126+ bytestring >= 0.9 && < 0.11,
127+ binary >= 0.5 && < 0.6
128+ else
129+ buildable: False
130+ Main-Is: benchmarks/Throughput.hs
131+ ghc-options: -Wall
132+ Extensions: BangPatterns