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:
Joey Hess 2012-01-29 22:55:06 -04:00
parent 0609e10239
commit a964012fc3
5 changed files with 30 additions and 16 deletions

View file

@ -26,7 +26,7 @@ module Annex (
fromRepo, fromRepo,
) where ) where
import Control.Monad.State import Control.Monad.State.Strict
import Control.Monad.Trans.Control (StM, MonadBaseControl, liftBaseWith, restoreM) import Control.Monad.Trans.Control (StM, MonadBaseControl, liftBaseWith, restoreM)
import Control.Monad.Base (liftBase, MonadBase) import Control.Monad.Base (liftBase, MonadBase)
import System.Posix.Types (Fd) import System.Posix.Types (Fd)
@ -41,6 +41,7 @@ import qualified Types.Remote
import Types.Crypto import Types.Crypto
import Types.BranchState import Types.BranchState
import Types.TrustLevel import Types.TrustLevel
import Utility.State
import qualified Utility.Matcher import qualified Utility.Matcher
import qualified Data.Map as M import qualified Data.Map as M
@ -125,18 +126,6 @@ run s a = runStateT (runAnnex a) s
eval :: AnnexState -> Annex a -> IO a eval :: AnnexState -> Annex a -> IO a
eval s a = evalStateT (runAnnex a) s 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 -} {- Sets a flag to True -}
setFlag :: String -> Annex () setFlag :: String -> Annex ()
setFlag flag = changeState $ \s -> setFlag flag = changeState $ \s ->

View file

@ -7,7 +7,7 @@
module Command.Status where module Command.Status where
import Control.Monad.State import Control.Monad.State.Strict
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Data.Set (Set) import Data.Set (Set)

View file

@ -3,7 +3,7 @@ module Common (module X) where
import Control.Monad as X hiding (join) import Control.Monad as X hiding (join)
import Control.Monad.IfElse as X import Control.Monad.IfElse as X
import Control.Applicative 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 Control.Exception.Extensible as X (IOException)
import Data.Maybe as X import Data.Maybe as X

View file

@ -13,7 +13,6 @@ module Git.CatFile (
catObject catObject
) where ) where
import Control.Monad.State
import System.Cmd.Utils import System.Cmd.Utils
import System.IO import System.IO
import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Char8 as S

26
Utility/State.hs Normal file
View 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