gameServer/Store.hs
changeset 6805 097289be7200
parent 5119 f475e10c4081
child 7751 8c7f5c43ea5e
--- a/gameServer/Store.hs	Wed Mar 21 00:05:46 2012 -0400
+++ b/gameServer/Store.hs	Thu Mar 22 22:55:38 2012 +0400
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}
 module Store(
     ElemIndex(),
     MStore(),
@@ -22,10 +23,11 @@
 import qualified Data.IntSet as IntSet
 import Data.IORef
 import Control.Monad
+import Control.DeepSeq
 
 
 newtype ElemIndex = ElemIndex Int
-    deriving (Eq, Show, Read, Ord)
+    deriving (Eq, Show, Read, Ord, NFData)
 newtype MStore e = MStore (IORef (IntSet.IntSet, IntSet.IntSet, IOA.IOArray Int e))
 newtype IStore e = IStore (IntSet.IntSet, IA.Array Int e)
 
@@ -84,7 +86,7 @@
 addElem m@(MStore ref) element = do
     growIfNeeded m
     (busyElems, freeElems, arr) <- readIORef ref
-    let (n, freeElems') = IntSet.deleteFindMin freeElems
+    let (!n, freeElems') = IntSet.deleteFindMin freeElems
     IOA.writeArray arr n element
     writeIORef ref (IntSet.insert n busyElems, freeElems', arr)
     return $ ElemIndex n
@@ -113,12 +115,12 @@
 
 elemExists :: MStore e -> ElemIndex -> IO Bool
 elemExists (MStore ref) (ElemIndex n) = do
-    (_, free, _) <- readIORef ref
+    (_, !free, _) <- readIORef ref
     return $ n `IntSet.notMember` free
 
 indicesM :: MStore e -> IO [ElemIndex]
 indicesM (MStore ref) = do
-    (busy, _, _) <- readIORef ref
+    (!busy, _, _) <- readIORef ref
     return $ map ElemIndex $ IntSet.toList busy