a7a78e6 · typeable/wai

git.iko.soy/typeable/wai

Only use atomic-primops on GHC 7.8

commita7a78e64096359520d84e5ce7583810339fac0a9 authorMichael Snoyman <michael@snoyman.com> dateThu 2 Oct 2014, 08:02 (12 years ago) parentc8d4d56

3 files changed+65−8

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Counter.hs+21 warp/Network/Wai/Handler/Warp/Timeout.hs+35−5 warp/warp.cabal+9−3

warp/Network/Wai/Handler/Warp/Counter.hs+21

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12module Network.Wai.Handler.Warp.Counter (

23 Counter

34 , newCounter

@@ -6,6 +7,7 @@ module Network.Wai.Handler.Warp.Counter (

67 , decrease

78 ) where

10+#if USE_ATOMIC_PRIMOPS

911import qualified Data.Atomics.Counter.Unboxed as C

1012import Control.Applicative ((<$>))

1113

@@ -22,3 +24,22 @@ increase (Counter ref) = C.incrCounter_ 1 ref

2224

2325decrease :: Counter -> IO ()

2426decrease (Counter ref) = C.incrCounter_ (-1) ref

27+#else

28+

29+import Network.Wai.Handler.Warp.IORef

30+import Control.Applicative ((<$>))

31+

32+newtype Counter = Counter (IORef Int)

33+

34+newCounter :: IO Counter

35+newCounter = Counter <$> newIORef 0

36+

37+isZero :: Counter -> IO Bool

38+isZero (Counter ref) = (== 0) <$> readIORef ref

39+

40+increase :: Counter -> IO ()

41+increase (Counter ref) = atomicModifyIORef' ref (\x -> (x + 1, ()))

42+

43+decrease :: Counter -> IO ()

44+decrease (Counter ref) = atomicModifyIORef' ref (\x -> (x - 1, ()))

45+#endif

warp/Network/Wai/Handler/Warp/Timeout.hs+35−5

@@ -59,7 +59,12 @@ import GHC.Weak (Weak (..))

5959import System.Mem.Weak (deRefWeak)

6060import Data.Typeable (Typeable)

6161import Control.Reaper

62+#if USE_ATOMIC_PRIMOPS

6263import qualified Data.Atomics.Counter.Unboxed as C

64+import Data.Atomics.Counter.Unboxed (casCounter)

65+#else

66+import Network.Wai.Handler.Warp.IORef

67+#endif

6368

6469----------------------------------------------------------------

6570

@@ -70,7 +75,12 @@ type Manager = Reaper [Handle] Handle

7075type TimeoutAction = IO ()

7176

7277-- | A handle used by 'Manager'

73−data Handle = Handle TimeoutAction {-# UNPACK #-} !C.AtomicCounter

78+data Handle = Handle TimeoutAction

79+#if USE_ATOMIC_PRIMOPS

80+ {-# UNPACK #-} !C.AtomicCounter

81+#else

82+ {-# UNPACK #-} !(IORef Int)

83+#endif

7484

7585-- Four states for the AtomicCounter:

7686--

@@ -91,7 +101,7 @@ initialize timeout = mkReaper defaultReaperSettings

91101 where

92102 prune m@(Handle onTimeout iactive) = do

93103 -- Try to change from active to inactive

94− (wasActive, newState) <- C.casCounter iactive 1 2

104+ (wasActive, newState) <- casCounter iactive 1 2

95105 case newState of

96106 2 | not wasActive -> do -- inactive

97107 onTimeout `E.catch` ignoreAll

@@ -99,6 +109,14 @@ initialize timeout = mkReaper defaultReaperSettings

99109 4 -> return Nothing -- canceled

100110 _ -> return $ Just m

101111

112+#if !USE_ATOMIC_PRIMOPS

113+casCounter :: IORef Int -> Int -> Int -> IO (Bool, Int)

114+casCounter ref old new = atomicModifyIORef' ref $ \curr ->

115+ if old == curr

116+ then (new, (True, new))

117+ else (old, (False, old))

118+#endif

119+

102120----------------------------------------------------------------

103121

104122-- | Stopping timeout manager.

@@ -115,7 +133,11 @@ ignoreAll _ = return ()

115133-- | Registering a timeout action.

116134register :: Manager -> TimeoutAction -> IO Handle

117135register mgr onTimeout = do

136+#if USE_ATOMIC_PRIMOPS

118137 iactive <- C.newCounter 1

138+#else

139+ iactive <- newIORef 1

140+#endif

119141 let h = Handle onTimeout iactive

120142 reaperAdd mgr h

121143 return h

@@ -149,20 +171,28 @@ mkWeakThreadId t@(ThreadId t#) = IO $ \s ->

149171

150172----------------------------------------------------------------

151173

174+writeCounter :: Int -> Handle -> IO ()

175+#if USE_ATOMIC_PRIMOPS

176+writeCounter i (Handle _ iactive) = C.writeCounter iactive i

177+#else

178+writeCounter i (Handle _ iactive) = writeIORef iactive i

179+#endif

180+{-# INLINE writeCounter #-}

181+

152182-- | Setting the state to active.

153183-- 'Manager' turns active to inactive repeatedly.

154184tickle :: Handle -> IO ()

155−tickle (Handle _ iactive) = C.writeCounter iactive 1

185+tickle = writeCounter 1

156186

157187-- | Setting the state to canceled.

158188-- 'Manager' eventually removes this without timeout action.

159189cancel :: Handle -> IO ()

160−cancel (Handle _ iactive) = C.writeCounter iactive 4

190+cancel = writeCounter 4

161191

162192-- | Setting the state to paused.

163193-- 'Manager' does not change the value.

164194pause :: Handle -> IO ()

165−pause (Handle _ iactive) = C.writeCounter iactive 3

195+pause = writeCounter 3

166196

167197-- | Setting the paused state to active.

168198-- This is an alias to 'tickle'.

warp/warp.cabal+9−3

@@ -1,5 +1,5 @@

11Name: warp

2−Version: 3.0.2.1

2+Version: 3.0.2.2

33Synopsis: A fast, light-weight web server for WAI applications.

44License: MIT

55License-file: LICENSE

@@ -52,7 +52,10 @@ Library

5252 , wai >= 3.0 && < 3.1

5353 , text

5454 , streaming-commons >= 0.1.2

55− , atomic-primops >= 0.6

55+

56+ if impl(ghc >= 7.8)

57+ Build-Depends: atomic-primops >= 0.6

58+ cpp-options: -DUSE_ATOMIC_PRIMOPS

5659 if flag(network-bytestring)

5760 Build-Depends: network >= 2.2.1.5 && < 2.2.3

5861 , network-bytestring >= 0.1.3 && < 0.1.4

@@ -144,7 +147,10 @@ Test-Suite spec

144147 , text

145148 , streaming-commons >= 0.1.1

146149 , async

147− , atomic-primops

150+

151+ if impl(ghc >= 7.8)

152+ Build-Depends: atomic-primops >= 0.6

153+ cpp-options: -DUSE_ATOMIC_PRIMOPS

148154

149155 if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)

150156 Cpp-Options: -DSENDFILEFD