1 -- Addressable Queues --
8 type AQ s a = (STArray s Int (Maybe a), Front s,Back s,QSize s,Int)
9 type Front s = STRef s Int
10 type Back s = STRef s Int
11 type QSize s = STRef s Int
15 new :: Int -> ST s (AQ s a)
16 enQueue :: AQ s a -> a -> ST s QAddr
17 deQueue :: AQ s a -> ST s (a,QAddr)
18 reQueue :: AQ s a -> a -> ST s QAddr
19 getSize :: AQ s a -> ST s Int
20 getMax :: AQ s a -> ST s Int
21 deQueueWhile :: AQ s a -> (a -> Bool) -> ST s [a]
22 enList :: AQ s a -> [a] -> ST s [QAddr]
23 update :: AQ s a -> QAddr -> (a -> a) -> ST s ()
24 clear :: AQ s a -> ST s ()
25 space :: AQ s a -> ST s Int
27 ------------------------------------------------------------------------------
29 assertM True _ = return ()
30 assertM False s = error $ s ++ "\n"
32 insert x y z = setQVal x y (Just z)
35 = do { q <- newSTArray (0,n) Nothing
43 = do { mapM (\x -> writeSTArray q x Nothing) [0 .. n]
50 = do { sz <- getSize q
52 ; () <- assertM (sz < max) "enQueue over max"
54 ; let f' = (f+1) `mod` max
55 ; setQVal q f' (Just elem)
62 = do { sz <- getSize q
64 ; assertM (sz < max) "reQueue over max"
66 ; let b' = (b-1) `mod` max
67 ; setQVal q b' (Just elem)
74 = do { sz <- getSize q
76 ; assertM (sz > 0) "deQueue under min"
79 ; let j = mj `catchEx` error "deQueue"
81 ; setBack q $ (b+1) `mod` max
86 = do { sz <- getSize q
92 = do { sz <- getSize q
95 else do { (elem,addr) <- deQueue q
97 then do { elems <- deQueueWhile q f
100 else do { reQueue q elem
108 enList q [] = return []
112 then do { a <- enQueue q x
120 = do { let len = length l
123 ; assertM (sz >= len) "sz < len"
126 ; let addrs = map (`mod` max) [f' .. f'+len]
127 ; return $ zip l addrs
131 = do { ans <- assignAddrs q [x]
136 = do { front <- getFront q
139 ; updateWhile q front front back max f
141 where updateWhile q front n back max f
142 | n == back = return ()
143 | otherwise = do { val <- getQVal q n
145 Just x -> return $ Just $ f x
146 Nothing -> return Nothing
148 ; updateWhile q front ((n+1) `mod` max) back max f
152 = do { x <- getQVal q n
153 ; setQVal q n $ fmap f x
156 -------------------------------------------------------------------------
158 getSize (q,f,b,s,m) = readSTRef s
159 setSize (q,f,b,s,m) v = writeSTRef s v
160 getMax (q,f,b,s,m) = return m
161 getFront (q,f,b,s,m) = readSTRef f
162 setFront (q,f,b,s,m) v = writeSTRef f v
163 getBack (q,f,b,s,m) = readSTRef b
164 setBack (q,f,b,s,m) v = writeSTRef b v
165 getQVal (q,f,b,s,m) n = readSTArray q n
166 setQVal (q,f,b,s,m) n e = writeSTArray q n e