content: 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
  
  
  
  -- Subtraction 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
  