diff options
| author | Thomas Miedema <thomasmiedema@gmail.com> | 2016-06-18 22:44:19 +0200 |
|---|---|---|
| committer | Thomas Miedema <thomasmiedema@gmail.com> | 2016-06-20 16:22:07 +0200 |
| commit | 5b03dc69389dc387b922c589ab9a8b92079e6a96 (patch) | |
| tree | 807db4d3e26cc078cab86def2df40afcd59803db /testsuite/tests | |
| parent | 915e07c33b143126e3c8de1d2ec22ccc709a9a24 (diff) | |
| download | haskell-5b03dc69389dc387b922c589ab9a8b92079e6a96.tar.gz | |
Testsuite: tabs -> spaces [skip ci]
Diffstat (limited to 'testsuite/tests')
62 files changed, 808 insertions, 808 deletions
diff --git a/testsuite/tests/concurrent/prog001/Arithmetic.hs b/testsuite/tests/concurrent/prog001/Arithmetic.hs index c1c18c549b..a1253969b0 100644 --- a/testsuite/tests/concurrent/prog001/Arithmetic.hs +++ b/testsuite/tests/concurrent/prog001/Arithmetic.hs @@ -41,114 +41,114 @@ 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 + 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) + 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) @@ -180,51 +180,51 @@ 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 - - +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 + 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) + 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)) + c <- unsafeInterleaveIO(addition (1:1:z0) (1:1:z0)) + putStrLn (show (take 30 c)) z0 = (0:z0) z1 = (1:z1) diff --git a/testsuite/tests/concurrent/prog001/Converter.hs b/testsuite/tests/concurrent/prog001/Converter.hs index d3dfe2a34f..cba86e0cfd 100644 --- a/testsuite/tests/concurrent/prog001/Converter.hs +++ b/testsuite/tests/concurrent/prog001/Converter.hs @@ -15,92 +15,92 @@ 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) - - + |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 +-- 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) - + |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) - + |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) - + |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) - - - + |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 +-- Behave exactly the same like above rationalToGray' :: Rational -> Gray rationalToGray' x - |x<0 = signToGray (negate' (rationalToStream (-x))) - |otherwise = signToGray (rationalToStream 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 +-- 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 - +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 +-- 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)) + 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)) + return (0:co)) -- Flip the first bit of an infinite stream f' (x:xs) = (f'' x):xs - where f'' 1 = 0 - f'' 0 = 1 + 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() + 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 @@ -108,9 +108,9 @@ f1 m (1:xs) = putMVar m 1 -- 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 +f2 m (c1:c2:xs) + |c2==1 = putMVar m 3 + |otherwise = yield @@ -118,8 +118,8 @@ f2 m (c1:c2:xs) -- Testing startC :: IO() startC = do - c<- unsafeInterleaveIO (grayToSignIO (1:1:z0)) - putStrLn (show (take 100 c)) + c<- unsafeInterleaveIO (grayToSignIO (1:1:z0)) + putStrLn (show (take 100 c)) startF = signToGray ((-1):1:z0) diff --git a/testsuite/tests/concurrent/prog001/Mult.hs b/testsuite/tests/concurrent/prog001/Mult.hs index e387244f68..8ea719ca23 100644 --- a/testsuite/tests/concurrent/prog001/Mult.hs +++ b/testsuite/tests/concurrent/prog001/Mult.hs @@ -9,229 +9,229 @@ import Data.Ratio import Utilities import Thread -main = startM1 +main = startM1 startM1 :: IO() startM1 = do - c <- unsafeInterleaveIO (mult (rationalToGray (1%3)) (rationalToGray (0%1))) - putStrLn (show (take 100 (drop 1 c))) + c <- unsafeInterleaveIO (mult (rationalToGray (1%3)) (rationalToGray (0%1))) + putStrLn (show (take 100 (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) - - - + 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 - +f0' 1 = 0 + diff --git a/testsuite/tests/concurrent/prog001/Stream.hs b/testsuite/tests/concurrent/prog001/Stream.hs index 349af32962..ad80b1159a 100644 --- a/testsuite/tests/concurrent/prog001/Stream.hs +++ b/testsuite/tests/concurrent/prog001/Stream.hs @@ -1,5 +1,5 @@ -module Stream (Stream, carry, addStream, rationalToStream, - streamToFloat, addFiniteStream, negate', average) where +module Stream (Stream, carry, addStream, rationalToStream, + streamToFloat, addFiniteStream, negate', average) where import Data.Ratio @@ -12,58 +12,58 @@ 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 - - + |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) +f (y:ys) n = (fromIntegral)y/(fromIntegral(2^n)) + f ys (n+1) --- Add two stream +-- 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 - - - + 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 - - - +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 + |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 @@ -78,14 +78,14 @@ 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) - - - +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]] @@ -99,23 +99,23 @@ 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 + 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 + where u = (x+y) `div` 2 + v = (x+y) `mod` 2 -- Negate a stream @@ -137,20 +137,20 @@ 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) - - +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))) diff --git a/testsuite/tests/concurrent/prog001/Thread.hs b/testsuite/tests/concurrent/prog001/Thread.hs index 62bb7dd3c3..12886a8456 100644 --- a/testsuite/tests/concurrent/prog001/Thread.hs +++ b/testsuite/tests/concurrent/prog001/Thread.hs @@ -8,27 +8,27 @@ 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 + 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 @@ -59,10 +59,10 @@ 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 (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 diff --git a/testsuite/tests/concurrent/prog001/Trit.hs b/testsuite/tests/concurrent/prog001/Trit.hs index bb6d03c9e2..b67d695984 100644 --- a/testsuite/tests/concurrent/prog001/Trit.hs +++ b/testsuite/tests/concurrent/prog001/Trit.hs @@ -1,6 +1,6 @@ module Trit (Trit, rationalToTrit, getIntegral, getFraction, getFraction', - neg, addTrits, subTrits, shiftLeft, shiftRight, multiply - ) where + neg, addTrits, subTrits, shiftLeft, shiftRight, multiply + ) where import Stream import Utilities @@ -14,15 +14,15 @@ 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 - - + |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 @@ -49,9 +49,9 @@ 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 + where u' = addFiniteStream m1 m2 + c = [carry x1 x2 y1 y2] + u = addFiniteStream u' c @@ -69,19 +69,19 @@ 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 + where u = last x shiftRight (x, xs) n = shiftRight (init x, (u:xs)) (n-1) - where u = last x - - + 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') + |x==0 = zero' + |otherwise = negate' xs + where zero' = (0:zero') @@ -91,11 +91,11 @@ mulOneDigit x xs -- 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)) + 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)) @@ -108,5 +108,5 @@ zo = 1:(-1):zero start1 = take 30 (average (rationalToStream (1%2)) (negate' (rationalToStream (1%4)))) - - + + diff --git a/testsuite/tests/concurrent/prog001/Utilities.hs b/testsuite/tests/concurrent/prog001/Utilities.hs index 9e8a39187d..0ebdb3db9c 100644 --- a/testsuite/tests/concurrent/prog001/Utilities.hs +++ b/testsuite/tests/concurrent/prog001/Utilities.hs @@ -7,11 +7,11 @@ import Data.Ratio toBinary :: Integer -> Stream toBinary 0 = [0] toBinary x = toBinary t ++ [x `mod` 2] - where t = x `div` 2 - + where t = x `div` 2 + fl :: Stream -> Stream fl (x:xs) = (f x):xs - where f 0 = 1 - f 1 = 0 + where f 0 = 1 + f 1 = 0 diff --git a/testsuite/tests/concurrent/prog002/Scheduler.hs b/testsuite/tests/concurrent/prog002/Scheduler.hs index bbfd374c43..0b9cf5bdd8 100644 --- a/testsuite/tests/concurrent/prog002/Scheduler.hs +++ b/testsuite/tests/concurrent/prog002/Scheduler.hs @@ -1,10 +1,10 @@ -module Scheduler +module Scheduler ( runTIO , module Event , module Thread , TTree , TIO -) +) where import Event @@ -18,14 +18,14 @@ type TIO = ContM SysReq SysRsp IO runTIO :: [TIO ()] -> IO () -runTIO l = runThreads $ map buildThread l +runTIO l = runThreads $ map buildThread l -data World = World +data World = World { mReadyQ :: ! (Chan (TTree)) } max_steps = 1 -worker_pure world= - do +worker_pure world= + do t <- readChan readyq case t of (Atom _) -> return () @@ -38,26 +38,26 @@ worker_pure world= exec_thread 0 t = do putStr "."; hFlush stdout writeChan readyq t - exec_thread c (Atom mx) = - do + exec_thread c (Atom mx) = + do x <- mx exec_thread (c-1) x exec_thread c (Stop) = return () - + runThreads :: [TTree] -> IO () runThreads l = - do + do mready <- newChan writeList2Chan mready l - let world = World mready + let world = World mready multiloop world loop_p world = do worker_pure world; loop_p world -multiloop world = - do - -- a mixture of bound threads & lightweight threads - -- to make things interesting... +multiloop world = + do + -- a mixture of bound threads & lightweight threads + -- to make things interesting... forkOS (loop_p world) forkOS (loop_p world) forkOS (loop_p world) diff --git a/testsuite/tests/concurrent/prog002/Server.hs b/testsuite/tests/concurrent/prog002/Server.hs index 2ff1ccb8c8..ce338b7543 100644 --- a/testsuite/tests/concurrent/prog002/Server.hs +++ b/testsuite/tests/concurrent/prog002/Server.hs @@ -6,13 +6,13 @@ import Control.Concurrent expensive = f (500 :: Int) where f 0 = stop - f n = do + f n = do r <- atom $ getStdRandom (randomR (0,99::Int)) r `seq` f $! n-1 main = do m <- newEmptyMVar - forkIO (do - runTIO $ map (\x->expensive) [1..500] - putMVar m ()) + forkIO (do + runTIO $ map (\x->expensive) [1..500] + putMVar m ()) takeMVar m diff --git a/testsuite/tests/concurrent/should_run/T5421.hs b/testsuite/tests/concurrent/should_run/T5421.hs index 863820ba4a..2c143013dd 100644 --- a/testsuite/tests/concurrent/should_run/T5421.hs +++ b/testsuite/tests/concurrent/should_run/T5421.hs @@ -2,16 +2,16 @@ import Control.Concurrent import Control.Monad.Fix data Client = Client - { clientLock :: MVar () - } + { clientLock :: MVar () + } main = do - mvar <- newMVar () - - client <- mfix $ \client -> do - _ <- forkIO (mainLoop client) + mvar <- newMVar () + + client <- mfix $ \client -> do + _ <- forkIO (mainLoop client) threadDelay 200000 - return (Client mvar) - return () + return (Client mvar) + return () mainLoop client = withMVar (clientLock client) (\_ -> return ()) diff --git a/testsuite/tests/concurrent/should_run/conc001.hs b/testsuite/tests/concurrent/should_run/conc001.hs index 99488fb07b..b88081f2a6 100644 --- a/testsuite/tests/concurrent/should_run/conc001.hs +++ b/testsuite/tests/concurrent/should_run/conc001.hs @@ -6,9 +6,9 @@ import Control.Concurrent main = do s <- newEmptyMVar - let + let write = do - putMVar s "hello world\n" + putMVar s "hello world\n" forkIO write str <- takeMVar s diff --git a/testsuite/tests/concurrent/should_run/conc002.hs b/testsuite/tests/concurrent/should_run/conc002.hs index 93efd6fe4c..ab2ed50b85 100644 --- a/testsuite/tests/concurrent/should_run/conc002.hs +++ b/testsuite/tests/concurrent/should_run/conc002.hs @@ -7,8 +7,8 @@ main = do let writer = writeList2Chan c "Hello World\n" forkIO writer let reader = do char <- readChan c - if (char == '\n') - then return () - else do putChar char; reader + if (char == '\n') + then return () + else do putChar char; reader reader diff --git a/testsuite/tests/concurrent/should_run/conc003.hs b/testsuite/tests/concurrent/should_run/conc003.hs index c7b1f9a56c..253d44dfc8 100644 --- a/testsuite/tests/concurrent/should_run/conc003.hs +++ b/testsuite/tests/concurrent/should_run/conc003.hs @@ -2,27 +2,27 @@ module Main where import Control.Concurrent --- simple handshaking using two MVars, +-- simple handshaking using two MVars, -- must context switch twice for each character. main = do ready <- newEmptyMVar datum <- newEmptyMVar - let + let reader = do - putMVar ready () - char <- takeMVar datum - if (char == '\n') - then return () - else do putChar char; reader + putMVar ready () + char <- takeMVar datum + if (char == '\n') + then return () + else do putChar char; reader writer "" = do - takeMVar ready - putMVar datum '\n' + takeMVar ready + putMVar datum '\n' writer (c:cs) = do - takeMVar ready - putMVar datum c - writer cs + takeMVar ready + putMVar datum c + writer cs forkIO reader writer "Hello World" diff --git a/testsuite/tests/concurrent/should_run/conc004.hs b/testsuite/tests/concurrent/should_run/conc004.hs index ec46c4ba73..4e6367c001 100644 --- a/testsuite/tests/concurrent/should_run/conc004.hs +++ b/testsuite/tests/concurrent/should_run/conc004.hs @@ -9,10 +9,10 @@ main :: IO () main = do mvar <- newEmptyMVar - let - spawner :: (IO () -> IO ThreadId) -> Int -> IO () - spawner c 0 = putMVar mvar () - spawner c n = do { c (spawner c (n-1)); return ()} + let + spawner :: (IO () -> IO ThreadId) -> Int -> IO () + spawner c 0 = putMVar mvar () + spawner c n = do { c (spawner c (n-1)); return ()} spawner forkIO 100000 takeMVar mvar diff --git a/testsuite/tests/concurrent/should_run/conc006.hs b/testsuite/tests/concurrent/should_run/conc006.hs index 4a77b5fc95..fba99f5504 100644 --- a/testsuite/tests/concurrent/should_run/conc006.hs +++ b/testsuite/tests/concurrent/should_run/conc006.hs @@ -3,7 +3,7 @@ module Main where import Control.Concurrent -- This test hopefully exercises the black hole code. The main thread --- forks off another thread and starts on a large computation. +-- forks off another thread and starts on a large computation. -- The child thread attempts to get the result of the same large -- computation (and should get blocked doing so, because the parent -- won't have evaluated it yet). When the result is available, the @@ -13,11 +13,11 @@ test = sum [1..10000] main = do x <- newEmptyMVar - forkIO (if test > 0 - then putMVar x test - else error "proc" + forkIO (if test > 0 + then putMVar x test + else error "proc" ) - if test > 0 -- evaluate test - then do result <- takeMVar x - print result - else error "main" + if test > 0 -- evaluate test + then do result <- takeMVar x + print result + else error "main" diff --git a/testsuite/tests/concurrent/should_run/conc010.hs b/testsuite/tests/concurrent/should_run/conc010.hs index 52acb97a35..21ced56f5a 100644 --- a/testsuite/tests/concurrent/should_run/conc010.hs +++ b/testsuite/tests/concurrent/should_run/conc010.hs @@ -17,12 +17,12 @@ import Control.Exception -- thread could exit before the second thread has time to print -- the result. -main = do +main = do block <- newEmptyMVar ready <- newEmptyMVar ready2 <- newEmptyMVar - id <- forkIO (Control.Exception.catch (putMVar ready () >> takeMVar block) - (\e -> putStr (show (e::SomeException)) >> putMVar ready2 ())) + id <- forkIO (Control.Exception.catch (putMVar ready () >> takeMVar block) + (\e -> putStr (show (e::SomeException)) >> putMVar ready2 ())) takeMVar ready throwTo id (ErrorCall "hello") takeMVar ready2 diff --git a/testsuite/tests/concurrent/should_run/conc012.hs b/testsuite/tests/concurrent/should_run/conc012.hs index 753fa894b6..9a94351ed6 100644 --- a/testsuite/tests/concurrent/should_run/conc012.hs +++ b/testsuite/tests/concurrent/should_run/conc012.hs @@ -16,8 +16,8 @@ main = do let x = stackoverflow 1 result <- newEmptyMVar forkIO $ Control.Exception.catch (evaluate x >> putMVar result Finished) $ - \e -> putMVar result (Died e) + \e -> putMVar result (Died e) res <- takeMVar result case res of - Died e -> putStr ("Died: " ++ show e ++ "\n") - Finished -> putStr "Ok.\n" + Died e -> putStr ("Died: " ++ show e ++ "\n") + Finished -> putStr "Ok.\n" diff --git a/testsuite/tests/concurrent/should_run/conc014.hs b/testsuite/tests/concurrent/should_run/conc014.hs index 717167482d..8078f9907c 100644 --- a/testsuite/tests/concurrent/should_run/conc014.hs +++ b/testsuite/tests/concurrent/should_run/conc014.hs @@ -9,8 +9,8 @@ main = do m <- newEmptyMVar forkIO (do { takeMVar m; throwTo main_thread (ErrorCall "foo") }) (do { throwIO (ErrorCall "wibble") - `Control.Exception.catch` - (\e -> let _ = e::ErrorCall in + `Control.Exception.catch` + (\e -> let _ = e::ErrorCall in do putMVar m (); evaluate (sum [1..10000]); putStrLn "done.") ; myDelay 500000 }) `Control.Exception.catch` diff --git a/testsuite/tests/concurrent/should_run/conc015.hs b/testsuite/tests/concurrent/should_run/conc015.hs index 635668888c..e7215097ca 100644 --- a/testsuite/tests/concurrent/should_run/conc015.hs +++ b/testsuite/tests/concurrent/should_run/conc015.hs @@ -16,17 +16,17 @@ main = do m <- newEmptyMVar m2 <- newEmptyMVar forkIO (do takeMVar m - throwTo main_thread (ErrorCall "foo") - throwTo main_thread (ErrorCall "bar") - putMVar m2 () - ) + throwTo main_thread (ErrorCall "foo") + throwTo main_thread (ErrorCall "bar") + putMVar m2 () + ) ( do mask $ \restore -> do - putMVar m () + putMVar m () print =<< getMaskingState -- True - sum [1..1] `seq` -- give 'foo' a chance to be raised + sum [1..1] `seq` -- give 'foo' a chance to be raised (restore $ myDelay 500000) - `Control.Exception.catch` + `Control.Exception.catch` \e -> putStrLn ("caught1: " ++ show (e::SomeException)) threadDelay 10000 takeMVar m2 diff --git a/testsuite/tests/concurrent/should_run/conc015a.hs b/testsuite/tests/concurrent/should_run/conc015a.hs index cd8d9dd6c7..a6a55c12cd 100644 --- a/testsuite/tests/concurrent/should_run/conc015a.hs +++ b/testsuite/tests/concurrent/should_run/conc015a.hs @@ -19,19 +19,19 @@ main = do m <- newEmptyMVar m2 <- newEmptyMVar forkIO (do takeMVar m - throwTo main_thread (ErrorCall "foo") - throwTo main_thread (ErrorCall "bar") - putMVar m2 () - ) + throwTo main_thread (ErrorCall "foo") + throwTo main_thread (ErrorCall "bar") + putMVar m2 () + ) ( do mask $ \restore -> do - putMVar m () + putMVar m () print =<< getMaskingState - sum [1..100000] `seq` -- give 'foo' a chance to be raised - (restore (myDelay 500000) - `Control.Exception.catch` + sum [1..100000] `seq` -- give 'foo' a chance to be raised + (restore (myDelay 500000) + `Control.Exception.catch` \e -> putStrLn ("caught1: " ++ show (e::SomeException))) - + threadDelay 10000 takeMVar m2 ) diff --git a/testsuite/tests/concurrent/should_run/conc016.hs b/testsuite/tests/concurrent/should_run/conc016.hs index 639b4306b3..b9f89ac70d 100644 --- a/testsuite/tests/concurrent/should_run/conc016.hs +++ b/testsuite/tests/concurrent/should_run/conc016.hs @@ -16,9 +16,9 @@ main = do main_thread <- myThreadId m <- newEmptyMVar sub_thread <- forkIO (do - takeMVar m - throwTo main_thread (ErrorCall "foo") - ) + takeMVar m + throwTo main_thread (ErrorCall "foo") + ) mask_ $ do putMVar m () sum [1..10000] `seq` -- to be sure the other thread is now blocked diff --git a/testsuite/tests/concurrent/should_run/conc017.hs b/testsuite/tests/concurrent/should_run/conc017.hs index c1ca4e745a..69c171732e 100644 --- a/testsuite/tests/concurrent/should_run/conc017.hs +++ b/testsuite/tests/concurrent/should_run/conc017.hs @@ -9,31 +9,31 @@ main = do m1 <- newEmptyMVar m2 <- newEmptyMVar m3 <- newEmptyMVar - forkIO (do - takeMVar m1 - throwTo main_thread (ErrorCall "foo") - takeMVar m2 - throwTo main_thread (ErrorCall "bar") - putMVar m3 () - ) - (do + forkIO (do + takeMVar m1 + throwTo main_thread (ErrorCall "foo") + takeMVar m2 + throwTo main_thread (ErrorCall "bar") + putMVar m3 () + ) + (do mask $ \restore -> do - (do putMVar m1 () + (do putMVar m1 () restore ( - -- unblocked, "foo" delivered to "caught1" - myDelay 100000 - ) - ) `Control.Exception.catch` + -- unblocked, "foo" delivered to "caught1" + myDelay 100000 + ) + ) `Control.Exception.catch` \e -> putStrLn ("caught1: " ++ show (e::SomeException)) - putMVar m2 () - -- blocked here, "bar" can't be delivered - (sum [1..10000] `seq` return ()) - `Control.Exception.catch` + putMVar m2 () + -- blocked here, "bar" can't be delivered + (sum [1..10000] `seq` return ()) + `Control.Exception.catch` \e -> putStrLn ("caught2: " ++ show (e::SomeException)) -- unblocked here, "bar" delivered to "caught3" takeMVar m3 - ) - `Control.Exception.catch` + ) + `Control.Exception.catch` \e -> putStrLn ("caught3: " ++ show (e::SomeException)) -- compensate for the fact that threadDelay is non-interruptible diff --git a/testsuite/tests/concurrent/should_run/conc017a.hs b/testsuite/tests/concurrent/should_run/conc017a.hs index ad015f7413..69c171732e 100644 --- a/testsuite/tests/concurrent/should_run/conc017a.hs +++ b/testsuite/tests/concurrent/should_run/conc017a.hs @@ -9,31 +9,31 @@ main = do m1 <- newEmptyMVar m2 <- newEmptyMVar m3 <- newEmptyMVar - forkIO (do - takeMVar m1 - throwTo main_thread (ErrorCall "foo") - takeMVar m2 - throwTo main_thread (ErrorCall "bar") - putMVar m3 () - ) - (do + forkIO (do + takeMVar m1 + throwTo main_thread (ErrorCall "foo") + takeMVar m2 + throwTo main_thread (ErrorCall "bar") + putMVar m3 () + ) + (do mask $ \restore -> do - (do putMVar m1 () - restore ( - -- unblocked, "foo" delivered to "caught1" - myDelay 100000 - ) - ) `Control.Exception.catch` + (do putMVar m1 () + restore ( + -- unblocked, "foo" delivered to "caught1" + myDelay 100000 + ) + ) `Control.Exception.catch` \e -> putStrLn ("caught1: " ++ show (e::SomeException)) - putMVar m2 () - -- blocked here, "bar" can't be delivered - (sum [1..10000] `seq` return ()) - `Control.Exception.catch` + putMVar m2 () + -- blocked here, "bar" can't be delivered + (sum [1..10000] `seq` return ()) + `Control.Exception.catch` \e -> putStrLn ("caught2: " ++ show (e::SomeException)) -- unblocked here, "bar" delivered to "caught3" takeMVar m3 ) - `Control.Exception.catch` + `Control.Exception.catch` \e -> putStrLn ("caught3: " ++ show (e::SomeException)) -- compensate for the fact that threadDelay is non-interruptible diff --git a/testsuite/tests/concurrent/should_run/conc018.hs b/testsuite/tests/concurrent/should_run/conc018.hs index aa83e31738..7caf32613e 100644 --- a/testsuite/tests/concurrent/should_run/conc018.hs +++ b/testsuite/tests/concurrent/should_run/conc018.hs @@ -17,10 +17,10 @@ main = do m <- newEmptyMVar t <- forkIO $ do - Control.Exception.catch (do - m <- newMVar () - putMVar m () - ) - (\e -> putMVar m (e::SomeException)) + Control.Exception.catch (do + m <- newMVar () + putMVar m () + ) + (\e -> putMVar m (e::SomeException)) takeMVar m >>= print -- should print "thread blocked indefinitely" diff --git a/testsuite/tests/concurrent/should_run/conc019.hs b/testsuite/tests/concurrent/should_run/conc019.hs index 51b3d7563a..1ac5731479 100644 --- a/testsuite/tests/concurrent/should_run/conc019.hs +++ b/testsuite/tests/concurrent/should_run/conc019.hs @@ -8,7 +8,7 @@ import System.Mem main = do forkIO (Control.Exception.catch (do { m <- newEmptyMVar; takeMVar m }) - $ \e -> putStrLn ("caught: " ++ show (e::SomeException))) + $ \e -> putStrLn ("caught: " ++ show (e::SomeException))) threadDelay 10000 System.Mem.performGC threadDelay 10000 diff --git a/testsuite/tests/concurrent/should_run/conc022.hs b/testsuite/tests/concurrent/should_run/conc022.hs index 5d420d8af7..c692c84c1d 100644 --- a/testsuite/tests/concurrent/should_run/conc022.hs +++ b/testsuite/tests/concurrent/should_run/conc022.hs @@ -4,9 +4,9 @@ import Control.Concurrent import Control.Exception -import GHC.Exts ( fork# ) -import GHC.IO ( IO(..) ) -import GHC.Conc ( ThreadId(..) ) +import GHC.Exts ( fork# ) +import GHC.IO ( IO(..) ) +import GHC.Conc ( ThreadId(..) ) main = do m <- newEmptyMVar @@ -18,23 +18,23 @@ main = do print r timeout - :: Int -- secs - -> IO a -- action to run - -> IO a -- action to run on timeout + :: Int -- secs + -> IO a -- action to run + -> IO a -- action to run on timeout -> IO a -timeout secs action on_timeout +timeout secs action on_timeout = do threadid <- myThreadId timeout <- forkIO $ do threadDelay (secs * 1000000) throwTo threadid (ErrorCall "__timeout") ( do result <- action - killThread timeout - return result - ) + killThread timeout + return result + ) `Control.Exception.catch` \exception -> case fromException exception of - Just (ErrorCall "__timeout") -> on_timeout - _other -> do killThread timeout + Just (ErrorCall "__timeout") -> on_timeout + _other -> do killThread timeout throw exception diff --git a/testsuite/tests/concurrent/should_run/conc024.hs b/testsuite/tests/concurrent/should_run/conc024.hs index 9a82320e73..7d8662ae08 100644 --- a/testsuite/tests/concurrent/should_run/conc024.hs +++ b/testsuite/tests/concurrent/should_run/conc024.hs @@ -10,6 +10,6 @@ import System.Mem main = do id <- myThreadId forkIO (catch (do m <- newEmptyMVar; takeMVar m) - (\e -> throwTo id (e::SomeException))) + (\e -> throwTo id (e::SomeException))) catch (do yield; performGC; threadDelay 1000000) - (\e -> print (e::SomeException)) + (\e -> print (e::SomeException)) diff --git a/testsuite/tests/concurrent/should_run/conc025.hs b/testsuite/tests/concurrent/should_run/conc025.hs index 0a5fbe7c30..6086708dd7 100644 --- a/testsuite/tests/concurrent/should_run/conc025.hs +++ b/testsuite/tests/concurrent/should_run/conc025.hs @@ -7,10 +7,10 @@ import Control.Exception import Control.Concurrent.Chan main = do - chan <- newChan - ch <- dupChan chan - writeChan chan "done" - x <- readChan chan - y <- readChan ch - print ("Got "++x ++" "++y) - + chan <- newChan + ch <- dupChan chan + writeChan chan "done" + x <- readChan chan + y <- readChan ch + print ("Got "++x ++" "++y) + diff --git a/testsuite/tests/concurrent/should_run/conc031.hs b/testsuite/tests/concurrent/should_run/conc031.hs index c3347550a9..9e9c62a3cc 100644 --- a/testsuite/tests/concurrent/should_run/conc031.hs +++ b/testsuite/tests/concurrent/should_run/conc031.hs @@ -22,9 +22,9 @@ main = do -- this is just to demonstrate that it is only about the GC timing -- gcThread = forkIO $ let gc = do - putStrLn "delay" - threadDelay 100000 - putStrLn "gc" - performGC - gc - in gc + putStrLn "delay" + threadDelay 100000 + putStrLn "gc" + performGC + gc + in gc diff --git a/testsuite/tests/concurrent/should_run/conc033.hs b/testsuite/tests/concurrent/should_run/conc033.hs index 6933822e56..47c46d366f 100644 --- a/testsuite/tests/concurrent/should_run/conc033.hs +++ b/testsuite/tests/concurrent/should_run/conc033.hs @@ -6,5 +6,5 @@ main = do r <- Control.Exception.try $ do m <- newEmptyMVar takeMVar m - return () + return () print (r::Either SomeException ()) diff --git a/testsuite/tests/concurrent/should_run/conc034.hs b/testsuite/tests/concurrent/should_run/conc034.hs index 85852d6532..5c11d61a18 100644 --- a/testsuite/tests/concurrent/should_run/conc034.hs +++ b/testsuite/tests/concurrent/should_run/conc034.hs @@ -13,18 +13,18 @@ import System.IO (hFlush,stdout) main = do Foreign.newStablePtr stdout - -- HACK, because when these two threads get blocked on each other, - -- there's nothing keeping stdout alive so it will get finalized. - -- SDM 12/3/2004 + -- HACK, because when these two threads get blocked on each other, + -- there's nothing keeping stdout alive so it will get finalized. + -- SDM 12/3/2004 let a = last ([1..10000] ++ [b]) b = last ([2..10000] ++ [a]) - -- we have to be careful to ensure that the strictness analyser - -- can't see that a and b are both bottom, otherwise the - -- simplifier will go to town here, resulting in something like - -- a = a and b = a. + -- we have to be careful to ensure that the strictness analyser + -- can't see that a and b are both bottom, otherwise the + -- simplifier will go to town here, resulting in something like + -- a = a and b = a. forkIO (print a `catch` \NonTermination -> return ()) - -- we need to catch in the child thread too, because it might - -- get sent the NonTermination exception first. + -- we need to catch in the child thread too, because it might + -- get sent the NonTermination exception first. r <- Control.Exception.try (print b) print (r :: Either NonTermination ()) diff --git a/testsuite/tests/concurrent/should_run/conc035.hs b/testsuite/tests/concurrent/should_run/conc035.hs index 05e48174a4..328b0f3307 100644 --- a/testsuite/tests/concurrent/should_run/conc035.hs +++ b/testsuite/tests/concurrent/should_run/conc035.hs @@ -36,12 +36,12 @@ main = do putMVar inVar 2 threadDelay 1000 throwTo tid (E.ErrorCall "2nd") - -- the second time around, exceptions will be blocked, because - -- the trapHandler is effectively "still in the handler" from the - -- first exception. I'm not sure if this is by design or by - -- accident. Anyway, the trapHandler will at some point block - -- in takeMVar, and thereby become interruptible, at which point - -- it will receive the second exception. + -- the second time around, exceptions will be blocked, because + -- the trapHandler is effectively "still in the handler" from the + -- first exception. I'm not sure if this is by design or by + -- accident. Anyway, the trapHandler will at some point block + -- in takeMVar, and thereby become interruptible, at which point + -- it will receive the second exception. takeMVar caughtVar -- Running the GHCi way complains that tid is blocked indefinitely if -- it still exists, so kill it. diff --git a/testsuite/tests/concurrent/should_run/conc036.hs b/testsuite/tests/concurrent/should_run/conc036.hs index ead85a530d..528649ce56 100644 --- a/testsuite/tests/concurrent/should_run/conc036.hs +++ b/testsuite/tests/concurrent/should_run/conc036.hs @@ -27,9 +27,9 @@ main = do threadDelay 500000 yield -- another hack, just in case child yields right after "sleep 1" putMVar th "main" `catch` (\BlockedIndefinitelyOnMVar -> return ()) - -- tests that the other thread doing an unsafe call to - -- sleep(3) has blocked this thread. Not sure if this - -- is a useful test. + -- tests that the other thread doing an unsafe call to + -- sleep(3) has blocked this thread. Not sure if this + -- is a useful test. x <- takeMVar th putStrLn x putStrLn "\nshutting down" diff --git a/testsuite/tests/concurrent/should_run/conc038.hs b/testsuite/tests/concurrent/should_run/conc038.hs index 0cf82f3b24..e4489e1cf3 100644 --- a/testsuite/tests/concurrent/should_run/conc038.hs +++ b/testsuite/tests/concurrent/should_run/conc038.hs @@ -28,9 +28,9 @@ main = do putStrLn "newThread back again" putMVar th "1 sec later" threadDelay 500000 >> putStrLn "mainThread" - -- this will not be blocked in the threaded RTS + -- this will not be blocked in the threaded RTS forkIO $ (hFun 2) - -- neither will this + -- neither will this x <- takeMVar th putStrLn x putStrLn "\nshutting down" diff --git a/testsuite/tests/concurrent/should_run/conc039.hs b/testsuite/tests/concurrent/should_run/conc039.hs index dc493d4acc..7fd3cea134 100644 --- a/testsuite/tests/concurrent/should_run/conc039.hs +++ b/testsuite/tests/concurrent/should_run/conc039.hs @@ -22,11 +22,11 @@ main = do -- propagated back to the caller of rts_evalIO(). -- -- The sequence we hope to create is: --- - main thread (1) forks off thread (2) --- - thread (2) invokes new main thread (3) via a 'safe' ccall --- - thread (3) yields to thread (1) --- - thread (1) completes, but cannot return yet because (3) --- is the current main thread (unless we --- are in SMP or RTS_SUPPORTS_THREADS mode) --- - thread (3) invokes a GC --- - thread (1) is GC'd, unless we're careful! +-- - main thread (1) forks off thread (2) +-- - thread (2) invokes new main thread (3) via a 'safe' ccall +-- - thread (3) yields to thread (1) +-- - thread (1) completes, but cannot return yet because (3) +-- is the current main thread (unless we +-- are in SMP or RTS_SUPPORTS_THREADS mode) +-- - thread (3) invokes a GC +-- - thread (1) is GC'd, unless we're careful! diff --git a/testsuite/tests/concurrent/should_run/conc068.hs b/testsuite/tests/concurrent/should_run/conc068.hs index 60b9652ee9..ae777fa718 100644 --- a/testsuite/tests/concurrent/should_run/conc068.hs +++ b/testsuite/tests/concurrent/should_run/conc068.hs @@ -7,7 +7,7 @@ main = do main_thread <- myThreadId m <- newEmptyMVar sub_thread <- mask_ $ forkIO $ - sum [1..100000] `seq` + sum [1..100000] `seq` throwTo main_thread (ErrorCall "foo") killThread sub_thread putStrLn "oops" diff --git a/testsuite/tests/deriving/should_compile/drv005.hs b/testsuite/tests/deriving/should_compile/drv005.hs index 527dde98b9..05f9fabc74 100644 --- a/testsuite/tests/deriving/should_compile/drv005.hs +++ b/testsuite/tests/deriving/should_compile/drv005.hs @@ -3,4 +3,4 @@ module ShouldSucceed where data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 - deriving Enum + deriving Enum diff --git a/testsuite/tests/deriving/should_compile/drv006.hs b/testsuite/tests/deriving/should_compile/drv006.hs index 62f2cbcf67..297d0ddc0b 100644 --- a/testsuite/tests/deriving/should_compile/drv006.hs +++ b/testsuite/tests/deriving/should_compile/drv006.hs @@ -4,6 +4,6 @@ module ShouldSucceed where import Data.Ix data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 - deriving (Eq, Ord, Ix, Show) + deriving (Eq, Ord, Ix, Show) data Bar a b = MkBar a Int b Integer a diff --git a/testsuite/tests/deriving/should_compile/drv015.hs b/testsuite/tests/deriving/should_compile/drv015.hs index f8cfbce2db..b8575b2970 100644 --- a/testsuite/tests/deriving/should_compile/drv015.hs +++ b/testsuite/tests/deriving/should_compile/drv015.hs @@ -1,8 +1,8 @@ -- July 07: I'm changing this from "should_compile" to "should_fail". -- It would generate an instance decl like --- insance (Show (f a), Show (g a)) => Show (Pair1 f g a) --- and that is not Haskell 98. +-- insance (Show (f a), Show (g a)) => Show (Pair1 f g a) +-- and that is not Haskell 98. -- -- See Note [Exotic derived instance contexts] in TcSimplify. -- The rule is simple: the context of a derived instance decl must diff --git a/testsuite/tests/deriving/should_compile/drv020.hs b/testsuite/tests/deriving/should_compile/drv020.hs index 9956407fbd..bd5c8f4235 100644 --- a/testsuite/tests/deriving/should_compile/drv020.hs +++ b/testsuite/tests/deriving/should_compile/drv020.hs @@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, GeneralizedNewtypeDeriving #-} --- Test deriving of a multi-parameter class for +-- Test deriving of a multi-parameter class for -- one-argument newtype defined in the same module module ShouldSucceed where @@ -26,14 +26,14 @@ instance Applicative (State s) where (<*>) = ap instance Monad (State s) where - return a = State $ \s -> (a, s) - m >>= k = State $ \s -> let - (a, s') = runState m s - in runState (k a) s' + return a = State $ \s -> (a, s) + m >>= k = State $ \s -> let + (a, s') = runState m s + in runState (k a) s' instance MonadState s (State s) where - get = State $ \s -> (s, s) - put s = State $ \_ -> ((), s) + get = State $ \s -> (s, s) + put s = State $ \_ -> ((), s) -- test code diff --git a/testsuite/tests/deriving/should_fail/T4846.hs b/testsuite/tests/deriving/should_fail/T4846.hs index e9cd180d4c..e9cd180d4c 100755..100644 --- a/testsuite/tests/deriving/should_fail/T4846.hs +++ b/testsuite/tests/deriving/should_fail/T4846.hs diff --git a/testsuite/tests/deriving/should_fail/drvfail001.hs b/testsuite/tests/deriving/should_fail/drvfail001.hs index 47447fb3e3..d2ba8eb1f6 100644 --- a/testsuite/tests/deriving/should_fail/drvfail001.hs +++ b/testsuite/tests/deriving/should_fail/drvfail001.hs @@ -1,9 +1,9 @@ -{- From: Ian Bayley +{- From: Ian Bayley Sent: Tuesday, June 29, 1999 3:39 PM To: hugs-bugs@haskell.org Subject: Show for higher-order nested datatypes - - + + Is "deriving Show" meant to work for higher-order nested datatypes ? Hugs hangs when loading in the following file: -} @@ -12,15 +12,15 @@ module Foo where type SqMat a = SM Nil a -data SM f a = ZeroS (f (f a)) | SuccS (SM (Cons f) a) - deriving Show +data SM f a = ZeroS (f (f a)) | SuccS (SM (Cons f) a) + deriving Show -- Show (f (f a)), Show (SM (Cons f) a) => Show (SM f a) data Nil a = MkNil deriving Show data Cons f a = MkCons a (f a) - deriving Show + deriving Show diff --git a/testsuite/tests/deriving/should_fail/drvfail002.hs b/testsuite/tests/deriving/should_fail/drvfail002.hs index 26a8f083d2..945ead493e 100644 --- a/testsuite/tests/deriving/should_fail/drvfail002.hs +++ b/testsuite/tests/deriving/should_fail/drvfail002.hs @@ -2,7 +2,7 @@ MultiParamTypeClasses, FunctionalDependencies #-} -- The Show instance for S would have form --- instance X T c => Show S +-- instance X T c => Show S -- which is hard to deal with. It sent GHC 5.01 into -- an infinite loop; now it should be rejected. diff --git a/testsuite/tests/deriving/should_fail/drvfail006.hs b/testsuite/tests/deriving/should_fail/drvfail006.hs index 0d8d1a95d9..2f30efb99c 100644 --- a/testsuite/tests/deriving/should_fail/drvfail006.hs +++ b/testsuite/tests/deriving/should_fail/drvfail006.hs @@ -7,5 +7,5 @@ module ShouldFail where import Control.Monad.State newtype T a = T (StateT Int IO a) deriving( MonadState ) - -- Here MonadState takes two type params, - -- but exactly one is needed.
\ No newline at end of file + -- Here MonadState takes two type params, + -- but exactly one is needed. diff --git a/testsuite/tests/deriving/should_fail/drvfail009.hs b/testsuite/tests/deriving/should_fail/drvfail009.hs index 06155c38a1..fa130b5993 100644 --- a/testsuite/tests/deriving/should_fail/drvfail009.hs +++ b/testsuite/tests/deriving/should_fail/drvfail009.hs @@ -5,16 +5,16 @@ module ShouldFail where -class C a b +class C a b newtype T1 = T1 Int deriving( C ) - -- Wrong arity + -- Wrong arity newtype T2 = T2 Int deriving( Monad ) - -- Type constructor has wrong kind + -- Type constructor has wrong kind newtype T3 a = T3 Int deriving( Monad ) - -- Rep type has wrong kind + -- Rep type has wrong kind newtype T4 a = T4 (Either a a) deriving( Monad ) - -- Eta fails + -- Eta fails diff --git a/testsuite/tests/deriving/should_run/drvrun005.hs b/testsuite/tests/deriving/should_run/drvrun005.hs index a4ef060a6a..03a12042a4 100644 --- a/testsuite/tests/deriving/should_run/drvrun005.hs +++ b/testsuite/tests/deriving/should_run/drvrun005.hs @@ -5,13 +5,13 @@ module Main where an operator, it is defaulted to being "infixl 9". OLD: The derived Read instances for data types containing - left-assoc constructors produces code that causes - non-termination if you use 'read' to evaluate them - ( (head (reads x)) is cool tho.) + left-assoc constructors produces code that causes + non-termination if you use 'read' to evaluate them + ( (head (reads x)) is cool tho.) - ==> The inferred assoc for :++ below left & the derived - Read instance should fail to terminate (with ghc-4.xx, - this is exemplified by having the stack overflow.) + ==> The inferred assoc for :++ below left & the derived + Read instance should fail to terminate (with ghc-4.xx, + this is exemplified by having the stack overflow.) NEW: the new H98 spec says that we ignore associativity when parsing, so it terminates fine diff --git a/testsuite/tests/deriving/should_run/drvrun006.hs b/testsuite/tests/deriving/should_run/drvrun006.hs index 3d268019bd..5eba61588b 100644 --- a/testsuite/tests/deriving/should_run/drvrun006.hs +++ b/testsuite/tests/deriving/should_run/drvrun006.hs @@ -2,7 +2,7 @@ module Main(main) where infix 4 :^: -data Tree a +data Tree a = Leaf a | (Tree a) :^: (Tree a) deriving (Show, Read) @@ -25,25 +25,25 @@ main = do instance (Show a) => Show (Tree a) where showsPrec d (Leaf m) = showParen (d >= 10) showStr - where + where showStr = showString "Leaf " . showsPrec 10 m showsPrec d (u :^: v) = showParen (d > 4) showStr - where - showStr = showsPrec 5 u . + where + showStr = showsPrec 5 u . showString " :^: " . showsPrec 5 v instance (Read a) => Read (Tree a) where - readsPrec d r = readParen (d > 4) - (\r -> [(u:^:v,w) | - (u,s) <- readsPrec 5 r, - (":^:",t) <- lex s, - (v,w) <- readsPrec 5 t]) r + readsPrec d r = readParen (d > 4) + (\r -> [(u:^:v,w) | + (u,s) <- readsPrec 5 r, + (":^:",t) <- lex s, + (v,w) <- readsPrec 5 t]) r - ++ readParen (d > 9) - (\r -> [(Leaf m,t) | - ("Leaf",s) <- lex r, - (m,t) <- readsPrec 10 s]) r + ++ readParen (d > 9) + (\r -> [(Leaf m,t) | + ("Leaf",s) <- lex r, + (m,t) <- readsPrec 10 s]) r -} diff --git a/testsuite/tests/deriving/should_run/drvrun009.hs b/testsuite/tests/deriving/should_run/drvrun009.hs index 0bd22ab787..03b073e3c4 100644 --- a/testsuite/tests/deriving/should_run/drvrun009.hs +++ b/testsuite/tests/deriving/should_run/drvrun009.hs @@ -13,8 +13,8 @@ a :: MyArr a = array bds [ ((i,j), i+j) | (i,j) <- range bds ] main = do { putStrLn (show a) ; - let { b :: MyArr ; - b = read (show a) } ; - putStrLn (show b) - } + let { b :: MyArr ; + b = read (show a) } ; + putStrLn (show b) + } diff --git a/testsuite/tests/deriving/should_run/drvrun010.hs b/testsuite/tests/deriving/should_run/drvrun010.hs index 0a2f3d2742..292bc5892d 100644 --- a/testsuite/tests/deriving/should_run/drvrun010.hs +++ b/testsuite/tests/deriving/should_run/drvrun010.hs @@ -7,6 +7,6 @@ main = putStrLn $ then "works" else "not" -- The point here is that if 'show' generates --- Test { field=-1 } +-- Test { field=-1 } -- the lexer things the '=-' is one lexeme, which does not work diff --git a/testsuite/tests/deriving/should_run/drvrun011.hs b/testsuite/tests/deriving/should_run/drvrun011.hs index aad1482f2a..82e6b71919 100644 --- a/testsuite/tests/deriving/should_run/drvrun011.hs +++ b/testsuite/tests/deriving/should_run/drvrun011.hs @@ -3,14 +3,14 @@ module Main( main ) where data Command = Commit (Maybe String) | Foo | Baz Bool | Boz Int - deriving (Read,Show) + deriving (Read,Show) type T = ([Command], [Command], [Command]) val :: T -val = ([Commit Nothing, Commit (Just "foo")], - [Foo, Baz True], +val = ([Commit Nothing, Commit (Just "foo")], + [Foo, Baz True], [Boz 3, Boz (-2)]) main = do { print val ; - print ((read (show val)) :: T) } + print ((read (show val)) :: T) } diff --git a/testsuite/tests/deriving/should_run/drvrun013.hs b/testsuite/tests/deriving/should_run/drvrun013.hs index 2a9adae585..8bf15161ea 100644 --- a/testsuite/tests/deriving/should_run/drvrun013.hs +++ b/testsuite/tests/deriving/should_run/drvrun013.hs @@ -1,18 +1,18 @@ --- This test makes sure that the derivied instance for --- Eq A --- "sees" the non-derived instance for --- Eq B +-- This test makes sure that the derivied instance for +-- Eq A +-- "sees" the non-derived instance for +-- Eq B -- -- In a version of GHC 5.05, this didn't happen, because the -- deriving mechanism looked through A's rep-type and found Int module Main where -newtype B = MkB Int +newtype B = MkB Int instance Eq B where - (MkB 1) == (MkB 2) = True -- Non-standard equality + (MkB 1) == (MkB 2) = True -- Non-standard equality (MkB a) == (MkB b) = False - + newtype A = MkA B deriving( Eq ) main = print (MkA (MkB 1) == MkA (MkB 2)) diff --git a/testsuite/tests/deriving/should_run/drvrun018.hs b/testsuite/tests/deriving/should_run/drvrun018.hs index a0b9f24362..e7bbd70fe8 100644 --- a/testsuite/tests/deriving/should_run/drvrun018.hs +++ b/testsuite/tests/deriving/should_run/drvrun018.hs @@ -6,4 +6,4 @@ module Main where data Foo = Int `MkFoo` Int deriving( Read, Show ) main = do { print (MkFoo 4 5) - ; print (read "3 `MkFoo` 5" :: Foo) } + ; print (read "3 `MkFoo` 5" :: Foo) } diff --git a/testsuite/tests/deriving/should_run/drvrun020.hs b/testsuite/tests/deriving/should_run/drvrun020.hs index cf78a2a992..381f3e7a78 100644 --- a/testsuite/tests/deriving/should_run/drvrun020.hs +++ b/testsuite/tests/deriving/should_run/drvrun020.hs @@ -6,13 +6,13 @@ module Main where infix 4 :%% data T = Int :%% T - | T1 { f1 :: Int } - | T2 T - deriving( Show, Read ) + | T1 { f1 :: Int } + | T2 T + deriving( Show, Read ) main = print (read "3 :%% T2 T1 { f1=3 }" :: T) -{- Here's the parser that is produced +{- Here's the parser that is produced import GHC.Read import Text.ParserCombinators.ReadPrec @@ -28,13 +28,13 @@ instance Read T where return (x :%% y)) +++ prec (appPrec+1) ( - do Ident "T1" <- lexP - Punc "{" <- lexP - Ident "f1" <- lexP - Punc "=" <- lexP - x <- reset readPrec - Punc "}" <- lexP - return (T1 { f1 = x })) + do Ident "T1" <- lexP + Punc "{" <- lexP + Ident "f1" <- lexP + Punc "=" <- lexP + x <- reset readPrec + Punc "}" <- lexP + return (T1 { f1 = x })) +++ prec appPrec ( do Ident "T2" <- lexP diff --git a/testsuite/tests/deriving/should_run/drvrun021.hs b/testsuite/tests/deriving/should_run/drvrun021.hs index 05c7c8dbf0..e634d1b80e 100644 --- a/testsuite/tests/deriving/should_run/drvrun021.hs +++ b/testsuite/tests/deriving/should_run/drvrun021.hs @@ -8,13 +8,13 @@ newtype Moose = MkMoose () deriving (Show, Eq, Ord) newtype Noose = MkNoose () deriving (Ord) instance Eq Noose where - a == b = False -- Non-standard! + a == b = False -- Non-standard! f :: Ord a => a -> Bool f x = x==x -main = do print (MkNoose () == MkNoose ()) -- Eq Noose - print (f (MkNoose ())) -- via Ord Noose - print (MkMoose () == MkMoose ()) -- Eq Moose - print (f (MkMoose ())) -- via Ord Moose - putStrLn (show (MkMoose ())) -- Should not use the show () method +main = do print (MkNoose () == MkNoose ()) -- Eq Noose + print (f (MkNoose ())) -- via Ord Noose + print (MkMoose () == MkMoose ()) -- Eq Moose + print (f (MkMoose ())) -- via Ord Moose + putStrLn (show (MkMoose ())) -- Should not use the show () method diff --git a/testsuite/tests/th/T3920.hs b/testsuite/tests/th/T3920.hs index 309ca8eeb2..d7ea28de5b 100644 --- a/testsuite/tests/th/T3920.hs +++ b/testsuite/tests/th/T3920.hs @@ -9,9 +9,9 @@ $(return []) test :: String test = $(do - test <- [d| - type family T :: (* -> (* -> * -> *)) -> (* -> *) -> * |] + test <- [d| + type family T :: (* -> (* -> * -> *)) -> (* -> *) -> * |] blah <- reify ''S - return (LitE (StringL (pprint test ++ "\n" ++ pprint blah)))) + return (LitE (StringL (pprint test ++ "\n" ++ pprint blah)))) main = putStrLn test diff --git a/testsuite/tests/th/T4135.hs b/testsuite/tests/th/T4135.hs index 03ff2fe1f9..71a5106ba4 100644 --- a/testsuite/tests/th/T4135.hs +++ b/testsuite/tests/th/T4135.hs @@ -7,9 +7,9 @@ import System.IO class C a where type T a -$(do { ds <- [d| - instance C (Maybe a) where - type T (Maybe a) = Char +$(do { ds <- [d| + instance C (Maybe a) where + type T (Maybe a) = Char |] ; runIO $ do { putStrLn (pprint ds); hFlush stdout } ; return ds }) diff --git a/testsuite/tests/th/T5379.hs b/testsuite/tests/th/T5379.hs index d978032534..47ec3e8f58 100644 --- a/testsuite/tests/th/T5379.hs +++ b/testsuite/tests/th/T5379.hs @@ -5,7 +5,7 @@ import Language.Haskell.TH $( [d| g = 0 h = $( return $ LamE [VarP (mkName "g")] (VarE 'g) ) |] ) - -- The 'g should bind to the g=0 definition + -- The 'g should bind to the g=0 definition -- Should print 0, not 1! main = print (h 1) diff --git a/testsuite/tests/th/TH_exn1.hs b/testsuite/tests/th/TH_exn1.hs index b401ca40d5..bfc6f5d252 100644 --- a/testsuite/tests/th/TH_exn1.hs +++ b/testsuite/tests/th/TH_exn1.hs @@ -7,5 +7,5 @@ module ShouldCompile where $( case reverse "no" of - [] -> return [] + [] -> return [] ) diff --git a/testsuite/tests/th/TH_genExLib.hs b/testsuite/tests/th/TH_genExLib.hs index 25091c4ecf..d8b646ac90 100644 --- a/testsuite/tests/th/TH_genExLib.hs +++ b/testsuite/tests/th/TH_genExLib.hs @@ -5,10 +5,10 @@ import Language.Haskell.TH genAny :: Q Info -> Q [Dec] genAny decl = do { d <- decl - ; case d of - ClassI (ClassD _ name _ _ decls) _ -> return [genAnyClass name decls] - _ -> error "genAny can be applied to classes only" - } + ; case d of + ClassI (ClassD _ name _ _ decls) _ -> return [genAnyClass name decls] + _ -> error "genAny can be applied to classes only" + } genAnyClass :: Name -> [Dec] -> Dec genAnyClass name decls @@ -16,6 +16,6 @@ genAnyClass name decls where anyName = mkName ("Any" ++ nameBase name ++ "1111") constructor = ForallC [PlainTV var_a] [AppT (ConT name) (VarT var_a)] $ - NormalC anyName - [(Bang NoSourceUnpackedness NoSourceStrictness, VarT var_a)] + NormalC anyName + [(Bang NoSourceUnpackedness NoSourceStrictness, VarT var_a)] var_a = mkName "a" diff --git a/testsuite/tests/th/TH_repPrim.hs b/testsuite/tests/th/TH_repPrim.hs index 2be35b1424..c625b43da6 100644 --- a/testsuite/tests/th/TH_repPrim.hs +++ b/testsuite/tests/th/TH_repPrim.hs @@ -13,21 +13,21 @@ main :: IO () main = do putStrLn $ show $ $( do e <- [| I# 20# |] runIO $ putStrLn $ show e runIO $ putStrLn $ pprint e - runIO $ hFlush stdout + runIO $ hFlush stdout return e ) putStrLn $ show $ $( do e <- [| W# 32## |] runIO $ putStrLn $ show e runIO $ putStrLn $ pprint e - runIO $ hFlush stdout + runIO $ hFlush stdout return e ) putStrLn $ show $ $( do e <- [| F# 12.3# |] runIO $ putStrLn $ show e runIO $ putStrLn $ pprint e - runIO $ hFlush stdout + runIO $ hFlush stdout return e ) putStrLn $ show $ $( do e <- [| D# 24.6## |] runIO $ putStrLn $ show e runIO $ putStrLn $ pprint e - runIO $ hFlush stdout + runIO $ hFlush stdout return e ) diff --git a/testsuite/tests/th/TH_spliceE4.hs b/testsuite/tests/th/TH_spliceE4.hs index 99ee7a7648..dcda44fbb0 100644 --- a/testsuite/tests/th/TH_spliceE4.hs +++ b/testsuite/tests/th/TH_spliceE4.hs @@ -4,7 +4,7 @@ module Main where import Language.Haskell.TH $( do let h x = x - foo = [| \x -> $(h [| x |]) |] + foo = [| \x -> $(h [| x |]) |] [d| baz = $foo |] ) diff --git a/testsuite/tests/th/TH_tuple1.hs b/testsuite/tests/th/TH_tuple1.hs index c3469e4a97..3e9b330fb0 100644 --- a/testsuite/tests/th/TH_tuple1.hs +++ b/testsuite/tests/th/TH_tuple1.hs @@ -7,9 +7,9 @@ module ShouldCompile where import Language.Haskell.TH foo = $( sigE (appsE [conE (tupleDataName 2), - litE (integerL 1), - litE (integerL 2)]) - (appT (appT (conT (tupleTypeName 2)) - (conT ''Integer)) - (conT ''Integer)) - ) + litE (integerL 1), + litE (integerL 2)]) + (appT (appT (conT (tupleTypeName 2)) + (conT ''Integer)) + (conT ''Integer)) + ) |