d6649fa · distributed-process

distributed-process-demos/distributed-process-demos.cabal+5−5

compare with master

unifiedsplit

@@ -25,7 +25,7 @@ flag use-azure

25

26executable distributed-process-simplelocalnet-masterslave

27 main-is: SimpleLocalnet.hs

28− hs-source-dirs: src/MasterSlave

28+ hs-source-dirs: src/MasterSlave src/Common

29 build-depends: base ==4.5.*,

30 distributed-process >= 0.3.2

31 extensions: BangPatterns, CPP, TemplateHaskell

@@ -38,7 +38,7 @@ executable distributed-process-simplelocalnet-masterslave

38

39executable distributed-process-azure-masterslave

40 main-is: Azure.hs

41− hs-source-dirs: src/MasterSlave

41+ hs-source-dirs: src/MasterSlave src/Common

42 build-depends: base ==4.5.*,

43 distributed-process >= 0.3.2

44 extensions: BangPatterns, CPP, TemplateHaskell

@@ -51,7 +51,7 @@ executable distributed-process-azure-masterslave

51

52executable distributed-process-simplelocalnet-workpushing

53 main-is: SimpleLocalnet.hs

54− hs-source-dirs: src/WorkPushing

54+ hs-source-dirs: src/WorkPushing src/Common

55 build-depends: base ==4.5.*,

56 distributed-process >= 0.3.2

57 extensions: BangPatterns, CPP, TemplateHaskell

@@ -64,7 +64,7 @@ executable distributed-process-simplelocalnet-workpushing

64

65executable distributed-process-azure-workpushing

66 main-is: Azure.hs

67− hs-source-dirs: src/WorkPushing

67+ hs-source-dirs: src/WorkPushing src/Common

68 build-depends: base ==4.5.*,

69 distributed-process >= 0.3.2

70 extensions: BangPatterns, CPP, TemplateHaskell

@@ -77,7 +77,7 @@ executable distributed-process-azure-workpushing

77

78executable distributed-process-simplelocalnet-workstealing

79 main-is: SimpleLocalnet.hs

80− hs-source-dirs: src/WorkStealing

80+ hs-source-dirs: src/WorkStealing src/Common

81 build-depends: base ==4.5.*,

82 distributed-process >= 0.3.2

83 extensions: BangPatterns, CPP, TemplateHaskell

distributed-process-demos/src/Common/PrimeFactors.hsnew file+25

@@ -0,0 +1,25 @@

1+-- | Prime factorization

2+--

3+-- Written by Dan Weston

4+-- <http://westondan.blogspot.ie/2007/07/simple-prime-factorization-code.html>

5+module PrimeFactors where

6+

7+primes :: [Integer]

8+primes = primes' (2:[3,5..])

9+ where

10+ primes' (x:xs) = x : primes' (filter (notDivisorOf x) xs)

11+ notDivisorOf d n = n `mod` d /= 0

12+

13+factors :: [Integer] -> Integer -> [Integer]

14+factors qs@(p:ps) n

15+ | n <= 1 = []

16+ | m == 0 = p : factors qs d

17+ | otherwise = factors ps n

18+ where

19+ (d,m) = n `divMod` p

20+

21+primeFactors :: Integer -> [Integer]

22+primeFactors = factors primes

23+

24+numPrimeFactors :: Integer -> Integer

25+numPrimeFactors = fromIntegral . length . primeFactors

distributed-process-demos/src/MasterSlave/MasterSlave.hs+2−7

@@ -3,15 +3,10 @@ module MasterSlave where

3import Control.Monad

4import Control.Distributed.Process

5import Control.Distributed.Process.Closure

6−

6+import PrimeFactors

7−fib :: Integer -> Integer

8−fib = go (0, 1)

9− where

10− go (!a, !b) !n | n == 0 = a

11− | otherwise = go (b, a + b) (n - 1)

12

7

13slave :: (ProcessId, Integer) -> Process ()

