summaryrefslogtreecommitdiff
path: root/tests/examples/ghc86/mdo.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/examples/ghc86/mdo.hs')
-rw-r--r--tests/examples/ghc86/mdo.hs40
1 files changed, 40 insertions, 0 deletions
diff --git a/tests/examples/ghc86/mdo.hs b/tests/examples/ghc86/mdo.hs
new file mode 100644
index 0000000..c077a12
--- /dev/null
+++ b/tests/examples/ghc86/mdo.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE RecursiveDo #-}
+import Control.Monad.Fix
+import Data.IORef
+import Prelude hiding (traverse)
+
+data N a = N (IORef Bool, N a, a, N a)
+
+newNode :: N a -> a -> N a -> IO (N a)
+newNode b c f = do v <- newIORef False
+ return (N (v, b, c, f))
+
+ll = mdo n0 <- newNode n3 0 n1
+ n1 <- newNode n0 1 n2
+ n2 <- newNode n1 2 n3
+ n3 <- newNode n2 3 n0
+ return n0
+
+data Dir = F | B deriving Eq
+
+traverse :: Dir -> N a -> IO [a]
+traverse d (N (v, b, i, f)) =
+ do visited <- readIORef v
+ if visited
+ then return []
+ else do writeIORef v True
+ let next = if d == F then f else b
+ is <- traverse d next
+ return (i:is)
+
+l2dll :: [a] -> IO (N a)
+l2dll (x:xs) = mdo c <- newNode l x f
+ (f, l) <- l2dll' c xs
+ return c
+
+l2dll' :: N a -> [a] -> IO (N a, N a)
+l2dll' p [] = return (p, p)
+l2dll' p (x:xs) = mdo c <- newNode p x f
+ (f, l) <- l2dll' c xs
+ return (c, l)
+