io-sim-por: renamed ThreadId type to IOSimThreadId

The original type clashes with `ThreadId` type class from `io-classes`
which is in particular annoying when pasting `ControlSchedules` in
`ghci` or counterexamples.

Author: coot

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

@@ -46,6 +46,7 @@ module Control.Monad.IOSim
   , SimEvent (..)
   , SimEventType (..)
   , ThreadLabel
+  , IOSimThreadId (..)
   , Labelled (..)
     -- ** Dynamic Tracing
   , traceM
@@ -324,12 +325,12 @@ data Failure =
        FailureException SomeException
 
        -- | The threads all deadlocked.
-     | FailureDeadlock ![Labelled ThreadId]
+     | FailureDeadlock ![Labelled IOSimThreadId]
 
        -- | The main thread terminated normally but other threads were still
        -- alive, and strict shutdown checking was requested.
        -- See 'runSimStrictShutdown'.
-     | FailureSloppyShutdown [Labelled ThreadId]
+     | FailureSloppyShutdown [Labelled IOSimThreadId]
 
        -- | An exception was thrown while evaluation the trace.
        -- This could be an internal assertion failure of `io-sim` or an
@@ -404,7 +405,7 @@ traceResult strict = unsafePerformIO . eval
 
 -- | Turn 'SimTrace' into a list of timestamped events.
 --
-traceEvents :: SimTrace a -> [(Time, ThreadId, Maybe ThreadLabel, SimEventType)]
+traceEvents :: SimTrace a -> [(Time, IOSimThreadId, Maybe ThreadLabel, SimEventType)]
 traceEvents (SimTrace time tid tlbl event t)      = (time, tid, tlbl, event)
                                                   : traceEvents t
 traceEvents (SimPORTrace time tid _ tlbl event t) = (time, tid, tlbl, event)
@@ -414,7 +415,7 @@ traceEvents _                                     = []
 
 -- | Pretty print a timestamped event.
 --
-ppEvents :: [(Time, ThreadId, Maybe ThreadLabel, SimEventType)]
+ppEvents :: [(Time, IOSimThreadId, Maybe ThreadLabel, SimEventType)]
          -> String
 ppEvents events =
     intercalate "\n"
@@ -547,7 +548,7 @@ exploreSimTrace optsf mainAction k =
       [ n `div` k + if i < n `mod` k then 1 else 0
       | i <- [0..k-1] ]
 
-    showThread :: (ThreadId,Maybe ThreadLabel) -> String
+    showThread :: (IOSimThreadId,Maybe ThreadLabel) -> String
     showThread (tid,lab) =
       ppIOSimThreadId tid ++ (case lab of Nothing -> ""
                                           Just l  -> " ("++l++")")
@@ -661,8 +662,8 @@ raceReversals ControlFollow{}     = error "Impossible: raceReversals ControlFoll
 compareTracesST :: forall a b s.
                    Maybe (SimTrace a) -- ^ passing
                 -> SimTrace b         -- ^ failing
