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,
|
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 ->
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
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