diff options
Diffstat (limited to 'testsuite/tests/concurrent/prog001/Arithmetic.hs')
| -rw-r--r-- | testsuite/tests/concurrent/prog001/Arithmetic.hs | 235 |
1 files changed, 235 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/prog001/Arithmetic.hs b/testsuite/tests/concurrent/prog001/Arithmetic.hs new file mode 100644 index 0000000000..c1c18c549b --- /dev/null +++ b/testsuite/tests/concurrent/prog001/Arithmetic.hs @@ -0,0 +1,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 |