summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/concurrent/prog001/Converter.hs
blob: d3dfe2a34fe085ec17ab4ed2d01499faeb5a277d (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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

module Converter (rationalToGray, grayToSignIO, signToGray, Gray, startF, startC) where

import Stream
import Data.Ratio
import Control.Concurrent
import Control.Concurrent.MVar
import System.IO.Unsafe


type Gray = [Integer]
type State = (Integer, Integer)


-- Convert a rational number (in (-1,1)) to its Gray representation
rationalToGray :: Rational -> Gray
rationalToGray x
		|x<0		= f (negate' (rationalToStream (-x))) (0,0)
		|otherwise	= f (rationalToStream x) (0,0)
		
	
-- Function to implement the two heads Turing machine that convert a
-- signed-digit stream to the corresponding Gray-code representation		
f :: Stream -> State -> Stream
f (x:xs) (0,0)
	    |x==(-1)	= 0:f xs (0,0)
	    |x==0	= c:1:ds
	    |x==1	= 1:f xs (1,0)
	    where c:ds = f xs (0,1)
	    
f (x:xs) (0,1)
	    |x==(-1)	= 0:f xs (1,0)
	    |x==0	= c:0:ds
	    |x==1	= 1:f xs (0,0)
	    where c:ds = f xs (0,1)
	    
f (x:xs) (1,0)
	    |x==(-1)	= 1:f xs (0,0)
	    |x==0	= c:1:ds
	    |x==1	= 0:f xs (1,0)
	    where c:ds = f xs (1,1)
	    
f (x:xs) (1,1)
	    |x==(-1)	= 1:f xs (1,0)
	    |x==0	= c:0:ds
	    |x==1	= 0:f xs (0,0)
	    where c:ds = f xs (1,1)
	  
	  
	  

-- Anotherway to convert from a rational to Gray code representation
-- Behave exactly the same like above	  
rationalToGray' :: Rational -> Gray
rationalToGray' x
		|x<0		= signToGray (negate' (rationalToStream (-x)))	  
	  	|otherwise	= signToGray (rationalToStream x) 
		

-- Function to convert a signed-digit stream to Gray representation
-- Is much shorter than above		
signToGray :: Stream -> Stream
signToGray (1:xs) 	= 1:f'(signToGray xs)
signToGray ((-1):xs) 	= 0:signToGray xs
signToGray (0:xs) 	= c:1:(f' ds)
    		  	where c:ds = signToGray xs
	    


-- Convert a Gray-code stream to the corresponding signed-digit representation
-- Make use of threads 	    
grayToSignIO :: Stream -> IO Stream
grayToSignIO (x1:x2:xs) = do
			c <- threadTesting(x1:x2:xs)
			if (c==1)
			   then (do  co <- unsafeInterleaveIO (grayToSignIO (f'(x2:xs)))
			             return (1:co))
			   else if (c==2) 
			   	   then (do co <- unsafeInterleaveIO (grayToSignIO (x2:xs))
				            return ((-1):co))
                                   else (do co <- unsafeInterleaveIO (grayToSignIO (x1:f' xs))
				            return (0:co))

-- Flip the first bit of an infinite stream
f' (x:xs) = (f'' x):xs
	    where f'' 1 = 0
	    	  f'' 0 = 1


-- Launch two threads which run concurrently, test for the first digit of the stream (1, 0 or bottom)
-- As soon as one thread terminate, grab that result and proceed
threadTesting :: Stream -> IO Int
threadTesting xs = do   m <- newEmptyMVar
	    		c1 <- forkIO (f1 m xs)
		    	c2 <- forkIO (f2 m xs)
	    		c <- takeMVar m
	    		killThread c1
	    		killThread c2
	    		return c
	    
-- Test case 1, when the first bit is either 1 or 0. 
-- In case of bottom, f1 will never terminate, then f2 will definitely terminate	    
f1 :: MVar Int -> Stream -> IO() 
f1 m (0:xs) = putMVar m 2
f1 m (1:xs) = putMVar m 1

-- Test case 2, when the first bit is completely ignored, esp in case it was a bottom
-- If the second bit is 1, then we can output, don't care value of the first bit
-- If the second bit is 0, then loop forever, give chances to f1 to terminate
f2 :: MVar Int -> Stream -> IO()
f2 m (c1:c2:xs) 
		|c2==1		= putMVar m 3
		|otherwise	= yield




-- Testing
startC :: IO()
startC = do
	    c<- unsafeInterleaveIO (grayToSignIO (1:1:z0))
	    putStrLn (show (take 100 c))


startF = signToGray ((-1):1:z0)


z0 = 0:z0
loop' = loop'
z1' = (1:z1')