@@ -2,11 +2,12 @@
22
33To run the benchmarks, select a value for the ring size (sz) and
44the number of times to send a message around the ring
5+
56-}
67import Control.Monad
78import Control.Distributed.Process hiding (catch)
89import Control.Distributed.Process.Node
9−import Control.Exception (SomeException, catch)
10+import Control.Exception (catch, SomeException)
1011import Network.Transport.TCP (createTransport, defaultTCPParameters)
1112import System.Environment
1213import System.Console.GetOpt
@@ -16,6 +17,7 @@ data Options = Options
1617 , optIterations :: Int
1718 , optForward :: Bool
1819 , optParallel :: Bool
20+ , optUnsafe :: Bool
1921 } deriving Show
2022
2123initialProcess :: Options -> Process ()
@@ -23,28 +25,30 @@ initialProcess op =
2325 let ringSz = optRingSize op
2426 msgCnt = optIterations op
2527 fwd = optForward op
28+ unsafe = optUnsafe op
2629 msg = ("foobar", "baz")
2730 in do
2831 self <- getSelfPid
29− ring <- makeRing fwd ringSz self
32+ ring <- makeRing fwd unsafe ringSz self
3033 forM_ [1..msgCnt] (\_ -> send ring msg)
3134 collect msgCnt
32− where relay' pid = do
35+ where relay fsend pid = do
3336 msg <- expect :: Process (String, String)
34− send pid msg
35− relay' pid
37+ fsend pid msg
38+ relay fsend pid
3639
3740 forward' pid =
3841 receiveWait [ matchAny (\m -> forward m pid) ] >> forward' pid
3942
40− makeRing :: Bool -> Int -> ProcessId -> Process ProcessId
41− makeRing !f !n !pid
42− | n == 0 = go f pid
43− | otherwise = go f pid >>= makeRing f (n - 1)
43+ makeRing :: Bool -> Bool -> Int -> ProcessId -> Process ProcessId
44+ makeRing !f !u !n !pid
45+ | n == 0 = go f u pid
46+ | otherwise = go f u pid >>= makeRing f u (n - 1)
4447
45− go :: Bool -> ProcessId -> Process ProcessId
46− go False next = spawnLocal $ relay' next
47− go True next = spawnLocal $ forward' next
48+ go :: Bool -> Bool -> ProcessId -> Process ProcessId
49+ go False False next = spawnLocal $ relay send next
50+ go False True next = spawnLocal $ relay unsafeSend next
51+ go True _ next = spawnLocal $ forward' next
4852
4953 collect :: Int -> Process ()
5054 collect !n
@@ -63,6 +67,7 @@ defaultOptions = Options
6367 , optIterations = 100
6468 , optForward = False
6569 , optParallel = False
70+ , optUnsafe = False
6671 }
6772
6873options :: [OptDescr (Options -> Options)]
@@ -72,6 +77,9 @@ options =
7277 , Option ['f'] ["forward"]
7378 (NoArg (\opts -> opts { optForward = True }))
7479 "use `forward' instead of send - default = False"
80+ , Option ['u'] ["unsafe-send"]
81+ (NoArg (\opts -> opts { optUnsafe = True }))
82+ "use 'unsafeSend' (ignored with -f) - default = False"
7583 , Option ['p'] ["parallel"]
7684 (NoArg (\opts -> opts { optForward = True }))
7785 "send in parallel and consume sequentially - default = False"
@@ -100,6 +108,6 @@ main = do
100108 putStrLn $ "options: " ++ (show opt)
101109 Right transport <- createTransport "127.0.0.1" "8090" defaultTCPParameters
102110 node <- newLocalNode transport initRemoteTable
103− catch (runProcess node $ initialProcess opt)
111+ catch (void $ runProcess node $ initialProcess opt)
104112 (\(e :: SomeException) -> putStrLn $ "ERROR: " ++ (show e))
105113