blob: d2a6882d6c9f57579b969f42a35e6944bcd1a03f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
{-# LANGUAGE BangPatterns #-}
module ManyQueue where
import Control.Concurrent
import Control.Monad
import Conf
newtype MQueue a = MQueue [MVar a]
newMQueue size = do
lst <- replicateM size newEmptyMVar
return (MQueue (cycle lst))
writeMQueue :: (MQueue a) -> a -> IO (MQueue a)
writeMQueue (MQueue (x:xs)) el = do
putMVar x el
return (MQueue xs)
readMQueue :: (MQueue a) -> IO (MQueue a, a)
readMQueue (MQueue (x:xs)) = do
el <- takeMVar x
return ((MQueue xs), el)
testManyQueue'1P1C = do
print "Test.ManyQueue.testManyQueue'1P1C"
finished <- newEmptyMVar
mq <- newMQueue bufferSize
let
-- elements = [0] ++ [1 .. iTERATIONS] -- workaround
elements = [0 .. iTERATIONS] -- heap overflow
writer _ 0 = putMVar finished ()
writer q x = do
q' <- writeMQueue q x
writer q' (x-1)
writer' _ [] = putMVar finished ()
writer' q (x:xs) = do
q' <- writeMQueue q x
writer' q' xs
reader _ !acc 0 = print acc >> putMVar finished ()
reader q !acc n = do
(q', x) <- readMQueue q
reader q' (acc+x) (n-1)
--forkIO $ writer mq iTERATIONS
forkIO $ writer' mq elements
forkIO $ reader mq 0 iTERATIONS
takeMVar finished
takeMVar finished
testManyQueue'1P3C = do
print "Test.ManyQueue.testManyQueue'1P3C"
let tCount = 3
finished <- newEmptyMVar
mqs <- replicateM tCount (newMQueue bufferSize)
let elements = [0 .. iTERATIONS]
writer _ [] = putMVar finished ()
writer qs (x:xs) = do
qs' <- mapM (\q -> writeMQueue q x) qs
writer qs' xs
reader _ !acc 0 = print acc >> putMVar finished ()
reader q !acc n = do
(q', x) <- readMQueue q
reader q' (acc+x) (n-1)
forkIO $ writer mqs elements
mapM_ (\ mq -> forkIO $ reader mq 0 iTERATIONS) mqs
replicateM (tCount+1) (takeMVar finished)
return ()
|
