f5339d8 · typeable/wai

git.iko.soy/typeable/wai

Attempt to speed up AutoUpdate for high concurrency.

The goal is to get rid of any situations where multiple threads will be spawned due to concurrent calls to the action. To do this, we take advantage of unsafePerformIO. This allows us to keep a single atomicModifyIORef call, which will always either: 1. Get the current value from the AutoUpdated constructor. 2. Spawn a new thread and calculate a new value in a separate thunk, and *immediately* return a new AutoUpdated constructor so that future calls will immediately get the same generated value. However, since the value is in fact an IO action in a thunk, future threads will all block for that single value to be calculated. Since unsafePerformIO does automatically applies non-duplication, we know the action will only be run once. 3. Decide that it's not yet time to do automatic updating, and return a ManualUpdates with a Manual action.

commitf5339d8447090401da6acdc6d433005af473e546 authorMichael Snoyman <michael@snoyman.com> dateWed 1 Oct 2014, 07:50 (12 years ago) parent1b6e42e

1 file changed+11−17

compare with master

unifiedsplit

auto-update/Control/AutoUpdate.hs+11−17

auto-update/Control/AutoUpdate.hs+11−17

@@ -23,6 +23,7 @@ module Control.AutoUpdate (

2323 , mkAutoUpdate

2424 ) where

2525

26+import Control.Applicative ((<$>), (<*>))

2627import Control.AutoUpdate.Util (atomicModifyIORef')

2728import Control.Concurrent (ThreadId, forkIO, myThreadId, threadDelay)

2829import Control.Exception (Exception, SomeException

@@ -30,6 +31,7 @@ import Control.Exception (Exception, SomeException

3031import Control.Monad (forever, join)

3132import Data.IORef (IORef, newIORef)

3233import Data.Typeable (Typeable)

34+import System.IO.Unsafe (unsafePerformIO)

3335

3436-- | Default value for creating an @UpdateSettings@.

3537--

@@ -94,7 +96,7 @@ mkAutoUpdate us = do

9496 istatus <- newIORef $ ManualUpdates 0

9597 return $! getCurrent us istatus

9698

97−data Action a = Return a | Manual | Spawn

99+data Action a = Return a | Manual

98100

99101data Replaced = Replaced deriving (Show, Typeable)

100102instance Exception Replaced

@@ -111,24 +113,16 @@ getCurrent settings@UpdateSettings{..} istatus = do

111113 case ea of

112114 Return a -> return a

113115 Manual -> updateAction

114− Spawn -> do

115− a <- updateAction

116− tid <- forkIO $ spawn settings istatus

117− join $ atomicModifyIORef' istatus $ turnToAuto a tid

118− return a

119116 where

120117 increment (AutoUpdated a cnt tid) = (AutoUpdated a (cnt + 1) tid, Return a)

121− increment (ManualUpdates i) = (ManualUpdates (i + 1), act)

122− where

123− act = if i > updateSpawnThreshold then Spawn else Manual

124−

125− -- Normal case.

126− turnToAuto a tid (ManualUpdates cnt) = (AutoUpdated a cnt tid

127− ,return ())

128− -- Race condition: multiple threads were spawned.

129− -- So, let's kill the previous one by this thread.

130− turnToAuto a tid (AutoUpdated _ cnt old) = (AutoUpdated a cnt tid

131− ,throwTo old Replaced)

118+ increment (ManualUpdates i)

119+ | i > updateSpawnThreshold =

120+ let (a, tid) =

121+ unsafePerformIO $ (,)

122+ <$> updateAction

123+ <*> forkIO (spawn settings istatus)

124+ in (AutoUpdated a (i + 1) tid, Return a)

125+ | otherwise = (ManualUpdates (i + 1), Manual)

132126

133127spawn :: UpdateSettings a -> IORef (Status a) -> IO ()

134128spawn UpdateSettings{..} istatus = handle (onErr istatus) $ forever $ do