switch to the strict state monad
I had not realized what a memory leak the lazy state monad could be, although I have not seen much evidence of actual leaking in git-annex. However, if running git-annex on a great many files, this could matter. The additional Utility.State.changeState adds even more strictness, avoiding a problem I saw in github-backup where repeatedly modifying state built up a huge pile of thunks.
This commit is contained in:
parent
0609e10239
commit
a964012fc3
5 changed files with 30 additions and 16 deletions
15
Annex.hs
15
Annex.hs
|
@ -26,7 +26,7 @@ module Annex (
|
|||
fromRepo,
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Control.Monad.State.Strict
|
||||
import Control.Monad.Trans.Control (StM, MonadBaseControl, liftBaseWith, restoreM)
|
||||
import Control.Monad.Base (liftBase, MonadBase)
|
||||
import System.Posix.Types (Fd)
|
||||
|
@ -41,6 +41,7 @@ import qualified Types.Remote
|
|||
import Types.Crypto
|
||||
import Types.BranchState
|
||||
import Types.TrustLevel
|
||||
import Utility.State
|
||||
import qualified Utility.Matcher
|
||||
import qualified Data.Map as M
|
||||
|
||||
|
@ -125,18 +126,6 @@ run s a = runStateT (runAnnex a) s
|
|||
eval :: AnnexState -> Annex a -> IO a
|
||||
eval s a = evalStateT (runAnnex a) s
|
||||
|
||||
{- Gets a value from the internal state, selected by the passed value
|
||||
- constructor. -}
|
||||
getState :: (AnnexState -> a) -> Annex a
|
||||
getState = gets
|
||||
|
||||
{- Applies a state mutation function to change the internal state.
|
||||
-
|
||||
- Example: changeState $ \s -> s { output = QuietOutput }
|
||||
-}
|
||||
changeState :: (AnnexState -> AnnexState) -> Annex ()
|
||||
changeState = modify
|
||||
|
||||
{- Sets a flag to True -}
|
||||
setFlag :: String -> Annex ()
|
||||
setFlag flag = changeState $ \s ->
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Status where
|
||||
|
||||
import Control.Monad.State
|
||||
import Control.Monad.State.Strict
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Data.Set (Set)
|
||||
|
|
|
@ -3,7 +3,7 @@ module Common (module X) where
|
|||
import Control.Monad as X hiding (join)
|
||||
import Control.Monad.IfElse as X
|
||||
import Control.Applicative as X
|
||||
import Control.Monad.State as X (liftIO)
|
||||
import Control.Monad.State.Strict as X (liftIO)
|
||||
import Control.Exception.Extensible as X (IOException)
|
||||
|
||||
import Data.Maybe as X
|
||||
|
|
|
@ -13,7 +13,6 @@ module Git.CatFile (
|
|||
catObject
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import System.Cmd.Utils
|
||||
import System.IO
|
||||
import qualified Data.ByteString.Char8 as S
|
||||
|
|
26
Utility/State.hs
Normal file
26
Utility/State.hs
Normal file
|
@ -0,0 +1,26 @@
|
|||
{- state monad support
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Utility.State where
|
||||
|
||||
import Control.Monad.State.Strict
|
||||
|
||||
{- Modifies Control.Monad.State's state, forcing a strict update.
|
||||
- This avoids building thunks in the state and leaking.
|
||||
- Why it's not the default, I don't know.
|
||||
-
|
||||
- Example: changeState $ \s -> s { foo = bar }
|
||||
-}
|
||||
changeState :: MonadState s m => (s -> s) -> m ()
|
||||
changeState f = do
|
||||
x <- get
|
||||
put $! f x
|
||||
|
||||
{- Gets a value from the internal state, selected by the passed value
|
||||
- constructor. -}
|
||||
getState :: MonadState s m => (s -> a) -> m a
|
||||
getState = gets
|
Loading…
Reference in a new issue