git.iko.soy/typeable/wai
on master help sign in
Using atomicModifyIORef' to ensure to use a good pattern.

See P284 of the ParCon book in detail.

commit2cf25249e65c97bfed219ad9e9dd23e9451d86c3 authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 22 Nov 2013, 16:02 (13 years ago) parent5e9d659
4 files changed+32−11
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/FdCache.hs+3−5 warp/Network/Wai/Handler/Warp/IORef.hs+22 warp/Network/Wai/Handler/Warp/Timeout.hs+6−6 warp/warp.cabal+1
warp/Network/Wai/Handler/Warp/FdCache.hs+3−5
@@ -26,7 +26,7 @@ import Control.Applicative ((<$>), (<*>))
2626import Control.Concurrent (threadDelay)
2727import Control.Exception (bracket, mask_)
2828import Data.Hashable (hash)
29−import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef)
29+import Network.Wai.Handler.Warp.IORef
3030import Network.Wai.Handler.Warp.MultiMap
3131import Network.Wai.Handler.Warp.Thread
3232import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
@@ -74,15 +74,13 @@ fdCache :: MutableFdCache -> IO FdCache
7474fdCache (MutableFdCache ref) = readIORef ref
7575
7676swapWithNew :: IORef FdCache -> IO FdCache
77−swapWithNew ref = atomicModifyIORef ref (\t -> (empty, t))
77+swapWithNew ref = atomicModifyIORef' ref $ \t -> (empty, t)
7878
7979update :: MutableFdCache -> (FdCache -> FdCache) -> IO ()
8080update (MutableFdCache ref) = update' ref
8181
8282update' :: IORef FdCache -> (FdCache -> FdCache) -> IO ()
83−update' ref f = do
84− !_ <- atomicModifyIORef ref $ \t -> let !new = f t in (new, ())
85− return ()
83+update' ref f = atomicModifyIORef' ref $ \t -> (f t, ())
8684
8785look :: MutableFdCache -> FilePath -> Hash -> IO (Maybe FdEntry)
8886look mfc path key = searchWith key check <$> fdCache mfc
warp/Network/Wai/Handler/Warp/IORef.hsnew file+22
@@ -0,0 +1,22 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Network.Wai.Handler.Warp.IORef (
4+ module Data.IORef
5+#if !MIN_VERSION_base(4,6,0)
6+ , atomicModifyIORef'
7+#endif
8+ ) where
9+
10+import Data.IORef
11+
12+#if !MIN_VERSION_base(4,6,0)
13+-- | Strict version of 'atomicModifyIORef'. This forces both the value stored
14+-- in the 'IORef' as well as the value returned.
15+atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
16+atomicModifyIORef' ref f = do
17+ c <- atomicModifyIORef ref
18+ (\x -> let (a, b) = f x -- Lazy application of "f"
19+ in (a, a `seq` b)) -- Lazy application of "seq"
20+ -- The following forces "a `seq` b", so it also forces "f x".
21+ c `seq` return c
22+#endif
warp/Network/Wai/Handler/Warp/Timeout.hs+6−6
@@ -48,9 +48,9 @@ import GHC.IO (IO (IO))
4848#endif
4949import Control.Concurrent (threadDelay, myThreadId, killThread)
5050import qualified Control.Exception as E
51−import Data.IORef (IORef)
52−import qualified Data.IORef as I
5351import GHC.Weak (Weak (..))
52+import Network.Wai.Handler.Warp.IORef (IORef)
53+import qualified Network.Wai.Handler.Warp.IORef as I
5454import Network.Wai.Handler.Warp.Thread
5555import System.Mem.Weak (deRefWeak)
5656
@@ -78,14 +78,14 @@ initialize :: Int -> IO Manager
7878initialize timeout = do
7979 ref' <- forkIOwithBreakableForever [] $ \ref -> do
8080 threadDelay timeout
81− old <- I.atomicModifyIORef ref (\x -> ([], x))
81+ old <- I.atomicModifyIORef' ref (\x -> ([], x))
8282 merge <- prune old id
83− I.atomicModifyIORef ref (\new -> (merge new, ()))
83+ I.atomicModifyIORef' ref (\new -> (merge new, ()))
8484 return $ Manager ref'
8585 where
8686 prune [] front = return front
8787 prune (m@(Handle onTimeout iactive):rest) front = do
88− state <- I.atomicModifyIORef iactive (\x -> (inactivate x, x))
88+ state <- I.atomicModifyIORef' iactive (\x -> (inactivate x, x))
8989 case state of
9090 Inactive -> do
9191 onTimeout `E.catch` ignoreAll
@@ -115,7 +115,7 @@ register :: Manager -> TimeoutAction -> IO Handle
115115register (Manager ref) onTimeout = do
116116 iactive <- I.newIORef Active
117117 let h = Handle onTimeout iactive
118− I.atomicModifyIORef ref (\x -> (h : x, ()))
118+ I.atomicModifyIORef' ref (\x -> (h : x, ()))
119119 return h
120120
121121-- | Registering a timeout action of killing this thread.
warp/warp.cabal+1
@@ -59,6 +59,7 @@ Library
5959 Network.Wai.Handler.Warp.Date
6060 Network.Wai.Handler.Warp.FdCache
6161 Network.Wai.Handler.Warp.Header
62+ Network.Wai.Handler.Warp.IORef
6263 Network.Wai.Handler.Warp.ReadInt
6364 Network.Wai.Handler.Warp.Recv
6465 Network.Wai.Handler.Warp.Request