67 growIfNeeded m@(MStore ref) = do |
67 growIfNeeded m@(MStore ref) = do |
68 (_, freeElems, _) <- readIORef ref |
68 (_, freeElems, _) <- readIORef ref |
69 when (IntSet.null freeElems) $ growStore m |
69 when (IntSet.null freeElems) $ growStore m |
70 |
70 |
71 |
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 () |
72 truncateIfNeeded :: MStore e -> IO () |
83 truncateIfNeeded m@(MStore ref) = do |
73 truncateIfNeeded (MStore ref) = do |
84 (busyElems, _, arr) <- readIORef ref |
74 (busyElems, _, arr) <- readIORef ref |
85 (_, m') <- IOA.getBounds arr |
75 (_, m') <- IOA.getBounds arr |
86 let newM' = truncFunc (m' + 1) - 1 |
76 let newM' = truncFunc (m' + 1) - 1 |
87 let allLessM = all (< newM') $ IntSet.elems busyElems |
77 when (newM' < m' && (not $ IntSet.null busyElems) && IntSet.findMax busyElems <= newM') $ do |
88 when (newM' < m' && allLessM) $ truncateStore m |
78 newArr <- IOA.newArray_ (0, newM') |
|
79 sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- IntSet.toList busyElems] |
|
80 writeIORef ref (busyElems, IntSet.fromAscList [0..newM'] `IntSet.difference` busyElems, newArr) |
89 |
81 |
90 |
82 |
91 addElem :: MStore e -> e -> IO ElemIndex |
83 addElem :: MStore e -> e -> IO ElemIndex |
92 addElem m@(MStore ref) element = do |
84 addElem m@(MStore ref) element = do |
93 growIfNeeded m |
85 growIfNeeded m |