33 firstIndex :: ElemIndex |
33 firstIndex :: ElemIndex |
34 firstIndex = ElemIndex 0 |
34 firstIndex = ElemIndex 0 |
35 |
35 |
36 -- MStore code |
36 -- MStore code |
37 initialSize :: Int |
37 initialSize :: Int |
38 initialSize = 10 |
38 initialSize = 16 |
39 |
39 |
40 |
40 |
41 growFunc :: Int -> Int |
41 growFunc :: Int -> Int |
42 growFunc a = a * 3 `div` 2 |
42 growFunc a = a * 3 `div` 2 |
|
43 |
|
44 truncFunc :: Int -> Int |
|
45 truncFunc a | a > growFunc initialSize = (a `div` 2) |
|
46 | otherwise = a |
43 |
47 |
44 |
48 |
45 newStore :: IO (MStore e) |
49 newStore :: IO (MStore e) |
46 newStore = do |
50 newStore = do |
47 newar <- IOA.newArray_ (0, initialSize - 1) |
51 newar <- IOA.newArray_ (0, initialSize - 1) |
63 growIfNeeded m@(MStore ref) = do |
67 growIfNeeded m@(MStore ref) = do |
64 (_, freeElems, _) <- readIORef ref |
68 (_, freeElems, _) <- readIORef ref |
65 when (IntSet.null freeElems) $ growStore m |
69 when (IntSet.null freeElems) $ growStore m |
66 |
70 |
67 |
71 |
|
72 truncateStore :: MStore e -> IO () |
|
73 truncateStore (MStore ref) = do |
|
74 (busyElems, freeElems, arr) <- readIORef ref |
|
75 (_, m') <- IOA.getBounds arr |
|
76 let newM' = truncFunc (m' + 1) - 1 |
|
77 newArr <- IOA.newArray_ (0, newM') |
|
78 sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- IntSet.toList busyElems] |
|
79 writeIORef ref (busyElems, freeElems `IntSet.difference` IntSet.fromAscList [newM'..m'+1], newArr) |
|
80 |
|
81 |
|
82 truncateIfNeeded :: MStore e -> IO () |
|
83 truncateIfNeeded m@(MStore ref) = do |
|
84 (busyElems, _, arr) <- readIORef ref |
|
85 (_, m') <- IOA.getBounds arr |
|
86 let newM' = truncFunc (m' + 1) - 1 |
|
87 let allLessM = all (< newM') $ IntSet.elems busyElems |
|
88 when (newM' < m' && allLessM) $ truncateStore m |
|
89 |
|
90 |
68 addElem :: MStore e -> e -> IO ElemIndex |
91 addElem :: MStore e -> e -> IO ElemIndex |
69 addElem m@(MStore ref) element = do |
92 addElem m@(MStore ref) element = do |
70 growIfNeeded m |
93 growIfNeeded m |
71 (busyElems, freeElems, arr) <- readIORef ref |
94 (busyElems, freeElems, arr) <- readIORef ref |
72 let (n, freeElems') = IntSet.deleteFindMin freeElems |
95 let (n, freeElems') = IntSet.deleteFindMin freeElems |
74 writeIORef ref (IntSet.insert n busyElems, freeElems', arr) |
97 writeIORef ref (IntSet.insert n busyElems, freeElems', arr) |
75 return $ ElemIndex n |
98 return $ ElemIndex n |
76 |
99 |
77 |
100 |
78 removeElem :: MStore e -> ElemIndex -> IO () |
101 removeElem :: MStore e -> ElemIndex -> IO () |
79 removeElem (MStore ref) (ElemIndex n) = do |
102 removeElem m@(MStore ref) (ElemIndex n) = do |
80 (busyElems, freeElems, arr) <- readIORef ref |
103 (busyElems, freeElems, arr) <- readIORef ref |
81 IOA.writeArray arr n (error $ "Store: no element " ++ show n) |
104 IOA.writeArray arr n (error $ "Store: no element " ++ show n) |
82 writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr) |
105 writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr) |
|
106 truncateIfNeeded m |
83 |
107 |
84 |
108 |
85 readElem :: MStore e -> ElemIndex -> IO e |
109 readElem :: MStore e -> ElemIndex -> IO e |
86 readElem (MStore ref) (ElemIndex n) = readIORef ref >>= \(_, _, arr) -> IOA.readArray arr n |
110 readElem (MStore ref) (ElemIndex n) = readIORef ref >>= \(_, _, arr) -> IOA.readArray arr n |
87 |
111 |