sim: avoid step looking for new actions every time
Once it has a list of actions, it can perform them all. A disappointing optimisation at least in my test case, which it sped up by less than 1 second out of 12. But still it did make it faster.
This commit is contained in:
parent
969e6c2747
commit
eec07aec68
1 changed files with 16 additions and 8 deletions
24
Annex/Sim.hs
24
Annex/Sim.hs
|
@ -491,22 +491,30 @@ handleStep :: Int -> Int -> SimState SimRepo -> Annex (SimState SimRepo)
|
||||||
handleStep startn n st
|
handleStep startn n st
|
||||||
| n > 0 = do
|
| n > 0 = do
|
||||||
let (st', actions) = getactions unsyncactions st
|
let (st', actions) = getactions unsyncactions st
|
||||||
(st'', nothingtodo) <- runoneaction actions st'
|
(st'', restactions) <- runoneaction actions st'
|
||||||
if nothingtodo
|
if null restactions
|
||||||
then do
|
then do
|
||||||
let (st''', actions') = getactions [ActionSync] st''
|
let (st''', actions') = getactions [ActionSync] st''
|
||||||
(st'''', stable) <- runoneaction actions' st'''
|
(st'''', restactions') <- runoneaction actions' st'''
|
||||||
if stable
|
if null restactions'
|
||||||
then do
|
then do
|
||||||
showLongNote $ UnquotedString $
|
showLongNote $ UnquotedString $
|
||||||
"Simulation has stabilized after "
|
"Simulation has stabilized after "
|
||||||
++ show (startn - n)
|
++ show (startn - n)
|
||||||
++ " steps."
|
++ " steps."
|
||||||
return st''''
|
return st''''
|
||||||
else handleStep startn (pred n) st''''
|
else runrest restactions' st'''' (pred n)
|
||||||
else handleStep startn (pred n) st''
|
else runrest restactions st'' (pred n)
|
||||||
| otherwise = return st
|
| otherwise = return st
|
||||||
where
|
where
|
||||||
|
runrest actions st' n'
|
||||||
|
| n > 0 = do
|
||||||
|
(st'', restactions) <- runoneaction actions st'
|
||||||
|
if null restactions
|
||||||
|
then handleStep startn n' st'
|
||||||
|
else runrest restactions st'' (pred n')
|
||||||
|
| otherwise = return st'
|
||||||
|
|
||||||
unsyncactions =
|
unsyncactions =
|
||||||
[ ActionGetWanted
|
[ ActionGetWanted
|
||||||
, ActionSendWanted
|
, ActionSendWanted
|
||||||
|
@ -530,7 +538,7 @@ handleStep startn n st
|
||||||
Right (Right st'') -> getcomponents c st'' as
|
Right (Right st'') -> getcomponents c st'' as
|
||||||
Right (Left (st'', cs)) -> getcomponents (cs:c) st'' as
|
Right (Left (st'', cs)) -> getcomponents (cs:c) st'' as
|
||||||
|
|
||||||
runoneaction [] st' = return (st', True)
|
runoneaction [] st' = return (st', [])
|
||||||
runoneaction actions st' = do
|
runoneaction actions st' = do
|
||||||
let (idx, st'') = simRandom st'
|
let (idx, st'') = simRandom st'
|
||||||
(randomR (0, length actions - 1))
|
(randomR (0, length actions - 1))
|
||||||
|
@ -539,7 +547,7 @@ handleStep startn n st
|
||||||
let restactions = take idx actions ++ drop (idx+1) actions
|
let restactions = take idx actions ++ drop (idx+1) actions
|
||||||
action st'' >>= \case
|
action st'' >>= \case
|
||||||
(st''', False) -> runoneaction restactions st'''
|
(st''', False) -> runoneaction restactions st'''
|
||||||
(st''', True) -> return (st''', False)
|
(st''', True) -> return (st''', restactions)
|
||||||
|
|
||||||
getSimActionComponents
|
getSimActionComponents
|
||||||
:: SimAction
|
:: SimAction
|
||||||
|
|
Loading…
Reference in a new issue