761c05665847496573fcb8452b22fa4be771e04c
[ghc.git] / testsuite / tests / ghci.debugger / mdo.hs
1 import Control.Monad.Fix
2 import Data.IORef
3
4 data N a = N (IORef Bool, N a, a, N a)
5
6 newNode :: N a -> a -> N a -> IO (N a)
7 newNode b c f = do v <- newIORef False
8 return (N (v, b, c, f))
9
10 ll = mdo n0 <- newNode n3 0 n1
11 n1 <- newNode n0 1 n2
12 n2 <- newNode n1 2 n3
13 n3 <- newNode n2 3 n0
14 return n0
15
16 data Dir = F | B deriving Eq
17
18 traverse :: Dir -> N a -> IO [a]
19 traverse d (N (v, b, i, f)) =
20 do visited <- readIORef v
21 if visited
22 then return []
23 else do writeIORef v True
24 let next = if d == F then f else b
25 is <- traverse d next
26 return (i:is)
27
28 l2dll :: [a] -> IO (N a)
29 l2dll (x:xs) = mdo c <- newNode l x f
30 (f, l) <- l2dll' c xs
31 return c
32
33 l2dll' :: N a -> [a] -> IO (N a, N a)
34 l2dll' p [] = return (p, p)
35 l2dll' p (x:xs) = mdo c <- newNode p x f
36 (f, l) <- l2dll' c xs
37 return (c, l)