@@ -1,29 +1,59 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
12import System.Environment
23import Control.Monad
34import Control.Applicative
45import Control.Distributed.Process
56import Control.Distributed.Process.Node
67import Network.Transport.TCP (createTransport, defaultTCPParameters)
7−import Data.Binary (encode, decode)
8+import Data.Binary
89import 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)
936
1037counter :: Process ()
1138counter = go 0
1239 where
1340 go :: Int -> Process ()
1441 go !n = do
15− b <- expect
16− case b of
17− Nothing -> go (n + 1)
18− Just them -> send them n >> go 0
42+ msg <- receiveWait
43+ [ match $ \xs -> return . Left . size $ (xs :: SizedList Int)
44+ , match $ \them -> return . Right $ them
45+ ]
46+ case msg of
47+ Left n' -> go (n + n')
48+ Right them -> send them n >> go 0
1949
20−count :: Int -> ProcessId -> Process ()
21−count n them = do
50+count :: (Int, Int) -> ProcessId -> Process ()
51+count (packets, size) them = do
2252 us <- getSelfPid
23− replicateM_ n $ send them (Nothing :: Maybe ProcessId)
24− send them (Just us)
53+ replicateM_ packets $ send them (nats size)
54+ send them us
2555 n' <- expect
26− liftIO $ print (n == n')
56+ liftIO $ print (packets * size, n' == packets * size)
2757
2858initialProcess :: String -> Process ()
2959initialProcess "SERVER" = do