scavenge_one: strange object 47
ug93tad at cs.bham.ac.uk
ug93tad at cs.bham.ac.uk
Tue Aug 30 12:11:32 EDT 2005
Hi, i hope this is a bug.
Please look at the file Mult.hs
and function: startM1 (17-20)
run this function for different inputs (orignially, multiply (1%7) with
(0%2)) try to run with : (1%3) and (0%1)
(2%3) and (0%1)
(1%2) and (0%1)
(1%5) and (0%1)
Best regards
TuanAnh
-------------- next part --------------
module Mutiply where
import Arithmetic
import Trit
import Stream
import Converter
import Control.Concurrent
import Control.Concurrent.MVar
import System.IO.Unsafe
import Data.Ratio
import Utilities
import Thread
startM1 :: IO()
startM1 = do
c <- unsafeInterleaveIO (mult (rationalToGray (1%7)) (rationalToGray (0%2)))
putStrLn (show (drop 1 c))
mult :: Gray -> Gray -> IO Gray
mult xs ys = do
c <- threadTesting1 xs ys
case c of
101 -> do
--putStrLn ("In case 101")
let tx = drop 2 xs
let ty = drop 2 ys
t1 <- unsafeInterleaveIO (addition tx ty)
t2 <- unsafeInterleaveIO (addition (fl t1) (1:t1))
t3 <- unsafeInterleaveIO (mult tx ty)
c' <- unsafeInterleaveIO (addition t2 (1:0:0:(fl t3)))
return c'
102 -> do
--putStrLn ("In case 102")
let tx = drop 2 xs
let ty = drop 2 ys
t1 <- unsafeInterleaveIO (addition (fl tx) ty)
t2 <- unsafeInterleaveIO (addition tx ty)
t0 <- unsafeInterleaveIO (addition t1 (1:fl t2))
t3 <- unsafeInterleaveIO (mult tx ty)
c' <- unsafeInterleaveIO (addition t0 (1:1:0:fl t3))
return c'
103 -> do
--putStrLn ("In case 103")
let tx = drop 2 xs
let ty = drop 2 ys
t <- unsafeInterleaveIO (mult (0:0:tx) (0:0:ty))
return (fl t)
104 -> do
--putStrLn ("In case 104")
let tx = drop 2 xs
let ty = drop 2 ys
t <- unsafeInterleaveIO (mult (0:0:tx) (0:1:ty))
return (fl t)
201 -> do
c' <- unsafeInterleaveIO (mult ys xs)
return c'
202 -> do
--putStrLn ("In case 202")
let tx = drop 2 xs
let ty = drop 2 ys
t1 <- unsafeInterleaveIO (addition tx ty)
t2 <- unsafeInterleaveIO (addition t1 (0:fl t1))
t3 <- unsafeInterleaveIO (mult tx ty)
c' <- unsafeInterleaveIO (addition t2 (1:1:1:fl t3))
return c'
203 -> do
--putStrLn ("In case 203")
let tx = drop 2 xs
let ty = drop 2 ys
t <- unsafeInterleaveIO (mult (0:1:tx) (0:0:ty))
return (fl t)
204 -> do
--putStrLn ("In case 204")
let tx = drop 2 xs
let ty = drop 2 ys
t <- unsafeInterleaveIO (mult (0:1:tx) (0:1:ty))
return (fl t)
30 -> do
--putStrLn ("In case 30")
let y1 = ys !! 0
let tx = drop 2 xs
let ty = drop 3 ys
t1 <- unsafeInterleaveIO (addition ((f0' y1):1:ty) ((f0' y1):1:0:ty))
t0 <- unsafeInterleaveIO (mult tx (y1: fl ty))
let c4 = head t0
let d4 = fl (tail t0)
c' <- unsafeInterleaveIO (addition t1 (c4:1:0:0:d4))
return c'
31 -> do
--putStrLn ("In case 31")
let tx = drop 2 xs
c' <- unsafeInterleaveIO (mult (0:0:tx) ys)
return (fl c')
40 -> do
--putStrLn ("In case 40")
let tx = drop 2 xs
let y2 = ys !! 1
let ty = drop 3 ys
t1 <- unsafeInterleaveIO (addition (y2:fl ty) tx)
t2 <- unsafeInterleaveIO (addition (fl t1) (1:y2:1:ty))
t0 <- unsafeInterleaveIO (mult tx (y2:fl ty))
let c2 = f0' (head t0)
let d2 = fl (tail t0)
c' <- unsafeInterleaveIO (addition t2 (1:c2:1:0:d2))
return c'
41 -> do
--putStrLn ("In case 41")
let tx = drop 2 xs
let y2 = ys !! 1
let ty = drop 3 ys
c' <- unsafeInterleaveIO (mult (0:0:tx) (0:y2:1:ty))
return (fl c')
50 -> do
--putStrLn ("In case 50")
let tx = drop 2 xs
let y2 = ys !! 1
let ty = drop 3 ys
t1 <- unsafeInterleaveIO (addition tx (fl (y2:fl ty)))
t2 <- unsafeInterleaveIO (addition t1 (0:y2:1:ty))
t0 <- unsafeInterleaveIO (mult (fl tx) (y2:fl ty))
let c1 = f0' (head t0)
let d1 = fl (tail t0)
c' <- unsafeInterleaveIO (addition t2 (1:c1:1:0:d1))
return c'
51 -> do
--putStrLn ("In case 51")
let tx = drop 2 xs
let y2 = ys !! 1
let ty = drop 3 ys
c' <- unsafeInterleaveIO (mult (0:1:tx) (0:y2:1:ty))
return (fl c')
60 -> do
--putStrLn ("In case 60")
let tx = drop 2 xs
let y1 = ys !! 0
let ty = drop 3 ys
t1 <- unsafeInterleaveIO (addition ((f0' y1):1:ty) (y1:1:0:ty))
t0 <- unsafeInterleaveIO (mult (fl tx) (y1:fl ty))
let c1 = head t0
let d1 = fl (tail t0)
c' <- unsafeInterleaveIO (addition t1 (c1:1:0:0:d1))
return c'
61 -> do
--putStrLn ("In case 61")
let tx = drop 2 xs
let y1 = ys !! 0
let ty = drop 3 ys
c' <- unsafeInterleaveIO (mult (0:1:tx) (y1:1:0:ty))
return (fl c')
70 -> do
--putStrLn ("In case 70")
c' <- unsafeInterleaveIO (mult ys xs)
return c'
80 -> do
--putStrLn ("In case 80")
let x2 = xs !! 1
let y2 = ys !! 1
let tx = drop 3 xs
let ty = drop 3 ys
t1 <- unsafeInterleaveIO (addition (x2:fl tx) (y2:fl ty))
t0 <- unsafeInterleaveIO (mult (x2:fl tx) (y2:fl ty))
let c1 = head (fl t1)
let d1 = tail (fl t1)
let c2 = f0' (head t0)
let d2 = fl (tail t0)
c' <- unsafeInterleaveIO (addition (c1:1:(fl d1)) (1:c2:1:0:d2))
return c'
81 -> do
--putStrLn ("In case 81")
let x2 = xs !! 1
let y2 = ys !! 1
let tx = drop 3 xs
let ty = drop 3 ys
c' <- unsafeInterleaveIO (mult (0:x2:1:tx) (0:y2:1:ty))
return (fl c')
90 -> do
--putStrLn ("In case 90")
let x2 = xs!!1
let y1 = ys!!0
let tx = drop 3 xs
let ty = drop 3 ys
t0 <- unsafeInterleaveIO (mult (x2:fl tx) (y1:fl ty))
let c1 = head t0
let d1 = fl (tail t0)
c' <- unsafeInterleaveIO (addition ((f0' y1):1:0:ty) (c1:1:0:0:d1))
return c'
91 -> do
--putStrLn ("In case 91")
let x2 = xs!!1
let y1 = ys!!0
let tx = drop 3 xs
let ty = drop 3 ys
c' <- unsafeInterleaveIO (mult (0:x2:1:tx) (y1:1:0:ty))
return (fl c')
100 -> do
--putStrLn ("In case 100")
let x1 = head xs
let y1 = head ys
let tx = drop 3 xs
let ty = drop 3 ys
t0 <- unsafeInterleaveIO (mult (x1:fl tx) (y1:fl ty))
let c4 = head t0
let d4 = fl (tail t0)
return (c4:1:0:0:0:d4)
f0' 0 = 1
f0' 1 = 0
-------------- next part --------------
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
-------------- next part --------------
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')
-------------- next part --------------
module Stream (Stream, carry, addStream, rationalToStream,
streamToFloat, addFiniteStream, negate', average) where
import Data.Ratio
type Digit = Integer
type Stream = [Integer]
-- Convert from a Rational fraction to its stream representation
rationalToStream :: Rational -> Stream
rationalToStream x
|t<1 = 0:rationalToStream t
|otherwise = 1:rationalToStream (t-1)
where t = 2*x
-- Convert from a stream to the Float value
streamToFloat :: Stream -> Float
streamToFloat x = f x (1)
f :: Stream -> Integer -> Float
f [] n = 0
f (y:ys) n = (fromIntegral)y/(fromIntegral(2^n)) + f ys (n+1)
-- Add two stream
addStream :: Stream -> Stream -> Stream
addStream (x1:x2:x3:xs) (y1:y2:y3:ys) = (u+c):(addStream (x2:x3:xs) (y2:y3:ys))
where u = interim x1 x2 y1 y2
c = carry x2 x3 y2 y3
-- Compute carry, the C(i) value, given x(i) and y(i)
carry :: Digit -> Digit -> Digit -> Digit -> Digit
carry x1 x2 y1 y2
|t>1 = 1
|t<(-1) = -1
|t==1 && (minus1 x2 y2) = 0
|t==1 && not (minus1 x2 y2) = 1
|t==(-1) && (minus1 x2 y2) = -1
|t==(-1) && not (minus1 x2 y2) = 0
|t==0 = 0
where t = x1+y1
-- Computer the interim sum, the U(i) value, given x(i), y(i) and c(i)
interim :: Digit -> Digit -> Digit -> Digit -> Digit
interim x1 x2 y1 y2
|t>1 = 0
|t<(-1) = 0
|t==1 && (minus1 x2 y2) = 1
|t==1 && not (minus1 x2 y2) = -1
|t==(-1) && (minus1 x2 y2) = 1
|t==(-1) && not (minus1 x2 y2) = -1
|t==0 = 0
where t = x1+y1
-- Check if at least one of 2 digits is -1
minus1 :: Digit -> Digit -> Bool
minus1 x y = (x==(-1))|| (y==(-1))
-- Algin two stream so that they have the same length
align :: Stream -> Stream -> (Stream, Stream)
align xs ys
|x>y = (xs, (copy 0 (x-y)) ++ys)
|otherwise = ((copy 0 (y-x)) ++ xs, ys)
where x = toInteger(length xs)
y = toInteger(length ys)
-- Generate a list of x
copy :: Integer -> Integer -> [Integer]
copy x n = [x| i<- [1..n]]
-- Add two finite stream (to add the integral part)
addFiniteStream :: Stream -> Stream -> Stream
addFiniteStream xs ys = add' u v
where (u,v) = align xs ys
-- Utility function for addFinitieStream
add' :: Stream -> Stream -> Stream
add' u v = normalise (f u v)
where f [] [] = []
f (x:xs) (y:ys) = (x+y):f xs ys
-- Normalise the sum
normalise :: Stream -> Stream
normalise = foldr f [0]
where f x (y:ys) = (u:v:ys)
where u = (x+y) `div` 2
v = (x+y) `mod` 2
-- Negate a stream
negate' :: Stream -> Stream
negate' = map (*(-1))
-- Compute average of two stream
-- Using [-2,-1,0,1,2] to add, and then divide by 2
average :: Stream -> Stream -> Stream
average xs ys = div2 (add xs ys)
-- Addition of two streams, using [-2,-1,0,1,2]
add :: Stream -> Stream -> Stream
add (x:xs) (y:ys) = (x+y):(add xs ys)
-- Then divided by 2, [-2,-1,0,1,2] -> [-1,0,1]
div2 :: Stream -> Stream
div2 (2:xs) = 1:div2 xs
div2 ((-2):xs) = (-1):div2 xs
div2 (0:xs) = 0:div2 xs
div2 (1:(-2):xs) = div2 (0:0:xs)
div2 (1:(-1):xs) = div2 (0:1:xs)
div2 (1:0:xs) = div2 (0:2:xs)
div2 (1:1:xs) = div2 (2:(-1):xs)
div2 (1:2:xs) = div2 (2:0:xs)
div2 ((-1):(-2):xs) = div2 ((-2):0:xs)
div2 ((-1):(-1):xs) = div2 ((-2):1:xs)
div2 ((-1):0:xs) = div2 (0:(-2):xs)
div2 ((-1):1:xs) = div2 (0:(-1):xs)
div2 ((-1):2:xs) = div2 (0:0:xs)
test = take 100 (average (rationalToStream (1%2)) (rationalToStream (1%3)))
-------------- next part --------------
module Thread (threadTesting1) where
import Control.Concurrent
import Control.Concurrent.MVar
import Stream
import Converter
threadTesting1 :: Gray -> Gray -> IO Int
threadTesting1 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)
c7 <- forkIO (t7 m xs ys)
c8 <- forkIO (t8 m xs ys)
c9 <- forkIO (t9 m xs ys)
c <- takeMVar m
killThread c1
killThread c2
killThread c3
killThread c4
killThread c5
killThread c6
killThread c7
killThread c8
killThread c9
return c
t1 :: MVar Int -> Stream -> Stream -> IO()
t1 m (0:0:x) (0:0:y) = putMVar m 101
t1 m (0:0:x) (0:1:y) = putMVar m 102
t1 m (0:0:x) (1:0:y) = putMVar m 103
t1 m (0:0:x) (1:1:y) = putMVar m 104
t1 m (0:1:x) (0:0:y) = putMVar m 201
t1 m (0:1:x) (0:1:y) = putMVar m 202
t1 m (0:1:x) (1:0:y) = putMVar m 203
t1 m (0:1:x) (1:1:y) = putMVar m 204
t1 m (1:0:x) (0:0:y) = putMVar m 103
t1 m (1:0:x) (0:1:y) = putMVar m 104
t1 m (1:0:x) (1:0:y) = putMVar m 101
t1 m (1:0:x) (1:1:y) = putMVar m 102
t1 m (1:1:x) (0:0:y) = putMVar m 203
t1 m (1:1:x) (0:1:y) = putMVar m 204
t1 m (1:1:x) (1:0:y) = putMVar m 201
t1 m (1:1:x) (1:1:y) = putMVar m 202
t2 :: MVar Int -> Stream -> Stream -> IO()
t2 m (0:0:x) (b:1:0:y) = putMVar m 30
t2 m (1:0:x) (b:1:0:y) = putMVar m 31
t2 m (0:1:x) (b:1:0:y) = putMVar m 60
t2 m (1:1:x) (b:1:0:y) = putMVar m 61
t2 m x y = yield
t3 m (0:0:x) (0:b:1:y) = putMVar m 40
t3 m (1:0:x) (1:b:1:y) = putMVar m 40
t3 m (0:0:x) (1:b:1:y) = putMVar m 41
t3 m (1:0:x) (0:b:1:y) = putMVar m 41
t3 m (0:1:x) (0:b:1:y) = putMVar m 50
t3 m (1:1:x) (1:b:1:y) = putMVar m 50
t3 m (0:1:x) (1:b:1:y) = putMVar m 51
t3 m (1:1:x) (0:b:1:y) = putMVar m 51
t3 m x y = yield
t4 m (0:a:1:y) (0:0:x) = putMVar m 70
t4 m (1:a:1:y) (1:0:x) = putMVar m 70
t4 m (1:a:1:y) (0:0:x) = putMVar m 70
t4 m (0:a:1:y) (1:0:x) = putMVar m 70
t4 m (0:a:1:y) (0:1:x) = putMVar m 70
t4 m (1:a:1:y) (1:1:x) = putMVar m 70
t4 m (1:a:1:y) (0:1:x) = putMVar m 70
t4 m (0:a:1:y) (1:1:x) = putMVar m 70
t4 m x y = yield
t5 m (a:1:0:y) (0:0:x) = putMVar m 70
t5 m (a:1:0:y) (1:0:x) = putMVar m 70
t5 m (a:1:0:y) (0:1:x) = putMVar m 70
t5 m (a:1:0:y) (1:1:x) = putMVar m 70
t5 m x y = yield
t6 m (0:a:1:x) (0:b:1:y) = putMVar m 80
t6 m (1:a:1:x) (1:b:1:y) = putMVar m 80
t6 m (0:a:1:x) (1:b:1:y) = putMVar m 81
t6 m (1:a:1:x) (0:b:1:y) = putMVar m 81
t6 m x y = yield
t7 m (0:a:1:x) (b:1:0:y) = putMVar m 90
t7 m (1:a:1:x) (b:1:0:y) = putMVar m 91
t7 m x y = yield
t8 m (a:1:0:x) (b:1:0:y) = putMVar m 100
t8 m x y = yield
t9 m (a:1:0:x) (0:b:1:y) = putMVar m 70
t9 m (a:1:0:x) (1:b:1:y) = putMVar m 70
t9 m x y = yield
-------------- next part --------------
module Trit (Trit, rationalToTrit, getIntegral, getFraction, getFraction',
neg, addTrits, subTrits, shiftLeft, shiftRight, multiply
) where
import Stream
import Utilities
import Data.Ratio
type Mantissa = Stream
type Fraction = Stream
type Trit = (Mantissa, Fraction)
-- Convert from a Rational number to its Trit representation (Integral, Fraction)
rationalToTrit :: Rational -> Trit
rationalToTrit x
|x<1 = ([0], rationalToStream x)
|otherwise = (u', rationalToStream v)
where u = n `div` d
u' = toBinary u
v = x - (toRational u)
n = numerator x
d = denominator x
-- Get the integral part of Trit
getIntegral :: Trit -> Mantissa
getIntegral = fst
-- Get the fraction part of Trit, with n digit of the stream
getFraction :: Int -> Trit -> Stream
getFraction n = take n. snd
-- Get the fraction part of Trit
getFraction' :: Trit -> Stream
getFraction' = snd
-- Negate a Trit
neg :: Trit -> Trit
neg (a, b) = (negate' a, negate' b)
-- Add two Trits
addTrits :: Trit -> Trit -> Trit
addTrits (m1, (x1:x2:xs)) (m2, (y1:y2:ys)) = (u,addStream (x1:x2:xs) (y1:y2:ys))
where u' = addFiniteStream m1 m2
c = [carry x1 x2 y1 y2]
u = addFiniteStream u' c
-- Substraction of 2 Trits
subTrits :: Trit -> Trit -> Trit
subTrits x y = addTrits x (neg y)
-- Shift left = *2 opertaion with Trit
shiftLeft :: Trit -> Trit
shiftLeft (x, (y:ys)) = (x++ [y], ys)
-- Shift right = /2 operation with Trit
shiftRight :: Trit -> Integer -> Trit
shiftRight (x, xs) 1 = (init x, (u:xs))
where u = last x
shiftRight (x, xs) (n+1) = shiftRight (init x, (u:xs)) n
where u = last x
-- Multiply a Trit stream by 1,0 or -1, simply return the stream
mulOneDigit :: Integer -> Stream -> Stream
mulOneDigit x xs
|x==1 = xs
|x==0 = zero'
|otherwise = negate' xs
where zero' = (0:zero')
-- Multiplication of two streams
multiply :: Stream -> Stream -> Stream
multiply (a0:a1:x) (b0:b1:y) = average p q
where p = average (a1*b0: (average (mulOneDigit b1 x)
(mulOneDigit a1 y)))
(average (mulOneDigit b0 x)
(mulOneDigit a0 y))
q = (a0*b0:a0*b1:a1*b1:(multiply x y))
start0 = take 30 (multiply (rationalToStream (1%2)) zo)
zo :: Stream
zo = 1:(-1):zero
where zero = 0:zero
start1 = take 30 (average (rationalToStream (1%2)) (negate' (rationalToStream (1%4))))
-------------- next part --------------
module Utilities (toBinary, fl) where
import Stream
import Data.Ratio
-- Convert from an Integer to its signed-digit representation
toBinary :: Integer -> Stream
toBinary 0 = [0]
toBinary x = toBinary t ++ [x `mod` 2]
where t = x `div` 2
fl :: Stream -> Stream
fl (x:xs) = (f x):xs
where f 0 = 1
f 1 = 0
More information about the Glasgow-haskell-bugs
mailing list