content: {-# OPTIONS -XRecursiveDo #-}
  
  module Main(main) where
  
  import Control.Monad.Fix
  import Control.Monad.ST
  import Data.STRef
  
  newtype Node s a = N (STRef s Bool, Node s a, a, Node s a)
  
  newNode       :: Node s a -> a -> Node s a -> ST s (Node s a)
  newNode b c f = do v <- newSTRef False
                     return (N (v, b, c, f))
  
  ll :: ST s (Node s Int)
  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 Direction = Forward | Backward deriving Eq
  
  traverse'                      :: Direction -> Node s a -> ST s [a]
  traverse' dir (N (v, b, i, f)) = 
         do visited <- readSTRef v
            if visited
               then return []
               else do writeSTRef v True
                       let n = if dir == Forward then f else b
                       is <- traverse' dir n
                       return (i:is)
  
  l2dll        :: [a] -> ST s (Node s a)
  l2dll (x:xs) = mdo c <- newNode l x f
                     (f, l) <- l2dll' c xs
                     return c
  
  l2dll'          :: Node s a -> [a] -> ST s (Node s a, Node s a)
  l2dll' p []     = return (p, p)
  l2dll' p (x:xs) = mdo c <- newNode p x f
                        (f, l) <- l2dll' c xs
                        return (c, l)
  
  insertAfter :: Node s a -> a -> ST s (Node s a)
  insertAfter cur@(N (v, prev, val, next)) i 
       = do vis <- newSTRef False
            let newCell = N (vis, cur, i, next)
  	  return (N (v, prev, val, newCell))
  
  test = runST (do l   <- l2dll [1 .. 10] 
                   l'  <- insertAfter l  12 
  		 l'' <- insertAfter l' 13 
  		 traverse' Forward l'')
  
  main = print test
  