1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
{-# OPTIONS -XRecursiveDo #-}
module Main(main) where
import Control.Monad.Fix
import Control.Monad.ST
import Data.STRef
import Prelude hiding (traverse)
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
|