-                -> ST s ( ST s (Maybe ( (Time, ThreadId, Maybe ThreadLabel)
-                                      , Set.Set (ThreadId, Maybe ThreadLabel)
+                -> ST s ( ST s (Maybe ( (Time, IOSimThreadId, Maybe ThreadLabel)
+                                      , Set.Set (IOSimThreadId, Maybe ThreadLabel)
                                       ))
                         , SimTrace b
                         )
@@ -674,8 +675,8 @@ compareTracesST (Just passing) trace = do
          , trace'
          )
   where
-        go :: STRef s (Maybe ( (Time, ThreadId, Maybe ThreadLabel)
-                             , Set.Set (ThreadId, Maybe ThreadLabel)
+        go :: STRef s (Maybe ( (Time, IOSimThreadId, Maybe ThreadLabel)
+                             , Set.Set (IOSimThreadId, Maybe ThreadLabel)
                              ))
            -> SimTrace a -- ^ passing
            -> SimTrace b -- ^ failing
@@ -693,10 +694,10 @@ compareTracesST (Just passing) trace = do
         go _ _ SimTrace {} = error "compareTracesST: invariant violation"
         go _ _ fail = return fail
 
-        wakeup :: STRef s (Maybe ( (Time, ThreadId, Maybe ThreadLabel)
-                                 , Set.Set (ThreadId, Maybe ThreadLabel)
+        wakeup :: STRef s (Maybe ( (Time, IOSimThreadId, Maybe ThreadLabel)
+                                 , Set.Set (IOSimThreadId, Maybe ThreadLabel)
                                  ))
-               -> ThreadId
+               -> IOSimThreadId
                -> SimTrace b
                -> ST s (SimTrace b)
         wakeup sleeper tidpass

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

@@ -7,7 +7,23 @@
 
 -- | Common types shared between `IOSim` and `IOSimPOR`.
 --
-module Control.Monad.IOSim.CommonTypes where
+module Control.Monad.IOSim.CommonTypes
+  ( IOSimThreadId (..)
+  , childThreadId
+  , setRacyThread
+  , TVarId (..)
+  , TimeoutId (..)
+  , ClockId (..)
+  , VectorClock (..)
+  , unTimeoutId
+  , ThreadLabel
+  , TVarLabel
+  , TVar (..)
+  , SomeTVar (..)
+  , Deschedule (..)
+  , ThreadStatus (..)
+  , BlockedReason (..)
+  ) where
 
 import           Control.DeepSeq (NFData (..))
 import           Control.Monad.Class.MonadSTM (TraceValue)
@@ -28,26 +44,26 @@ import           GHC.Generics
 -- `Control.Monad.Class.MonadTest.exploreRaces` was
 -- executed in it or it's a thread forked by a racy thread.
 --
-data ThreadId = RacyThreadId [Int]
-              | ThreadId     [Int]    -- non racy threads have higher priority
+data IOSimThreadId = RacyThreadId [Int]
+                   | ThreadId     [Int]    -- non racy threads have higher priority
   deriving stock    (Eq, Ord, Show, Generic)
   deriving anyclass NFData
   deriving anyclass NoThunks
 
 
-childThreadId :: ThreadId -> Int -> ThreadId
+childThreadId :: IOSimThreadId -> Int -> IOSimThreadId
 childThreadId (RacyThreadId is) i = RacyThreadId (is ++ [i])
 childThreadId (ThreadId     is) i = ThreadId     (is ++ [i])
 
-setRacyThread :: ThreadId -> ThreadId
+setRacyThread :: IOSimThreadId -> IOSimThreadId
 setRacyThread (ThreadId is)      = RacyThreadId is
 setRacyThread tid@RacyThreadId{} = tid
 
 
 newtype TVarId      = TVarId    Int   deriving (Eq, Ord, Enum, Show)
 newtype TimeoutId   = TimeoutId Int   deriving (Eq, Ord, Enum, Show)
 newtype ClockId     = ClockId   [Int] deriving (Eq, Ord, Show)
-newtype VectorClock = VectorClock { getVectorClock :: Map ThreadId Int }
+newtype VectorClock = VectorClock { getVectorClock :: Map IOSimThreadId Int }
   deriving Show
 
 unTimeoutId :: TimeoutId -> Int
@@ -80,7 +96,7 @@ data TVar s a = TVar {
        -- To avoid duplicates efficiently, the operations rely on a copy of the
        -- thread Ids represented as a set.
        --
-       tvarBlocked :: !(STRef s ([ThreadId], Set ThreadId)),
+       tvarBlocked :: !(STRef s ([IOSimThreadId], Set IOSimThreadId)),
 
        -- | The vector clock of the current value.
        --

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

@@ -26,7 +26,7 @@ module Control.Monad.IOSim.Internal
   , TimeoutException (..)
   , EventlogEvent (..)
   , EventlogMarker (..)
-  , ThreadId
+  , IOSimThreadId
   , ThreadLabel
   , Labelled (..)
   , SimTrace
@@ -83,12 +83,12 @@ import           Control.Monad.IOSim.Types (SimEvent)
 --
 
 data Thread s a = Thread {
-    threadId      :: !ThreadId,
+    threadId      :: !IOSimThreadId,
     threadControl :: !(ThreadControl s a),
     threadStatus  :: !ThreadStatus,
     threadMasking :: !MaskingState,
     -- other threads blocked in a ThrowTo to us because we are or were masked
-    threadThrowTo :: ![(SomeException, Labelled ThreadId)],
+    threadThrowTo :: ![(SomeException, Labelled IOSimThreadId)],
     threadClockId :: !ClockId,
     threadLabel   ::  Maybe ThreadLabel,
     threadNextTId :: !Int
@@ -102,7 +102,7 @@ isThreadBlocked t = case threadStatus t of
 labelledTVarId :: TVar s a -> ST s (Labelled TVarId)
 labelledTVarId TVar { tvarId, tvarLabel } = (Labelled tvarId) <$> readSTRef tvarLabel
 
-labelledThreads :: Map ThreadId (Thread s a) -> [Labelled ThreadId]
+labelledThreads :: Map IOSimThreadId (Thread s a) -> [Labelled IOSimThreadId]
 labelledThreads threadMap =
     -- @Map.foldr'@ (and alikes) are not strict enough, to not ratain the
     -- original thread map we need to evaluate the spine of the list.
@@ -121,11 +121,11 @@ data TimerCompletionInfo s =
      -- ^ `newTimeout` timer.
      | TimerRegisterDelay !(TVar s Bool)
      -- ^ `registerDelay` timer.
-     | TimerThreadDelay !ThreadId !TimeoutId
-     -- ^ `threadDelay` timer run by `ThreadId` which was assigned the given
+     | TimerThreadDelay !IOSimThreadId !TimeoutId
+     -- ^ `threadDelay` timer run by `IOSimThreadId` which was assigned the given
      -- `TimeoutId` (only used to report in a trace).
-     | TimerTimeout !ThreadId !TimeoutId !(TMVar (IOSim s) ThreadId)
-     -- ^ `timeout` timer run by `ThreadId` which was assigned the given
+     | TimerTimeout !IOSimThreadId !TimeoutId !(TMVar (IOSim s) IOSimThreadId)
+     -- ^ `timeout` timer run by `IOSimThreadId` which was assigned the given
      -- `TimeoutId` (only used to report in a trace).
 
 
@@ -134,10 +134,10 @@ type Timeouts s = OrdPSQ TimeoutId Time (TimerCompletionInfo s)
 -- | Internal state.
 --
 data SimState s a = SimState {
-       runqueue :: !(Deque ThreadId),
+       runqueue :: !(Deque IOSimThreadId),
        -- | All threads other than the currently running thread: both running
        -- and blocked threads.
-       threads  :: !(Map ThreadId (Thread s a)),
+       threads  :: !(Map IOSimThreadId (Thread s a)),
        -- | current time
        curTime  :: !Time,
        -- | ordered list of timers and timeouts
@@ -821,7 +821,7 @@ reschedule !simstate@SimState{ threads, timers, curTime = time } =
     timeoutSTMAction TimerThreadDelay{}       = return ()
     timeoutSTMAction TimerTimeout{}           = return ()
 
-unblockThreads :: Bool -> [ThreadId] -> SimState s a -> ([ThreadId], SimState s a)
+unblockThreads :: Bool -> [IOSimThreadId] -> SimState s a -> ([IOSimThreadId], SimState s a)
 unblockThreads !onlySTM !wakeup !simstate@SimState {runqueue, threads} =
     -- To preserve our invariants (that threadBlocked is correct)
     -- we update the runqueue and threads together here
@@ -863,7 +863,7 @@ unblockThreads !onlySTM !wakeup !simstate@SimState {runqueue, threads} =
 -- receive a 'ThreadKilled' exception.
 --
 forkTimeoutInterruptThreads :: forall s a.
-                               [(ThreadId, TimeoutId, TMVar (IOSim s) ThreadId)]
+                               [(IOSimThreadId, TimeoutId, TMVar (IOSim s) IOSimThreadId)]
                             -> SimState s a
                             -> ST s (SimState s a)
 forkTimeoutInterruptThreads timeoutExpired simState =
@@ -883,13 +883,13 @@ 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) IOSimThreadId)] 
 
     (simState', throwToThread) = List.mapAccumR fn simState timeoutExpired 
       where
         fn :: SimState s a
-           -> (ThreadId, TimeoutId, TMVar (IOSim s) ThreadId)
-           -> (SimState s a, (Thread s a, TMVar (IOSim s) ThreadId))
+           -> (IOSimThreadId, TimeoutId, TMVar (IOSim s) IOSimThreadId)
+           -> (SimState s a, (Thread s a, TMVar (IOSim s) IOSimThreadId))
         fn state@SimState { threads } (tid, tmid, lock) =
           let t = case tid `Map.lookup` threads of
                     Just t' -> t'
@@ -1003,13 +1003,13 @@ removeMinimums = \psq ->
           | p == p' -> collectAll (k:ks) p (x:xs) psq'
         _           -> (reverse ks, p, reverse xs, psq)
 
-traceMany :: [(Time, ThreadId, Maybe ThreadLabel, SimEventType)]
+traceMany :: [(Time, IOSimThreadId, Maybe ThreadLabel, SimEventType)]
           -> SimTrace a -> SimTrace a
 traceMany []                      trace = trace
 traceMany ((time, tid, tlbl, event):ts) trace =
     SimTrace time tid tlbl event (traceMany ts trace)
 
-lookupThreadLabel :: ThreadId -> Map ThreadId (Thread s a) -> Maybe ThreadLabel
+lookupThreadLabel :: IOSimThreadId -> Map IOSimThreadId (Thread s a) -> Maybe ThreadLabel
 lookupThreadLabel tid threads = join (threadLabel <$> Map.lookup tid threads)
 
 
@@ -1041,7 +1041,7 @@ runSimTraceST mainAction = schedule mainThread initialState
 
 execAtomically :: forall s a c.
                   Time
-               -> ThreadId
+               -> IOSimThreadId
                -> Maybe ThreadLabel
                -> TVarId
                -> StmA s a
@@ -1341,10 +1341,10 @@ traceTVarST TVar{tvarCurrent, tvarUndo, tvarTrace} new = do
 -- Blocking and unblocking on TVars
 --
 
-readTVarBlockedThreads :: TVar s a -> ST s [ThreadId]
+readTVarBlockedThreads :: TVar s a -> ST s [IOSimThreadId]
 readTVarBlockedThreads TVar{tvarBlocked} = fst <$> readSTRef tvarBlocked
 
-blockThreadOnTVar :: ThreadId -> TVar s a -> ST s ()
+blockThreadOnTVar :: IOSimThreadId -> TVar s a -> ST s ()
 blockThreadOnTVar tid TVar{tvarBlocked} = do
     (tids, tidsSet) <- readSTRef tvarBlocked
     when (tid `Set.notMember` tidsSet) $ do
@@ -1365,7 +1365,7 @@ unblockAllThreadsFromTVar TVar{tvarBlocked} = do
 -- the var writes that woke them.
 --
 threadsUnblockedByWrites :: [SomeTVar s]
-                         -> ST s ([ThreadId], Map ThreadId (Set (Labelled TVarId)))
+                         -> ST s ([IOSimThreadId], Map IOSimThreadId (Set (Labelled TVarId)))
 threadsUnblockedByWrites written = do
   !tidss <- sequence
              [ (,) <$> labelledTVarId tvar <*> readTVarBlockedThreads tvar

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

@@ -15,7 +15,7 @@ import           Control.Exception (Exception)
 import           Control.Concurrent.Class.MonadSTM
 import           Control.Monad.Class.MonadThrow (MaskingState (..))
 
-import           Control.Monad.IOSim.Types (IOSim (..), SimA (..), ThreadId, TimeoutId)
+import           Control.Monad.IOSim.Types (IOSim (..), SimA (..), IOSimThreadId, TimeoutId)
 
 import           GHC.Exts (oneShot)
 
@@ -43,7 +43,7 @@ data ControlStack s b a where
              -> !(ControlStack s c a)
              -> ControlStack s b a
   TimeoutFrame :: TimeoutId
-               -> TMVar (IOSim s) ThreadId
+               -> TMVar (IOSim s) IOSimThreadId
                -> (Maybe b -> SimA s c)
                -> !(ControlStack s c a)
                -> ControlStack s b a
@@ -74,7 +74,7 @@ data ControlStackDash =
   | DelayFrame' TimeoutId ControlStackDash
   deriving Show
 
-data IsLocked = NotLocked | Locked !ThreadId
+data IsLocked = NotLocked | Locked !IOSimThreadId
   deriving (Eq, Show)
 
 -- | Unsafe method which removes a timeout.