io-sim-por: shuffle module structure

The following order makes things easier to read:
* Effects
* Steps
* Races
* Schedule control
* Schedule modifications

Author: coot

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

@@ -105,6 +105,9 @@ data Thread s a = Thread {
   }
   deriving Show
 
+threadStepId :: Thread s a -> (ThreadId, Int)
+threadStepId Thread{ threadId, threadStep } = (threadId, threadStep)
+
 isRacyThreadId :: ThreadId -> Bool
 isRacyThreadId (RacyThreadId _) = True
 isRacyThreadId _                = True
@@ -1215,7 +1218,9 @@ ordNub = go Set.empty
       | x `Set.member` s = go s xs
       | otherwise        = x : go (Set.insert x s) xs
 
+--
 -- Effects
+--
 
 data Effect = Effect {
     effectReads  :: !(Set TVarId),
@@ -1276,7 +1281,9 @@ racingEffects e e' =
              effectLiftST eff
           || not (Set.null (effectReads eff) && Set.null (effectWrites eff))
 
+--
 -- Steps
+--
 
 data Step = Step {
     stepThreadId :: !ThreadId,
@@ -1336,6 +1343,10 @@ data StepInfo = StepInfo {
   }
   deriving Show
 
+--
+-- Races
+--
+
 data Races = Races { -- These steps may still race with future steps
                      activeRaces   :: ![StepInfo],
                      -- These steps cannot be concurrent with future steps
@@ -1467,55 +1478,24 @@ traceRaces r = r
 -- traceRaces r@Races{activeRaces,completeRaces} =
 --   Debug.trace ("Tracking "++show (length (concatMap stepInfoRaces activeRaces)) ++" races") r
 
--- Schedule modifications
-
-stepStepId :: Step -> (ThreadId, Int)
-stepStepId Step{ stepThreadId = tid, stepStep = n } = (tid,n)
-
-threadStepId :: Thread s a -> (ThreadId, Int)
-threadStepId Thread{ threadId, threadStep } = (threadId, threadStep)
-
-stepInfoToScheduleMods :: StepInfo -> [ScheduleMod]
-stepInfoToScheduleMods
-  StepInfo{ stepInfoStep    = step,
-            stepInfoControl = control,
-            stepInfoNonDep  = nondep,
-            stepInfoRaces   = races
-          } =
-  -- It is actually possible for a later step that races with an earlier one
-  -- not to *depend* on it in a happens-before sense. But we don't want to try
-  -- to follow any steps *after* the later one.
-  [ ScheduleMod 
-      { scheduleModTarget    = stepStepId step
-      , scheduleModControl   = control
-      , scheduleModInsertion = takeWhile (/=stepStepId step')
-                                         (map stepStepId (reverse nondep))
-                            ++ [stepStepId step']
-                            -- It should be unnecessary to include the delayed
-                            -- step in the insertion, since the default
-                            -- scheduling should run it anyway. Removing it may
-                            -- help avoid redundant schedules.
-                            -- ++ [stepStepId step]
-      }
-  | step' <- races ]
-
-traceFinalRacesFound :: SimState s a -> SimTrace a -> SimTrace a
-traceFinalRacesFound simstate@SimState{ control0 = control } =
-  TraceRacesFound [extendScheduleControl control m | m <- scheduleMods]
-  where SimState{ races } =
-          quiescentRacesInSimState simstate
-        scheduleMods =
-          concatMap stepInfoToScheduleMods $ completeRaces races
-
 
+--
 -- Schedule control
+--
 
 controlTargets :: StepId -> ScheduleControl -> Bool
 controlTargets stepId
                (ControlAwait (ScheduleMod{ scheduleModTarget }:_)) =
   stepId == scheduleModTarget
 controlTargets _stepId _ = False
 
+followControl :: ScheduleControl -> ScheduleControl
+followControl (ControlAwait (ScheduleMod { scheduleModInsertion } : mods)) =
+               ControlFollow scheduleModInsertion mods
+followControl (ControlAwait []) = error "Impossible: followControl (ControlAwait [])"
+followControl ControlDefault{}  = error "Impossible: followControl ControlDefault{}"
+followControl ControlFollow{}   = error "Impossible: followControl ControlFollow{}"
+
 controlFollows :: StepId -> ScheduleControl -> Bool
 controlFollows _stepId  ControlDefault               = True
 controlFollows _stepId (ControlFollow [] _)          = True
@@ -1545,12 +1525,44 @@ advanceControl stepId control =
   assert (not $ controlTargets stepId control) $
   control
 
-followControl :: ScheduleControl -> ScheduleControl
-followControl (ControlAwait (ScheduleMod { scheduleModInsertion } : mods)) =
-               ControlFollow scheduleModInsertion mods
-followControl (ControlAwait []) = error "Impossible: followControl (ControlAwait [])"
-followControl ControlDefault{}  = error "Impossible: followControl ControlDefault{}"
-followControl ControlFollow{}   = error "Impossible: followControl ControlFollow{}"
+--
+-- Schedule modifications
+--
+
+stepStepId :: Step -> (ThreadId, Int)
+stepStepId Step{ stepThreadId = tid, stepStep = n } = (tid,n)
+
+stepInfoToScheduleMods :: StepInfo -> [ScheduleMod]
+stepInfoToScheduleMods
+  StepInfo{ stepInfoStep    = step,
+            stepInfoControl = control,
+            stepInfoNonDep  = nondep,
+            stepInfoRaces   = races
+          } =
+  -- It is actually possible for a later step that races with an earlier one
+  -- not to *depend* on it in a happens-before sense. But we don't want to try
+  -- to follow any steps *after* the later one.
+  [ ScheduleMod 
+      { scheduleModTarget    = stepStepId step
+      , scheduleModControl   = control
+      , scheduleModInsertion = takeWhile (/=stepStepId step')
+                                         (map stepStepId (reverse nondep))
+                            ++ [stepStepId step']
+                            -- It should be unnecessary to include the delayed
+                            -- step in the insertion, since the default
+                            -- scheduling should run it anyway. Removing it may
+                            -- help avoid redundant schedules.
+                            -- ++ [stepStepId step]
+      }
+  | step' <- races ]
+
+traceFinalRacesFound :: SimState s a -> SimTrace a -> SimTrace a
+traceFinalRacesFound simstate@SimState{ control0 = control } =
+  TraceRacesFound [extendScheduleControl control m | m <- scheduleMods]
+  where SimState{ races } =
+          quiescentRacesInSimState simstate
+        scheduleMods =
+          concatMap stepInfoToScheduleMods $ completeRaces races
 
 -- Extend an existing schedule control with a newly discovered schedule mod
 extendScheduleControl' :: ScheduleControl -> ScheduleMod -> ScheduleControl