diff -r 312f4dd41753 -r db4726bf9205 gameServer/Store.hs --- a/gameServer/Store.hs Sat Mar 12 22:55:25 2011 +0300 +++ b/gameServer/Store.hs Sun Mar 13 15:09:04 2011 +0300 @@ -35,12 +35,16 @@ -- MStore code initialSize :: Int -initialSize = 10 +initialSize = 16 growFunc :: Int -> Int growFunc a = a * 3 `div` 2 +truncFunc :: Int -> Int +truncFunc a | a > growFunc initialSize = (a `div` 2) + | otherwise = a + newStore :: IO (MStore e) newStore = do @@ -65,6 +69,25 @@ when (IntSet.null freeElems) $ growStore m +truncateStore :: MStore e -> IO () +truncateStore (MStore ref) = do + (busyElems, freeElems, arr) <- readIORef ref + (_, m') <- IOA.getBounds arr + let newM' = truncFunc (m' + 1) - 1 + newArr <- IOA.newArray_ (0, newM') + sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- IntSet.toList busyElems] + writeIORef ref (busyElems, freeElems `IntSet.difference` IntSet.fromAscList [newM'..m'+1], newArr) + + +truncateIfNeeded :: MStore e -> IO () +truncateIfNeeded m@(MStore ref) = do + (busyElems, _, arr) <- readIORef ref + (_, m') <- IOA.getBounds arr + let newM' = truncFunc (m' + 1) - 1 + let allLessM = all (< newM') $ IntSet.elems busyElems + when (newM' < m' && allLessM) $ truncateStore m + + addElem :: MStore e -> e -> IO ElemIndex addElem m@(MStore ref) element = do growIfNeeded m @@ -76,10 +99,11 @@ removeElem :: MStore e -> ElemIndex -> IO () -removeElem (MStore ref) (ElemIndex n) = do +removeElem m@(MStore ref) (ElemIndex n) = do (busyElems, freeElems, arr) <- readIORef ref IOA.writeArray arr n (error $ "Store: no element " ++ show n) writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr) + truncateIfNeeded m readElem :: MStore e -> ElemIndex -> IO e