> module Main (main) where

This module serves as a testbench for various internal issues which are hard to debug using the
example programs.

> import Distributed
> import CPUTime
> import Concurrent
> import IO

> data Msgs = Ping Pid | Pong | Reap
>   deriving (Show,Read)

> main :: IO ()
> main = do
>  putStrLn "The Distributed Haskell Performance Suite"
>  hSetBuffering stdout NoBuffering
>  msgsToSelf 10000                
>  msgsToSelfPingPong 10000	      
>  -- msgsToSelfRegistered 10000
>  -- msgsToTunnel 100
>  -- msgsWithoutTunnel 100
>  msgsToSelfDHD 1000

> msgsToSelf :: Int -> IO ()
> msgsToSelf nr = do
>  putStrLn ("Sending " ++ (show nr) ++ " messages to a sink...")
>  Distributed.start (do
>    sinkPid <- spawn sink
>    me <- self
>    timeBrace (loop nr me sinkPid)
>    halt
>   ) ""
>  putStrLn ("Done!")
>
>  where
>    sink :: DIO Msgs ()
>    sink = do
>	     receive (\v -> case v of
>	       Ping _ -> sink
>	       Reap   -> return ()
>	      )
>    loop :: Int -> Pid -> Pid -> DIO Msgs ()
>    loop 0 _ pid = do
>      pid <!> Reap
>      return ()
>    loop (nr+1) me pid = do
>      pid <!>  Ping me
>      loop nr me pid

> msgsToSelfPingPong :: Int -> IO ()
> msgsToSelfPingPong nr = do
>  putStrLn ("Sending " ++ (show nr) ++ " ping-pong messages...")
>  Distributed.start (do
>    sinkPid <- spawn sink
>    me <- self
>    timeBrace (loop nr me sinkPid)
>    halt
>   ) ""
>  putStrLn ("Done!")
>  where
>    sink :: DIO Msgs ()
>    sink = do
>	     receive (\v -> case v of
>	       Ping p -> do p <!> Pong; sink
>	       Reap   -> do return ()
>	      )
>    loop :: Int -> Pid -> Pid -> DIO Msgs ()
>    loop 0 _ him = do
>      him <!> Reap
>      return ()
>    loop (nr+1) me him = do
>      him <!> Ping me
>      receive (\v -> case v of
>        Pong -> loop nr me him
>	)

> msgsToSelfRegistered :: Int -> IO ()
> msgsToSelfRegistered nr = do
>  putStrLn ("Sending " ++ (show nr) ++ " messages to a named sink...")
>  Distributed.start (do
>    sinkPid <- spawn (do register "nada"; sink)
>    me <- self
>    timeBrace (loop nr me)
>    halt
>   ) ""
>  putStrLn ("Done!")
>
>  where
>    sink :: DIO Msgs ()
>    sink = do
>	     receive (\v -> case v of
>	       Ping _ -> sink
>	       Reap   -> return ()
>	      )
>    loop :: Int -> Pid -> DIO Msgs ()
>    loop 0 _  = do
>      -- sendRegistered "nada" Reap
>      return ()
>    loop (nr+1) me = do
>      -- sendRegistered "nada" (Ping me)
>      loop nr me

> msgsToTunnel :: Int -> IO ()
> msgsToTunnel nr = do
>  putStrLn ("Sending " ++ (show nr) ++ " 'tunneled' messages to a sink...")
>  Distributed.start (do
>    (Pid (host,port) p) <- spawn sink
>    let sPid = (Pid ("monster",port) p) -- Trick for Pid-rewriting: localhost != hostname
>    -- allocTunnel sPid
>    me <- self
>    timeBrace (loop nr me sPid)
>    halt
>   ) ""
>  putStrLn ("Done!")
>
>  where
>    sink :: DIO Msgs ()
>    sink = do
>	     receive (\v -> case v of
>	       Ping _ -> sink
>	       Reap   -> return ()
>	      )
>    loop :: Int -> Pid -> Pid -> DIO Msgs ()
>    loop 0 _ sp = do
>      sp <!> Reap
>      return ()
>    loop (nr+1) me sp = do
>      sp <!> (Ping me)
>      loop nr me sp

> msgsWithoutTunnel :: Int -> IO ()
> msgsWithoutTunnel nr = do
>  putStrLn ("Sending " ++ (show nr) ++ " messages to a sink...")
>  Distributed.start (do
>    (Pid (host,port) p) <- spawn sink
>    proc $ putStrLn host
>    let sPid = (Pid ("monster",port) p) -- Trick for Pid-rewriting: host.FQDN != hostname
>    me <- self
>    timeBrace (loop nr me sPid)
>    halt     
>   ) ""
>  putStrLn ("Done!")
>
>  where
>    sink :: DIO Msgs ()
>    sink = do
>	     receive (\v -> case v of
>	       Ping _ -> sink
>	       Reap   -> return ()
>	      )
>    loop :: Int -> Pid -> Pid -> DIO Msgs ()
>    loop 0 _ sp = do
>      sp <!> Reap
>      return ()
>    loop (nr+1) me sp = do
>      sp <!> (Ping me)
>      loop nr me sp

> msgsToSelfDHD :: Int -> IO ()
> msgsToSelfDHD nr = do
>  putStrLn ("Sending " ++ (show nr) ++ " messages to a named 'loopback' sink...")
>  Distributed.start (do
>    _  <- spawn (do register "nada"; sink)
>    me <- self
>    timeBrace (loop nr me)
>    halt
>   ) "infierno"
>  putStrLn ("Done!")
>
>  where
>    sink :: DIO Msgs ()
>    sink = do
>	     receive (\v -> case v of
>	       Ping _ -> sink
>	       Reap   -> return ()
>	      )
>    loop :: Int -> Pid -> DIO Msgs ()
>    loop 0 _ = do
>      remoteSend (Hostname "localhost") (Nodename "infierno") "nada" Reap
>      return ()
>    loop (nr+1) me = do
>      proc $ putStr "."		
>      remoteSend (Hostname "localhost") (Nodename "infierno") "nada" (Ping me)
>      loop nr me 

> timeBrace :: DIO Msgs () -> DIO Msgs ()
> timeBrace f = do
>   time1 <- proc $ getCPUTime
>   f
>   time2 <- proc $ getCPUTime
>   proc $ putStrLn ("CPUTime (div 100000): " ++ (show (div (time2-time1) 100000)))