barrucadu/dejafu
1
1
Fork 0
mirror of https://github.com/barrucadu/dejafu.git synced 2024-12-19 19:41:31 +03:00
Code Issues Projects Releases Wiki Activity

Gradually accumulate allThreads in findBacktrack.

Browse Source 
Recomputing it every single time is a waste of effort.
This commit is contained in:
Michael Walker 2015-07-21 14:16:34 +01:00
parent d498ebd355
commit 148cd0a351
1 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
Test/DejaFu/SCT/Internal.hs
View File

@ -102,28 +102,28 @@ findBacktrack :: ([BacktrackStep] -> Int -> ThreadId -> [BacktrackStep])
-> [(NonEmpty (ThreadId, ThreadAction'), [ThreadId])]
-> Trace'
-> [BacktrackStep]
findBacktrack backtrack = go [] where
go bs ((e,i):is) ((d,_,a):ts) =
let this = BacktrackStep { _decision = (d, a), _runnable = map fst . toList $ e, _backtrack = map (\i' -> (i', False)) i }
bs' = doBacktrack (toList e) bs
in go (bs' ++ [this]) is ts
go bs _ _ = bs
findBacktrack backtrack = go [] [] where
go allThreads bs ((e,i):is) ((d,_,a):ts) =
let this = BacktrackStep { _decision = (d, a), _runnable = map fst . toList $ e, _backtrack = map (\i' -> (i', False)) i }
bs' = doBacktrack allThreads (toList e) bs
allThreads' = nub $ allThreads ++ _runnable this
in go allThreads' (bs' ++ [this]) is ts
go _ bs _ _ = bs
doBacktrack enabledThreads bs =
let idxs = [ (maximum is, u)
| (u, n) <- enabledThreads
, v <- allThreads bs
, u /= v
, let is = [ i
| (i, (t, b)) <- zip [0..] $ tidTag (fst . _decision) 0 bs
, t == v
, dependent' (snd $ _decision b) (u, n)
]
, not $ null is] :: [(Int, ThreadId)]
doBacktrack allThreads enabledThreads bs =
let tagged = zip [0..] $ tidTag (fst . _decision) 0 bs
idxs = [ (maximum is, u)
| (u, n) <- enabledThreads
, v <- allThreads
, u /= v
, let is = [ i
| (i, (t, b)) <- tagged
, t == v
, dependent' (snd $ _decision b) (u, n)
]
, not $ null is] :: [(Int, ThreadId)]
in foldl' (\bs (i, u) -> backtrack bs i u) bs idxs
allThreads = nub . concatMap _runnable
-- | Add a new trace to the tree, creating a new subtree.
grow :: Bool -> Trace' -> BPOR -> BPOR
grow conservative = grow' initialCVState 0 where