8slave :: (ProcessId, Integer) -> Process ()

14−slave (pid, n) = send pid (fib n)

9+slave (pid, n) = send pid (numPrimeFactors n)

15

10

16remotable ['slave]

11remotable ['slave]

17

12

distributed-process-demos/src/WorkPushing/WorkPushing.hs+3−8

@@ -3,17 +3,12 @@ module WorkPushing where

3import Control.Monad

4import Control.Distributed.Process

5import Control.Distributed.Process.Closure

6−

6+import PrimeFactors

7−fib :: Integer -> Integer

8−fib = go (0, 1)

9− where

10− go (!a, !b) !n | n == 0 = a

11− | otherwise = go (b, a + b) (n - 1)

12

7

13slave :: ProcessId -> Process ()

8slave :: ProcessId -> Process ()

14slave them = forever $ do

9slave them = forever $ do

15 n <- expect

10 n <- expect

16− send them (fib n)

11+ send them (numPrimeFactors n)

17

12

18remotable ['slave]

13remotable ['slave]

19

14

@@ -21,7 +16,7 @@ master :: Integer -> [NodeId] -> Process Integer

21master n slaves = do

16master n slaves = do

22 us <- getSelfPid

17 us <- getSelfPid

23

18

24− -- Start processes on the slaves that compute Fibonacci numbers

19+ -- Start slave processes

25 slaveProcesses <- forM slaves $ \nid -> spawn nid ($(mkClosure 'slave) us)

20 slaveProcesses <- forM slaves $ \nid -> spawn nid ($(mkClosure 'slave) us)

26

21

27 -- Distribute 1 .. n amongst the slave processes

22 -- Distribute 1 .. n amongst the slave processes

distributed-process-demos/src/WorkStealing/WorkStealing.hs+5−10

@@ -3,12 +3,7 @@ module WorkStealing where

3import Control.Monad

4import Control.Distributed.Process

5import Control.Distributed.Process.Closure

6−

6+import PrimeFactors

7−fib :: Integer -> Integer

8−fib = go (0, 1)

9− where

10− go (!a, !b) !n | n == 0 = a

11− | otherwise = go (b, a + b) (n - 1)

12

7

13slave :: (ProcessId, ProcessId) -> Process ()

8slave :: (ProcessId, ProcessId) -> Process ()

14slave (master, workQueue) = do

9slave (master, workQueue) = do

@@ -21,7 +16,7 @@ slave (master, workQueue) = do

21

16

22 -- If there is work, do it, otherwise terminate

17 -- If there is work, do it, otherwise terminate

23 receiveWait

18 receiveWait

24− [ match $ \n -> send master (fib n) >> go us

19+ [ match $ \n -> send master (numPrimeFactors n) >> go us

25 , match $ \() -> return ()

20 , match $ \() -> return ()

26 ]

21 ]

27

22

@@ -32,17 +27,17 @@ master n slaves = do

32 us <- getSelfPid

27 us <- getSelfPid

33

28

34 workQueue <- spawnLocal $ do

29 workQueue <- spawnLocal $ do

35− -- As long as there is work, return the next Fib to compute

30+ -- Reply with the next bit of work to be done

36 forM_ [1 .. n] $ \m -> do

31 forM_ [1 .. n] $ \m -> do

37 them <- expect

32 them <- expect

38 send them m

33 send them m

39

34

40− -- After that, just report that the work is done

35+ -- Once all the work is done, tell the slaves to terminate

41 forever $ do

36 forever $ do

42 pid <- expect

37 pid <- expect

43 send pid ()

38 send pid ()

44

39

45− -- Start processes on the slaves that compute Fibonacci numbers

40+ -- Start slave processes

46 forM_ slaves $ \nid -> spawn nid ($(mkClosure 'slave) (us, workQueue))

41 forM_ slaves $ \nid -> spawn nid ($(mkClosure 'slave) (us, workQueue))

47

42

48 -- Wait for the result

43 -- Wait for the result