gameServer/Store.hs
changeset 3742 8461f0cef2e6
parent 3741 73246d25dfe1
child 3747 76a197793b62
equal deleted inserted replaced
3740:2e7dda50fddd 3742:8461f0cef2e6
     6     addElem,
     6     addElem,
     7     removeElem,
     7     removeElem,
     8     readElem,
     8     readElem,
     9     writeElem,
     9     writeElem,
    10     modifyElem,
    10     modifyElem,
       
    11     elemExists,
    11     firstIndex,
    12     firstIndex,
    12     indicesM,
    13     indicesM,
    13     withIStore,
    14     withIStore,
    14     withIStore2,
    15     withIStore2,
    15     (!),
    16     (!),
    92 modifyElem :: MStore e -> (e -> e) -> ElemIndex -> IO ()
    93 modifyElem :: MStore e -> (e -> e) -> ElemIndex -> IO ()
    93 modifyElem (MStore ref) f (ElemIndex n) = do
    94 modifyElem (MStore ref) f (ElemIndex n) = do
    94     (_, _, arr) <- readIORef ref
    95     (_, _, arr) <- readIORef ref
    95     IOA.readArray arr n >>= (IOA.writeArray arr n) . f
    96     IOA.readArray arr n >>= (IOA.writeArray arr n) . f
    96 
    97 
       
    98 elemExists :: MStore e -> ElemIndex -> IO Bool
       
    99 elemExists (MStore ref) (ElemIndex n) = do
       
   100     (_, free, _) <- readIORef ref
       
   101     return $ n `IntSet.notMember` free
    97 
   102 
    98 indicesM :: MStore e -> IO [ElemIndex]
   103 indicesM :: MStore e -> IO [ElemIndex]
    99 indicesM (MStore ref) = do
   104 indicesM (MStore ref) = do
   100     (busy, _, _) <- readIORef ref
   105     (busy, _, _) <- readIORef ref
   101     return $ map ElemIndex $ IntSet.toList busy
   106     return $ map ElemIndex $ IntSet.toList busy
   102 
   107 
   103 
   108 
   104 -- A way to use see MStore elements in pure code via IStore
   109 -- A way to see MStore elements in pure code via IStore
   105 m2i :: MStore e -> IO (IStore e)
   110 m2i :: MStore e -> IO (IStore e)
   106 m2i (MStore ref) = do
   111 m2i (MStore ref) = do
   107     (a, _, c') <- readIORef ref 
   112     (a, _, c') <- readIORef ref
   108     c <- IOA.freeze c'
   113     c <- IOA.unsafeFreeze c'
   109     return $ IStore (a, c)
   114     return $ IStore (a, c)
   110 
   115 
       
   116 i2m :: (MStore e) -> IStore e -> IO ()
       
   117 i2m (MStore ref) (IStore (_, arr)) = do
       
   118     (b, e, _) <- readIORef ref
       
   119     a <- IOA.unsafeThaw arr
       
   120     writeIORef ref (b, e, a)
   111 
   121 
   112 withIStore :: MStore e -> (IStore e -> a) -> IO a
   122 withIStore :: MStore e -> (IStore e -> a) -> IO a
   113 withIStore m f = liftM f (m2i m)
   123 withIStore m f = do
       
   124     i <- m2i m
       
   125     let res = f i
       
   126     res `seq` i2m m i
       
   127     return res
   114 
   128 
   115 
   129 
   116 withIStore2 :: MStore e1 -> MStore e2 -> (IStore e1 -> IStore e2 -> a) -> IO a
   130 withIStore2 :: MStore e1 -> MStore e2 -> (IStore e1 -> IStore e2 -> a) -> IO a
   117 withIStore2 m1 m2 f = do
   131 withIStore2 m1 m2 f = do
   118     i1 <- m2i m1
   132     i1 <- m2i m1
   119     i2 <- m2i m2
   133     i2 <- m2i m2
   120     return $ f i1 i2
   134     let res = f i1 i2
       
   135     res `seq` i2m m1 i1
       
   136     i2m m2 i2
       
   137     return res
   121 
   138 
   122 
   139 
   123 -- IStore code
   140 -- IStore code
   124 (!) :: IStore e -> ElemIndex -> e
   141 (!) :: IStore e -> ElemIndex -> e
   125 (!) (IStore (_, arr)) (ElemIndex i) = (IA.!) arr i
   142 (!) (IStore (_, arr)) (ElemIndex i) = (IA.!) arr i