mirror of
https://github.com/barrucadu/dejafu.git
synced 2024-12-18 11:01:50 +03:00
Don't consider TVar reads dependent
This commit is contained in:
parent
eb73600b39
commit
30ab912210
@ -7,6 +7,17 @@ This project is versioned according to the [Package Versioning Policy](https://p
|
|||||||
*de facto* standard Haskell versioning scheme.
|
*de facto* standard Haskell versioning scheme.
|
||||||
|
|
||||||
|
|
||||||
|
unreleased
|
||||||
|
----------
|
||||||
|
|
||||||
|
### Miscellaneous
|
||||||
|
|
||||||
|
- Small improvement to dependency detection of STM transactions.
|
||||||
|
|
||||||
|
|
||||||
|
---------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
0.9.0.1
|
0.9.0.1
|
||||||
-------
|
-------
|
||||||
|
|
||||||
|
@ -27,6 +27,8 @@ module Test.DejaFu.Common
|
|||||||
, ThreadAction(..)
|
, ThreadAction(..)
|
||||||
, isBlock
|
, isBlock
|
||||||
, tvarsOf
|
, tvarsOf
|
||||||
|
, tvarsWritten
|
||||||
|
, tvarsRead
|
||||||
-- ** Lookahead
|
-- ** Lookahead
|
||||||
, Lookahead(..)
|
, Lookahead(..)
|
||||||
, rewind
|
, rewind
|
||||||
@ -410,18 +412,39 @@ isBlock _ = False
|
|||||||
--
|
--
|
||||||
-- @since 0.4.0.0
|
-- @since 0.4.0.0
|
||||||
tvarsOf :: ThreadAction -> Set TVarId
|
tvarsOf :: ThreadAction -> Set TVarId
|
||||||
tvarsOf act = S.fromList $ case act of
|
tvarsOf act = tvarsRead act `S.union` tvarsWritten act
|
||||||
|
|
||||||
|
-- | Get the @TVar@s a transaction wrote to (or would have, if it
|
||||||
|
-- didn't @retry@).
|
||||||
|
--
|
||||||
|
-- @since unreleased
|
||||||
|
tvarsWritten :: ThreadAction -> Set TVarId
|
||||||
|
tvarsWritten act = S.fromList $ case act of
|
||||||
STM trc _ -> concatMap tvarsOf' trc
|
STM trc _ -> concatMap tvarsOf' trc
|
||||||
BlockedSTM trc -> concatMap tvarsOf' trc
|
BlockedSTM trc -> concatMap tvarsOf' trc
|
||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
where
|
where
|
||||||
tvarsOf' (TRead tv) = [tv]
|
|
||||||
tvarsOf' (TWrite tv) = [tv]
|
tvarsOf' (TWrite tv) = [tv]
|
||||||
tvarsOf' (TOrElse ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
|
tvarsOf' (TOrElse ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
|
||||||
tvarsOf' (TCatch ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
|
tvarsOf' (TCatch ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
|
||||||
tvarsOf' _ = []
|
tvarsOf' _ = []
|
||||||
|
|
||||||
|
-- | Get the @TVar@s a transaction read from.
|
||||||
|
--
|
||||||
|
-- @since unreleased
|
||||||
|
tvarsRead :: ThreadAction -> Set TVarId
|
||||||
|
tvarsRead act = S.fromList $ case act of
|
||||||
|
STM trc _ -> concatMap tvarsOf' trc
|
||||||
|
BlockedSTM trc -> concatMap tvarsOf' trc
|
||||||
|
_ -> []
|
||||||
|
|
||||||
|
where
|
||||||
|
tvarsOf' (TRead tv) = [tv]
|
||||||
|
tvarsOf' (TOrElse ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
|
||||||
|
tvarsOf' (TCatch ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
|
||||||
|
tvarsOf' _ = []
|
||||||
|
|
||||||
---------------------------------------
|
---------------------------------------
|
||||||
-- Lookahead
|
-- Lookahead
|
||||||
|
|
||||||
|
@ -605,15 +605,21 @@ dependent memtype ds t1 a1 t2 a2 = case (a1, a2) of
|
|||||||
-- Dependency of STM transactions can be /greatly/ improved here, as
|
-- Dependency of STM transactions can be /greatly/ improved here, as
|
||||||
-- the 'Lookahead' does not know which @TVar@s will be touched, and
|
-- the 'Lookahead' does not know which @TVar@s will be touched, and
|
||||||
-- so has to assume all transactions are dependent.
|
-- so has to assume all transactions are dependent.
|
||||||
(STM _ _, STM _ _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2
|
(STM _ _, STM _ _) -> checkSTM
|
||||||
(STM _ _, BlockedSTM _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2
|
(STM _ _, BlockedSTM _) -> checkSTM
|
||||||
(BlockedSTM _, STM _ _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2
|
(BlockedSTM _, STM _ _) -> checkSTM
|
||||||
(BlockedSTM _, BlockedSTM _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2
|
(BlockedSTM _, BlockedSTM _) -> checkSTM
|
||||||
|
|
||||||
_ -> case (,) <$> rewind a1 <*> rewind a2 of
|
_ -> case (,) <$> rewind a1 <*> rewind a2 of
|
||||||
Just (l1, l2) -> dependent' memtype ds t1 a1 t2 l2 && dependent' memtype ds t2 a2 t1 l1
|
Just (l1, l2) -> dependent' memtype ds t1 a1 t2 l2 && dependent' memtype ds t2 a2 t1 l1
|
||||||
_ -> dependentActions memtype ds (simplifyAction a1) (simplifyAction a2)
|
_ -> dependentActions memtype ds (simplifyAction a1) (simplifyAction a2)
|
||||||
|
|
||||||
|
where
|
||||||
|
-- STM actions A and B are dependent if A wrote to anything B
|
||||||
|
-- touched, or vice versa.
|
||||||
|
checkSTM = checkSTM' a1 a2 || checkSTM' a2 a1
|
||||||
|
checkSTM' a b = not . S.null $ tvarsWritten a `S.intersection` tvarsOf b
|
||||||
|
|
||||||
-- | Variant of 'dependent' to handle 'Lookahead'.
|
-- | Variant of 'dependent' to handle 'Lookahead'.
|
||||||
--
|
--
|
||||||
-- Termination of the initial thread is handled specially in the DPOR
|
-- Termination of the initial thread is handled specially in the DPOR
|
||||||
|
Loading…
Reference in New Issue
Block a user