blob: 72aa1dee4665dcfd35cde2536999ce61331cd249 (
plain)
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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
> {-# LANGUAGE BangPatterns,CPP #-}
> module IOList where
-- #define USE_UNPACK
-- #define USE_STRICT
#if defined(USE_UNPACK)
#define UNPACK(p) {-# UNPACK #-} !(p)
#elif defined(USE_STRICT)
#define UNPACK(p) !(p)
#else
#define UNPACK(p) p
#endif
> import Data.IORef
> data List a = Node { val :: a, next :: UNPACK(IORef (List a))}
> | Null
> | Head {next :: UNPACK(IORef (List a)) }
> data ListHandle a = ListHandle { headList :: UNPACK(IORef (IORef (List a))),
> tailList :: UNPACK(IORef (IORef (List a))) }
> atomically = \x -> x
> -- we create a new list
> newList :: IO (ListHandle a)
> newList =
> do null <- newIORef Null
> hd <- newIORef (Head {next = null })
> hdPtr <- newIORef hd
> tailPtr <- newIORef null
> return (ListHandle {headList = hdPtr, tailList = tailPtr})
> find :: Eq a => ListHandle a -> a -> IO Bool
> find (ListHandle {headList = ptrPtr}) i = do
> ptr <- readIORef ptrPtr
> Head {next = startptr} <- readIORef ptr
> find2 startptr i
> where
> find2 :: Eq a => IORef (List a) -> a -> IO Bool
> find2 curNodePtr i = do
> { curNode <- readIORef curNodePtr
> ; case curNode of
> Null -> return False -- we've reached the end of the list
> -- element not found
> Node {val = curval, next = curnext} ->
> if (curval == i) then return True -- element found
> else find2 curnext i -- keep searching
> }
> -- we add a new node, by overwriting the null tail node
> -- we only need to adjust tailList but not headList because
> -- of the static Head
> -- we return the location of the newly added node
> addToTail :: ListHandle a -> a -> IO (IORef (List a))
> addToTail (ListHandle {tailList = tailPtrPtr}) x =
> do tPtr <- atomically (
> do null <- newIORef Null
> tailPtr <- readIORef tailPtrPtr
> writeIORef tailPtr (Node {val = x, next = null})
> writeIORef tailPtrPtr null
> return tailPtr
> )
> return tPtr
> delete :: Eq a => ListHandle a -> a -> IO Bool
> delete (ListHandle {headList = ptrPtr}) i =
> atomically (
> do startptr <- readIORef ptrPtr
> delete2 startptr i)
> where
> delete2 :: Eq a => IORef (List a) -> a -> IO Bool
> delete2 prevPtr i =
> do
> { prevNode <- readIORef prevPtr
> ; let curNodePtr = next prevNode -- head/node have both next
> ; curNode <- readIORef curNodePtr
> ; case curNode of
> Null -> return False -- we've reached the end of the list
> -- element not found
> Node {val = curval, next = nextNode} ->
> if (curval /= i)
> then delete2 curNodePtr i -- keep searching
> else
> -- delete element (ie delink node)
> do { case prevNode of
> Head {} -> do writeIORef prevPtr (Head {next = nextNode})
> return True
> Node {} -> do writeIORef prevPtr
> (Node {val = val prevNode, next = nextNode})
> return True
> }
> }
printing and counting
> printList :: Show a => ListHandle a -> IO ()
> printList (ListHandle {headList = ptrPtr}) =
> do startptr <- (
> do ptr <- readIORef ptrPtr
> Head {next = startptr} <- readIORef ptr
> return startptr)
> printListHelp startptr
> printListHelp :: Show a => IORef (List a) -> IO ()
> printListHelp curNodePtr =
> do { curNode <- readIORef curNodePtr
> ; case curNode of
> Null -> putStr "Nil"
> Node {val = curval, next = curnext} ->
> do { putStr (show curval ++ " -> ")
> ; printListHelp curnext }
> }
> cntList :: Show a => ListHandle a -> IO Int
> cntList (ListHandle {headList = ptrPtr}) =
> do startptr <- (
> do ptr <- readIORef ptrPtr
> Head {next = startptr} <- readIORef ptr
> return startptr)
> cntListHelp startptr 0
> cntListHelp :: Show a => IORef (List a) -> Int -> IO Int
> cntListHelp curNodePtr i =
> do { curNode <- readIORef curNodePtr
> ; case curNode of
> Null -> return i
> Node {val = curval, next = curnext} ->
> cntListHelp curnext (i+1)
> }
|
