Skip to content
GitLab
Commit 5b03dc69 authored by Thomas Miedema's avatar Thomas Miedema
Browse files

Testsuite: tabs -> spaces [skip ci]

parent 915e07c3
Expand all Hide whitespace changes
Inline Side-by-side
libraries/base/tests/Memo1.lhs
View file @ 5b03dc69
......@@ -7,16 +7,16 @@
\begin{code}
module Memo1
( memo -- :: (a -> b) -> a -> b
, memoSized -- :: Int -> (a -> b) -> a -> b
)
where
import System.Mem.StableName ( StableName, makeStableName, hashStableName )
import System.Mem.Weak ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
import Data.Array.IO ( IOArray, newArray, readArray, writeArray )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
( memo -- :: (a -> b) -> a -> b
, memoSized -- :: Int -> (a -> b) -> a -> b
)
where
import System.Mem.StableName ( StableName, makeStableName, hashStableName )
import System.Mem.Weak ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
import Data.Array.IO ( IOArray, newArray, readArray, writeArray )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
\end{code}
-----------------------------------------------------------------------------
......@@ -40,10 +40,10 @@ the documentation).
\begin{code}
type MemoTable key val
= MVar (
Int, -- current table size
IOArray Int [MemoEntry key val] -- hash table
)
= MVar (
Int, -- current table size
IOArray Int [MemoEntry key val] -- hash table
)
-- a memo table entry: compile with -funbox-strict-fields to eliminate
-- the boxes around the StableName and Weak fields.
......@@ -76,19 +76,19 @@ strict = ($!)
lazyMemoSized :: Int -> (a -> b) -> a -> b
lazyMemoSized size f =
let (table,weak) = unsafePerformIO (
do { tbl <- newArray (0,size) []
; mvar <- newMVar (size,tbl)
; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
; return (mvar,weak)
})
do { tbl <- newArray (0,size) []
; mvar <- newMVar (size,tbl)
; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
; return (mvar,weak)
})
in memo' f table weak
table_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()
table_finalizer table size =
table_finalizer table size =
sequence_ [ finalizeBucket i | i <- [0..size] ]
where
finalizeBucket i = do
bucket <- readArray table i
bucket <- readArray table i
sequence_ [ finalize w | MemoEntry _ w <- bucket ]
memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
......@@ -101,35 +101,35 @@ memo' f ref weak_ref = \k -> unsafePerformIO $ do
case lkp of
Just result -> do
putMVar ref (size,table)
return result
putMVar ref (size,table)
return result
Nothing -> do
let result = f k
weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
writeArray table hash_key (MemoEntry stable_key weak : bucket)
putMVar ref (size,table)
return result
let result = f k
weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
writeArray table hash_key (MemoEntry stable_key weak : bucket)
putMVar ref (size,table)
return result
finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()
finalizer hash_key stable_key weak_ref =
do r <- deRefWeak weak_ref
finalizer hash_key stable_key weak_ref =
do r <- deRefWeak weak_ref
case r of
Nothing -> return ()
Just mvar -> do
(size,table) <- takeMVar mvar
bucket <- readArray table hash_key
let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket,
sn /= stable_key ]
writeArray table hash_key new_bucket
putMVar mvar (size,table)
Nothing -> return ()
Just mvar -> do
(size,table) <- takeMVar mvar
bucket <- readArray table hash_key
let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket,
sn /= stable_key ]
writeArray table hash_key new_bucket
putMVar mvar (size,table)
lookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)
lookupSN sn [] = sn `seq` return Nothing -- make it strict in sn
lookupSN sn (MemoEntry sn' weak : xs)
| sn == sn' = do maybe_item <- deRefWeak weak
case maybe_item of
Nothing -> error ("dead weak pair: " ++
show (hashStableName sn))
Just v -> return (Just v)
case maybe_item of
Nothing -> error ("dead weak pair: " ++
show (hashStableName sn))
Just v -> return (Just v)
| otherwise = lookupSN sn xs
\end{code}
libraries/base/tests/Memo2.lhs
View file @ 5b03dc69
......@@ -7,16 +7,16 @@
\begin{code}
module Memo2
( memo -- :: (a -> b) -> a -> b
, memoSized -- :: Int -> (a -> b) -> a -> b
)
where
import System.Mem.StableName ( StableName, makeStableName, hashStableName )
import System.Mem.Weak ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
import Data.Array.IO ( IOArray, newArray, readArray, writeArray )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
( memo -- :: (a -> b) -> a -> b
, memoSized -- :: Int -> (a -> b) -> a -> b
)
where
import System.Mem.StableName ( StableName, makeStableName, hashStableName )
import System.Mem.Weak ( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
import Data.Array.IO ( IOArray, newArray, readArray, writeArray )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar )
\end{code}
-----------------------------------------------------------------------------
......@@ -40,10 +40,10 @@ the documentation).
\begin{code}
type MemoTable key val
= MVar (
Int, -- current table size
IOArray Int [MemoEntry key val] -- hash table
)
= MVar (
Int, -- current table size
IOArray Int [MemoEntry key val] -- hash table
)
-- a memo table entry: compile with -funbox-strict-fields to eliminate
-- the boxes around the StableName and Weak fields.
......@@ -76,19 +76,19 @@ strict = ($!)
lazyMemoSized :: Int -> (a -> b) -> a -> b
lazyMemoSized size f =
let (table,weak) = unsafePerformIO (
do { tbl <- newArray (0,size) []
; mvar <- newMVar (size,tbl)
; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
; return (mvar,weak)
})
do { tbl <- newArray (0,size) []
; mvar <- newMVar (size,tbl)
; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
; return (mvar,weak)
})
in memo' f table weak
table_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()
table_finalizer table size =
table_finalizer table size =
sequence_ [ finalizeBucket i | i <- [0..size] ]
where
finalizeBucket i = do
bucket <- readArray table i
bucket <- readArray table i
sequence_ [ finalize w | MemoEntry _ w <- bucket ]
memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
......@@ -101,35 +101,35 @@ memo' f ref weak_ref = \k -> unsafePerformIO $ do
case lkp of
Just result -> do
putMVar ref (size,table)
return result
putMVar ref (size,table)
return result
Nothing -> do
let result = f k
weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
writeArray table hash_key (MemoEntry stable_key weak : bucket)
putMVar ref (size,table)
return result
let result = f k
weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
writeArray table hash_key (MemoEntry stable_key weak : bucket)
putMVar ref (size,table)
return result
finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()
finalizer hash_key stable_key weak_ref =
do r <- deRefWeak weak_ref
finalizer hash_key stable_key weak_ref =
do r <- deRefWeak weak_ref
case r of
Nothing -> return ()
Just mvar -> do
(size,table) <- takeMVar mvar
bucket <- readArray table hash_key
let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket,
sn /= stable_key ]
writeArray table hash_key new_bucket
putMVar mvar (size,table)
Nothing -> return ()
Just mvar -> do
(size,table) <- takeMVar mvar
bucket <- readArray table hash_key
let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket,
sn /= stable_key ]
writeArray table hash_key new_bucket
putMVar mvar (size,table)
lookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)
lookupSN sn [] = sn `seq` return Nothing -- make it strict in sn
lookupSN sn (MemoEntry sn' weak : xs)
| sn == sn' = do maybe_item <- deRefWeak weak
case maybe_item of
Nothing -> error ("dead weak pair: " ++
show (hashStableName sn))
Just v -> return (Just v)
case maybe_item of
Nothing -> error ("dead weak pair: " ++
show (hashStableName sn))
Just v -> return (Just v)
| otherwise = lookupSN sn xs
\end{code}
testsuite/tests/concurrent/prog001/Arithmetic.hs
View file @ 5b03dc69
......@@ -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)
......
testsuite/tests/concurrent/prog001/Converter.hs
View file @ 5b03dc69
......@@ -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)