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
|
-- !!! this test exposed a bug in the take/putMVar implementation in
-- !!! GHC 5.00. It involves multiple blocking takes & puts on the
-- !!! same MVar.
import Control.Concurrent
import System.IO.Unsafe
awk True True z = 1
awk False y True = 2
awk x False False = 3
awk'1 True True z = 1
awk'2 False y True = 2
awk'3 x False False = 3
awk' x y z | ppm [a1'1,a1'2,a1'3] (x,y,z) = awk'1 x y z
| ppm [a2'1,a2'2,a2'3] (x,y,z) = awk'2 x y z
| ppm [a3'1,a3'2,a3'3] (x,y,z) = awk'3 x y z
| otherwise = 0
a1'1 (True,y,z) s = s True
a1'1 (x,y,z) s = s False
a1'2 (x,True,z) s = s True
a1'2 (x,y,z) s = s False
a1'3 (x,y,z) s = s True
a2'1 (False,y,z) s = s True
a2'1 (x,y,z) s = s False
a2'2 (x,y,z) s = s True
a2'3 (x,y,True) s = s True
a2'3 (x,y,z) s = s False
a3'1 (x,y,z) s = s True
a3'2 (x,False,z) s = s True
a3'2 (x,y,z) s = s False
a3'3 (x,y,False) s = s True
a3'3 (x,y,z) s = s False
ppm fs as = unsafePerformIO (ppm' fs as)
ppm' fs as = do m <- newEmptyMVar
let s = putMVar m
hs <- sequence [forkIO (f as s)|f <- fs]
result <- assess (length fs) m
sequence (map killThread hs)
return result
where assess 0 m = return True
assess n m = do h <- takeMVar m
if h then (assess (n-1) m)
else return False
main = do sequence [putStrLn (show (awk' x y z))|(x,y,z) <- args]
where args = [
(t,t,t),
(t,t,f),
(t,f,t),
(t,f,f),
(f,t,t),
(f,t,f),
(f,f,t),
(f,f,f),
(t,t,n)
--(f,n,t),
--(n,f,f),
]
t = True
f = False
n = odd (last [1..])
|
