20 import qualified Data.Array.IArray as IA |
21 import qualified Data.Array.IArray as IA |
21 import qualified Data.Array.IO as IOA |
22 import qualified Data.Array.IO as IOA |
22 import qualified Data.IntSet as IntSet |
23 import qualified Data.IntSet as IntSet |
23 import Data.IORef |
24 import Data.IORef |
24 import Control.Monad |
25 import Control.Monad |
|
26 import Control.DeepSeq |
25 |
27 |
26 |
28 |
27 newtype ElemIndex = ElemIndex Int |
29 newtype ElemIndex = ElemIndex Int |
28 deriving (Eq, Show, Read, Ord) |
30 deriving (Eq, Show, Read, Ord, NFData) |
29 newtype MStore e = MStore (IORef (IntSet.IntSet, IntSet.IntSet, IOA.IOArray Int e)) |
31 newtype MStore e = MStore (IORef (IntSet.IntSet, IntSet.IntSet, IOA.IOArray Int e)) |
30 newtype IStore e = IStore (IntSet.IntSet, IA.Array Int e) |
32 newtype IStore e = IStore (IntSet.IntSet, IA.Array Int e) |
31 |
33 |
32 |
34 |
33 firstIndex :: ElemIndex |
35 firstIndex :: ElemIndex |
82 |
84 |
83 addElem :: MStore e -> e -> IO ElemIndex |
85 addElem :: MStore e -> e -> IO ElemIndex |
84 addElem m@(MStore ref) element = do |
86 addElem m@(MStore ref) element = do |
85 growIfNeeded m |
87 growIfNeeded m |
86 (busyElems, freeElems, arr) <- readIORef ref |
88 (busyElems, freeElems, arr) <- readIORef ref |
87 let (n, freeElems') = IntSet.deleteFindMin freeElems |
89 let (!n, freeElems') = IntSet.deleteFindMin freeElems |
88 IOA.writeArray arr n element |
90 IOA.writeArray arr n element |
89 writeIORef ref (IntSet.insert n busyElems, freeElems', arr) |
91 writeIORef ref (IntSet.insert n busyElems, freeElems', arr) |
90 return $ ElemIndex n |
92 return $ ElemIndex n |
91 |
93 |
92 |
94 |
111 (_, _, arr) <- readIORef ref |
113 (_, _, arr) <- readIORef ref |
112 IOA.readArray arr n >>= IOA.writeArray arr n . f |
114 IOA.readArray arr n >>= IOA.writeArray arr n . f |
113 |
115 |
114 elemExists :: MStore e -> ElemIndex -> IO Bool |
116 elemExists :: MStore e -> ElemIndex -> IO Bool |
115 elemExists (MStore ref) (ElemIndex n) = do |
117 elemExists (MStore ref) (ElemIndex n) = do |
116 (_, free, _) <- readIORef ref |
118 (_, !free, _) <- readIORef ref |
117 return $ n `IntSet.notMember` free |
119 return $ n `IntSet.notMember` free |
118 |
120 |
119 indicesM :: MStore e -> IO [ElemIndex] |
121 indicesM :: MStore e -> IO [ElemIndex] |
120 indicesM (MStore ref) = do |
122 indicesM (MStore ref) = do |
121 (busy, _, _) <- readIORef ref |
123 (!busy, _, _) <- readIORef ref |
122 return $ map ElemIndex $ IntSet.toList busy |
124 return $ map ElemIndex $ IntSet.toList busy |
123 |
125 |
124 |
126 |
125 -- A way to see MStore elements in pure code via IStore |
127 -- A way to see MStore elements in pure code via IStore |
126 m2i :: MStore e -> IO (IStore e) |
128 m2i :: MStore e -> IO (IStore e) |