blob: c1c18c549b0e203a29db6bdb4ed347db797f31db (
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
module Arithmetic where
import Control.Concurrent
import Control.Concurrent.MVar
import System.IO.Unsafe
import Utilities
import Converter
import Stream
import Data.Ratio
import Trit
-- Negate a stream of Gray code
negateGray :: Gray -> Gray
negateGray = fl
-- Multiply a Gray code stream by 2
-- The stream must represent a real number in (-1/2, 1/2) only
mul2 :: Gray -> Gray
mul2 (x:1:xs) = (x:fl xs)
-- Division by 2, the result is to be in (-1/2, 1/2)
div2 :: Gray -> Gray
div2 (x:xs) = x:1:(fl xs)
-- Addition by 1, the input must be in (-1,0)
plusOne :: Gray -> Gray
plusOne (0:xs) = 1:fl xs
-- Substraction by 1, the input must be in (0,1)
minusOne :: Gray -> Gray
minusOne (1:xs) = 0:fl xs
threadTesting :: Gray -> Gray -> IO Int
threadTesting xs ys = do
m <- newEmptyMVar
c1 <- forkIO (t1 m xs ys)
c2 <- forkIO (t2 m xs ys)
c3 <- forkIO (t3 m xs ys)
c4 <- forkIO (t4 m xs ys)
c5 <- forkIO (t5 m xs ys)
c6 <- forkIO (t6 m xs ys)
c <- takeMVar m
killThread c1
killThread c2
killThread c3
killThread c4
killThread c5
killThread c6
return c
addition :: Gray -> Gray -> IO Gray
addition xs ys = do
c <- threadTesting xs ys
case c of
1 -> do
let tx = tail xs
let ty = tail ys
t <- unsafeInterleaveIO (addition tx ty)
return (0:t)
2 -> do
let tx = tail xs
let ty = tail ys
t <- unsafeInterleaveIO (addition tx ty)
return (1:t)
3 -> do
let tx = tail xs
let ty = tail ys
cs <- unsafeInterleaveIO (addition tx (fl ty))
let c1 = cs !! 0
let c2 = tail cs
return (c1:1:fl c2)
4 -> do
let tx = tail xs
let ty = tail ys
(cs) <- unsafeInterleaveIO (addition (fl tx) ty)
let c1 = cs !! 0
let c2 = tail cs
return (c1:1:(fl c2))
5 -> do
let x1 = xs!!0
let y1 = ys!!0
let tx = (drop 2) xs
let ty = (drop 2) ys
cs <- unsafeInterleaveIO (addition (x1:(fl tx)) (y1:(fl ty)))
let c1 = cs !! 0
let c2 = tail cs
return (c1:(1:(fl c2)))
6 -> do
let x1 = xs !! 0
let tx = drop 3 xs
let ty = drop 2 ys
t <- unsafeInterleaveIO (addition (x1:1:tx) (1:fl ty))
return (0:t)
7 -> do
let x1 = xs !! 0
let tx = drop 3 xs
let ty = drop 2 ys
t <- unsafeInterleaveIO (addition (fl (x1:1:tx)) (1:(fl ty)))
return (1:t)
8 -> do
let x1 = xs !! 0
let y2 = ys !! 1
let tx = drop 3 xs
let ty = drop 3 ys
t <- unsafeInterleaveIO (addition (fl (x1:fl tx)) (fl (y2:fl ty)))
return (0:1:t)
9 -> do
let x1 = xs !! 0
let y2 = ys !! 1
let tx = drop 3 xs
let ty = drop 3 ys
t <- unsafeInterleaveIO (addition (x1:fl tx) (fl (y2:fl ty)))
return (1:1:t)
10 -> do
let y1 = ys !! 0
let ty = drop 3 ys
let tx = drop 2 xs
t <- unsafeInterleaveIO (addition (1:fl tx) (y1:1:ty))
return (0:t)
11 -> do
let y1 = ys !! 0
let ty = drop 3 ys
let tx = drop 2 xs
t <- unsafeInterleaveIO (addition (1:fl tx) (fl (y1:1:ty)))
return (1:t)
12 -> do
let y1 = ys !! 0
let x2 = xs !! 1
let tx = drop 3 xs
let ty = drop 3 ys
t <- unsafeInterleaveIO (addition (fl (x2:fl tx)) (fl (y1:fl ty)))
return (0:1:t)
13 -> do
let y1 = ys !! 0
let x2 = xs !! 1
let tx = drop 3 xs
let ty = drop 3 ys
t <- unsafeInterleaveIO (addition (fl (x2:fl tx)) (y1:fl ty))
return (1:1:t)
-- Compute (a-b)/2
substraction :: Gray -> Gray -> IO Gray
substraction xs ys = addition xs (negateGray ys)
t1 :: MVar Int -> Stream -> Stream -> IO()
t1 m (0:as) (0:bs) = putMVar m 1
t1 m (1:as) (1:bs) = putMVar m 2
t1 m (0:as) (1:bs) = putMVar m 3
t1 m (1:as) (0:bs) = putMVar m 4
t2 :: MVar Int -> Stream -> Stream -> IO()
t2 m (a:1:x) (b:1:y) = putMVar m 5
t2 m x y = yield
t3 m (a:1:0:x) (0:0:y) = putMVar m 6
t3 m (a:1:0:x) (1:0:y) = putMVar m 7
t3 m x y = yield
t4 m (a:1:0:x) (0:b:1:y) = putMVar m 8
t4 m (a:1:0:x) (1:b:1:y) = putMVar m 9
t4 m x y = yield
t5 m (0:0:x) (b:1:0:y) = putMVar m 10
t5 m (1:0:x) (b:1:0:y) = putMVar m 11
t5 m x y = yield
t6 m (0:a:1:x) (b:1:0:y) = putMVar m 12
t6 m (1:a:1:x) (b:1:0:y) = putMVar m 13
t6 m x y = yield
multiplyIO :: Gray -> Gray -> IO Gray
multiplyIO xs ys = do
s1 <- unsafeInterleaveIO (grayToSignIO xs)
s2 <- unsafeInterleaveIO (grayToSignIO ys)
let s = Trit.multiply s1 s2
let g = signToGray s
return g
start :: IO()
start = do
c <- unsafeInterleaveIO(multiplyIO z1 z1)
putStrLn (show c)
startA :: IO()
startA = do
c <- unsafeInterleaveIO(addition (1:1:z0) (1:1:z0))
putStrLn (show (take 30 c))
z0 = (0:z0)
z1 = (1:z1)
zl = 0:loop:z0
loop = loop
loop01 = 0:1:loop01
|
