Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
5b03dc69
Commit
5b03dc69
authored
Jun 18, 2016
by
Thomas Miedema
Browse files
Testsuite: tabs -> spaces [skip ci]
parent
915e07c3
Changes
64
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
)