io-sim-por: removed ST effect

ST computations can not be shared by multiple threads, they are always
thread local; which means they never can race with anything else. This
means we don't need to track ST effects, and consider them when checking
if two steps race or not.

Author: coot

io-sim/src/Control/Monad/IOSimPOR/Internal.hs

@@ -378,8 +378,7 @@ schedule thread@Thread{
 
     LiftST st k -> do
       x <- strictToLazyST st
-      let thread' = thread { threadControl = ThreadControl (k x) ctl,
-                             threadEffect  = effect <> liftSTEffect }
+      let thread' = thread { threadControl = ThreadControl (k x) ctl }
       schedule thread' simstate
 
     GetMonoTime k -> do

io-sim/src/Control/Monad/IOSimPOR/Types.hs

@@ -17,18 +17,17 @@ data Effect = Effect {
     effectReads  :: !(Set TVarId),
     effectWrites :: !(Set TVarId),
     effectForks  :: !(Set ThreadId),
-    effectLiftST :: !Bool,
     effectThrows :: ![ThreadId],
     effectWakeup :: ![ThreadId]
   }
   deriving (Eq, Show)
 
 instance Semigroup Effect where
-  Effect r w s b ts wu <> Effect r' w' s' b' ts' wu' =
-    Effect (r<>r') (w<>w') (s<>s') (b||b') (ts++ts') (wu++wu')
+  Effect r w s ts wu <> Effect r' w' s' ts' wu' =
+    Effect (r<>r') (w<>w') (s<>s') (ts++ts') (wu++wu')
 
 instance Monoid Effect where
-  mempty = Effect Set.empty Set.empty Set.empty False [] []
+  mempty = Effect Set.empty Set.empty Set.empty [] []
 
 -- readEffect :: SomeTVar s -> Effect
 -- readEffect r = mempty{effectReads = Set.singleton $ someTvarId r }
@@ -45,9 +44,6 @@ writeEffects rs = mempty{effectWrites = Set.fromList (map someTvarId rs)}
 forkEffect :: ThreadId -> Effect
 forkEffect tid = mempty{effectForks = Set.singleton $ tid}
 
-liftSTEffect :: Effect
-liftSTEffect = mempty{ effectLiftST = True }
-
 throwToEffect :: ThreadId -> Effect
 throwToEffect tid = mempty{ effectThrows = [tid] }
 
@@ -62,9 +58,7 @@ onlyReadEffect e = e { effectReads = effectReads mempty } == mempty
 
 racingEffects :: Effect -> Effect -> Bool
 racingEffects e e' =
-      (effectLiftST e  && racesWithLiftST e')
-   || (effectLiftST e' && racesWithLiftST e )
-   || effectThrows e `intersectsL` effectThrows e'
+      effectThrows e `intersectsL` effectThrows e'
    || effectReads  e `intersects`  effectWrites e'
    || effectWrites e `intersects`  effectReads  e'
    || effectWrites e `intersects`  effectWrites e'
@@ -74,8 +68,3 @@ racingEffects e e' =
 
     intersectsL :: Eq a => [a] -> [a] -> Bool
     intersectsL a b = not $ null $ a `List.intersect` b
-
-    racesWithLiftST eff =
-         effectLiftST eff
-      || not (Set.null (effectReads eff) && Set.null (effectWrites eff))
-