io-sim-por: code style & comments

Author: coot

io-sim/src/Control/Monad/IOSim.hs

@@ -362,7 +362,7 @@ runSimOrThrow mainAction =
 
 -- | Like 'runSim' but fail when the main thread terminates if there are other
 -- threads still running or blocked. If one is trying to follow a strict thread
--- cleanup policy then this helps testing for that.
+-- clean-up policy then this helps testing for that.
 --
 runSimStrictShutdown :: forall a. (forall s. IOSim s a) -> Either Failure a
 runSimStrictShutdown mainAction = traceResult True (runSimTrace mainAction)
@@ -451,8 +451,8 @@ runSimTrace mainAction = runST (runSimTraceST mainAction)
 -- slot.  In /IOSim/ and /IOSimPOR/ time only moves explicitly through timer
 -- events, e.g. things like `Control.Monad.Class.MonadTimer.SI.threadDelay`,
 -- `Control.Monad.Class.MonadTimer.SI.registerDelay` or the
--- `Control.Monad.Class.MonadTimer.NonStandard.MonadTimeout` api.  The usual
--- quickcheck techniques can help explore different schedules of
+-- `Control.Monad.Class.MonadTimer.NonStandard.MonadTimeout` API.  The usual
+-- QuickCheck techniques can help explore different schedules of
 -- threads too.
 
 -- | Execute a simulation, discover & revert races.  Note that this will execute

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

@@ -424,7 +424,7 @@ schedule !thread@Thread{
       let !expiry  = d `addTime` time
           !timers' = PSQ.insert nextTmid expiry (TimerThreadDelay tid nextTmid) timers
           !thread' = thread { threadControl = ThreadControl (Return ()) (DelayFrame nextTmid k ctl) }
-      !trace <- deschedule (Blocked BlockedOnOther) thread' simstate { timers   = timers'
+      !trace <- deschedule (Blocked BlockedOnDelay) thread' simstate { timers   = timers'
                                                                      , nextTmid = succ nextTmid }
       return (SimTrace time tid tlbl (EventThreadDelay nextTmid expiry) trace)
 
@@ -609,10 +609,10 @@ schedule !thread@Thread{
           -- exception and the source thread id to the pending async exceptions.
           let adjustTarget t = t { threadThrowTo = (e, Labelled tid tlbl) : threadThrowTo t }
               threads'       = Map.adjust adjustTarget tid' threads
-          !trace <- deschedule (Blocked BlockedOnOther) thread' simstate { threads = threads' }
+          !trace <- deschedule (Blocked BlockedOnThrowTo) thread' simstate { threads = threads' }
           return $ SimTrace time tid tlbl (EventThrowTo e tid')
                  $ SimTrace time tid tlbl EventThrowToBlocked
-                 $ SimTrace time tid tlbl (EventDeschedule (Blocked BlockedOnOther))
+                 $ SimTrace time tid tlbl (EventDeschedule (Blocked BlockedOnThrowTo))
                  $ trace
         else do
           -- The target thread has async exceptions unmasked, or is masked but

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

@@ -175,7 +175,7 @@ data TimerCompletionInfo s =
      -- ^ `timeout` timer run by `ThreadId` which was assigned the given
      -- `TimeoutId` (only used to report in a trace).
 
-type RunQueue = OrdPSQ (Down ThreadId) (Down ThreadId) ()
+type RunQueue   = OrdPSQ (Down ThreadId) (Down ThreadId) ()
 type Timeouts s = OrdPSQ TimeoutId Time (TimerCompletionInfo s)
 
 -- | Internal state.
@@ -601,7 +601,7 @@ schedule thread@Thread{
           thread'' = Thread { threadId      = tid'
                             , threadControl = ThreadControl (runIOSim a)
                                                             ForkFrame
-                            , threadStatus  = ThreadRunning 
+                            , threadStatus  = ThreadRunning
                             , threadMasking = threadMasking thread
                             , threadThrowTo = []
                             , threadClockId = threadClockId thread
@@ -1023,7 +1023,7 @@ reschedule simstate@SimState{ threads, timers, curTime = time, races } =
         TimeoutFired     -> error "MonadTimer(Sim): invariant violation"
         TimeoutCancelled -> return ()
     timeoutAction (TimerRegisterDelay var) = writeTVar var True
-    timeoutAction (TimerThreadDelay _ _)    = return ()
+    timeoutAction (TimerThreadDelay _ _)   = return ()
     timeoutAction (TimerTimeout _ _ _)     = return ()
 
 unblockThreads :: forall s a.
@@ -1105,7 +1105,7 @@ forkTimeoutInterruptThreads timeoutExpired simState =
   where
     -- we launch a thread responsible for throwing an AsyncCancelled exception
     -- to the thread which timeout expired
-    throwToThread :: [(Thread s a, TMVar (IOSim s) ThreadId)] 
+    throwToThread :: [(Thread s a, TMVar (IOSim s) ThreadId)]
 
     (simState', throwToThread) = List.mapAccumR fn simState timeoutExpired
       where
@@ -1143,7 +1143,7 @@ forkTimeoutInterruptThreads timeoutExpired simState =
                 , lock
                 )
               )
-       
+
 
 -- | Iterate through the control stack to find an enclosing exception handler
 -- of the right type, or unwind all the way to the top level for the thread.
@@ -1249,10 +1249,10 @@ runSimTraceST mainAction = controlSimTraceST Nothing ControlDefault mainAction
 controlSimTraceST :: Maybe Int -> ScheduleControl -> IOSim s a -> ST s (SimTrace a)
 controlSimTraceST limit control mainAction =
   SimPORTrace (curTime initialState)
-           (threadId mainThread)
-           0
-           (threadLabel mainThread)
-           (EventSimStart control)
+              (threadId mainThread)
+              0
+              (threadLabel mainThread)
+              (EventSimStart control)
   <$> schedule mainThread initialState { control  = control,
                                          control0 = control,
                                          perStepTimeLimit = limit
@@ -1662,6 +1662,7 @@ racingSteps s s' =
      )
   where throwsTo s1 s2 =
              stepThreadId s2 `elem` effectThrows (stepEffect s1)
+          -- `throwTo` races with any other effect
           && stepEffect s2 /= mempty
 
 currentStep :: Thread s a -> Step
@@ -1822,7 +1823,7 @@ updateRaces newStep@Step{ stepThreadId = tid, stepEffect = newEffect }
                       }
 
       activeRaces' :: [StepInfo]
-      !activeRaces' = 
+      !activeRaces' =
         case newStepInfo of
           Nothing ->       updateStepInfo <$> activeRaces
           Just si -> si : (updateStepInfo <$> activeRaces)