{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}

-- | Common types shared between `IOSim` and `IOSimPOR`.
--
module Control.Monad.IOSim.CommonTypes
  ( IOSimThreadId (..)
  , ppIOSimThreadId
  , StepId
  , ppStepId
  , childThreadId
  , setRacyThread
  , TVarId (..)
  , TimeoutId (..)
  , ClockId (..)
  , VectorClock (..)
  , ppVectorClock
  , unTimeoutId
  , ThreadLabel
  , TVarLabel
  , TVar (..)
  , SomeTVar (..)
  , Deschedule (..)
  , ThreadStatus (..)
  , BlockedReason (..)
    -- * Utils
  , ppList
  ) where

import Control.DeepSeq (NFData (..))
import Control.Monad.Class.MonadSTM (TraceValue)
import Control.Monad.ST.Lazy

import NoThunks.Class

import Data.List (intercalate, intersperse)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.STRef.Lazy
import GHC.Generics
import Quiet


-- | A thread id.
--
-- /IOSimPOR/: 'RacyThreadId' indicates that this thread is taken into account
-- when discovering races.  A thread is marked as racy iff
-- `Control.Monad.Class.MonadTest.exploreRaces` was
-- executed in it or it's a thread forked by a racy thread.
--
data IOSimThreadId =
    -- | A racy thread (`IOSimPOR` only), shown in the trace with curly braces,
    -- e.g. `Thread {2,3}`.
    RacyThreadId [Int]
    -- | A non racy thread.  They have higher priority than racy threads in
    -- `IOSimPOR` scheduler.
  | ThreadId     [Int]
  deriving stock    (IOSimThreadId -> IOSimThreadId -> Bool
(IOSimThreadId -> IOSimThreadId -> Bool)
-> (IOSimThreadId -> IOSimThreadId -> Bool) -> Eq IOSimThreadId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IOSimThreadId -> IOSimThreadId -> Bool
== :: IOSimThreadId -> IOSimThreadId -> Bool
$c/= :: IOSimThreadId -> IOSimThreadId -> Bool
/= :: IOSimThreadId -> IOSimThreadId -> Bool
Eq, Eq IOSimThreadId
Eq IOSimThreadId =>
(IOSimThreadId -> IOSimThreadId -> Ordering)
-> (IOSimThreadId -> IOSimThreadId -> Bool)
-> (IOSimThreadId -> IOSimThreadId -> Bool)
-> (IOSimThreadId -> IOSimThreadId -> Bool)
-> (IOSimThreadId -> IOSimThreadId -> Bool)
-> (IOSimThreadId -> IOSimThreadId -> IOSimThreadId)
-> (IOSimThreadId -> IOSimThreadId -> IOSimThreadId)
-> Ord IOSimThreadId
IOSimThreadId -> IOSimThreadId -> Bool
IOSimThreadId -> IOSimThreadId -> Ordering
IOSimThreadId -> IOSimThreadId -> IOSimThreadId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IOSimThreadId -> IOSimThreadId -> Ordering
compare :: IOSimThreadId -> IOSimThreadId -> Ordering
$c< :: IOSimThreadId -> IOSimThreadId -> Bool
< :: IOSimThreadId -> IOSimThreadId -> Bool
$c<= :: IOSimThreadId -> IOSimThreadId -> Bool
<= :: IOSimThreadId -> IOSimThreadId -> Bool
$c> :: IOSimThreadId -> IOSimThreadId -> Bool
> :: IOSimThreadId -> IOSimThreadId -> Bool
$c>= :: IOSimThreadId -> IOSimThreadId -> Bool
>= :: IOSimThreadId -> IOSimThreadId -> Bool
$cmax :: IOSimThreadId -> IOSimThreadId -> IOSimThreadId
max :: IOSimThreadId -> IOSimThreadId -> IOSimThreadId
$cmin :: IOSimThreadId -> IOSimThreadId -> IOSimThreadId
min :: IOSimThreadId -> IOSimThreadId -> IOSimThreadId
Ord, Int -> IOSimThreadId -> ShowS
[IOSimThreadId] -> ShowS
IOSimThreadId -> String
(Int -> IOSimThreadId -> ShowS)
-> (IOSimThreadId -> String)
-> ([IOSimThreadId] -> ShowS)
-> Show IOSimThreadId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IOSimThreadId -> ShowS
showsPrec :: Int -> IOSimThreadId -> ShowS
$cshow :: IOSimThreadId -> String
show :: IOSimThreadId -> String
$cshowList :: [IOSimThreadId] -> ShowS
showList :: [IOSimThreadId] -> ShowS
Show, (forall x. IOSimThreadId -> Rep IOSimThreadId x)
-> (forall x. Rep IOSimThreadId x -> IOSimThreadId)
-> Generic IOSimThreadId
forall x. Rep IOSimThreadId x -> IOSimThreadId
forall x. IOSimThreadId -> Rep IOSimThreadId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IOSimThreadId -> Rep IOSimThreadId x
from :: forall x. IOSimThreadId -> Rep IOSimThreadId x
$cto :: forall x. Rep IOSimThreadId x -> IOSimThreadId
to :: forall x. Rep IOSimThreadId x -> IOSimThreadId
Generic)
  deriving anyclass IOSimThreadId -> ()
(IOSimThreadId -> ()) -> NFData IOSimThreadId
forall a. (a -> ()) -> NFData a
$crnf :: IOSimThreadId -> ()
rnf :: IOSimThreadId -> ()
NFData
  deriving anyclass Context -> IOSimThreadId -> IO (Maybe ThunkInfo)
Proxy IOSimThreadId -> String
(Context -> IOSimThreadId -> IO (Maybe ThunkInfo))
-> (Context -> IOSimThreadId -> IO (Maybe ThunkInfo))
-> (Proxy IOSimThreadId -> String)
-> NoThunks IOSimThreadId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> IOSimThreadId -> IO (Maybe ThunkInfo)
noThunks :: Context -> IOSimThreadId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IOSimThreadId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> IOSimThreadId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy IOSimThreadId -> String
showTypeOf :: Proxy IOSimThreadId -> String
NoThunks

ppIOSimThreadId :: IOSimThreadId -> String
ppIOSimThreadId :: IOSimThreadId -> String
ppIOSimThreadId (RacyThreadId [Int]
as) = String
"Thread {"String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Context -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((Int -> String) -> [Int] -> Context
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
as) String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"}"
ppIOSimThreadId     (ThreadId [Int]
as) = String
"Thread " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
as

childThreadId :: IOSimThreadId -> Int -> IOSimThreadId
childThreadId :: IOSimThreadId -> Int -> IOSimThreadId
childThreadId (RacyThreadId [Int]
is) Int
i = [Int] -> IOSimThreadId
RacyThreadId ([Int]
is [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i])
childThreadId (ThreadId     [Int]
is) Int
i = [Int] -> IOSimThreadId
ThreadId     ([Int]
is [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i])

setRacyThread :: IOSimThreadId -> IOSimThreadId
setRacyThread :: IOSimThreadId -> IOSimThreadId
setRacyThread (ThreadId [Int]
is)      = [Int] -> IOSimThreadId
RacyThreadId [Int]
is
setRacyThread tid :: IOSimThreadId
tid@RacyThreadId{} = IOSimThreadId
tid

-- | Execution step in `IOSimPOR` is identified by the thread id and
-- a monotonically increasing number (thread specific).
--
type StepId = (IOSimThreadId, Int)

ppStepId :: (IOSimThreadId, Int) -> String
ppStepId :: (IOSimThreadId, Int) -> String
ppStepId (IOSimThreadId
tid, Int
step) | Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                     = Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [IOSimThreadId -> String
ppIOSimThreadId IOSimThreadId
tid, String
".-"]
ppStepId (IOSimThreadId
tid, Int
step) = Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [IOSimThreadId -> String
ppIOSimThreadId IOSimThreadId
tid, String
".", Int -> String
forall a. Show a => a -> String
show Int
step]


newtype TVarId      = TVarId    Int   deriving (TVarId -> TVarId -> Bool
(TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool) -> Eq TVarId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TVarId -> TVarId -> Bool
== :: TVarId -> TVarId -> Bool
$c/= :: TVarId -> TVarId -> Bool
/= :: TVarId -> TVarId -> Bool
Eq, Eq TVarId
Eq TVarId =>
(TVarId -> TVarId -> Ordering)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> Bool)
-> (TVarId -> TVarId -> TVarId)
-> (TVarId -> TVarId -> TVarId)
-> Ord TVarId
TVarId -> TVarId -> Bool
TVarId -> TVarId -> Ordering
TVarId -> TVarId -> TVarId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TVarId -> TVarId -> Ordering
compare :: TVarId -> TVarId -> Ordering
$c< :: TVarId -> TVarId -> Bool
< :: TVarId -> TVarId -> Bool
$c<= :: TVarId -> TVarId -> Bool
<= :: TVarId -> TVarId -> Bool
$c> :: TVarId -> TVarId -> Bool
> :: TVarId -> TVarId -> Bool
$c>= :: TVarId -> TVarId -> Bool
>= :: TVarId -> TVarId -> Bool
$cmax :: TVarId -> TVarId -> TVarId
max :: TVarId -> TVarId -> TVarId
$cmin :: TVarId -> TVarId -> TVarId
min :: TVarId -> TVarId -> TVarId
Ord, Int -> TVarId
TVarId -> Int
TVarId -> [TVarId]
TVarId -> TVarId
TVarId -> TVarId -> [TVarId]
TVarId -> TVarId -> TVarId -> [TVarId]
(TVarId -> TVarId)
-> (TVarId -> TVarId)
-> (Int -> TVarId)
-> (TVarId -> Int)
-> (TVarId -> [TVarId])
-> (TVarId -> TVarId -> [TVarId])
-> (TVarId -> TVarId -> [TVarId])
-> (TVarId -> TVarId -> TVarId -> [TVarId])
-> Enum TVarId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TVarId -> TVarId
succ :: TVarId -> TVarId
$cpred :: TVarId -> TVarId
pred :: TVarId -> TVarId
$ctoEnum :: Int -> TVarId
toEnum :: Int -> TVarId
$cfromEnum :: TVarId -> Int
fromEnum :: TVarId -> Int
$cenumFrom :: TVarId -> [TVarId]
enumFrom :: TVarId -> [TVarId]
$cenumFromThen :: TVarId -> TVarId -> [TVarId]
enumFromThen :: TVarId -> TVarId -> [TVarId]
$cenumFromTo :: TVarId -> TVarId -> [TVarId]
enumFromTo :: TVarId -> TVarId -> [TVarId]
$cenumFromThenTo :: TVarId -> TVarId -> TVarId -> [TVarId]
enumFromThenTo :: TVarId -> TVarId -> TVarId -> [TVarId]
Enum, Int -> TVarId -> ShowS
[TVarId] -> ShowS
TVarId -> String
(Int -> TVarId -> ShowS)
-> (TVarId -> String) -> ([TVarId] -> ShowS) -> Show TVarId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TVarId -> ShowS
showsPrec :: Int -> TVarId -> ShowS
$cshow :: TVarId -> String
show :: TVarId -> String
$cshowList :: [TVarId] -> ShowS
showList :: [TVarId] -> ShowS
Show)
newtype TimeoutId   = TimeoutId Int   deriving (TimeoutId -> TimeoutId -> Bool
(TimeoutId -> TimeoutId -> Bool)
-> (TimeoutId -> TimeoutId -> Bool) -> Eq TimeoutId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeoutId -> TimeoutId -> Bool
== :: TimeoutId -> TimeoutId -> Bool
$c/= :: TimeoutId -> TimeoutId -> Bool
/= :: TimeoutId -> TimeoutId -> Bool
Eq, Eq TimeoutId
Eq TimeoutId =>
(TimeoutId -> TimeoutId -> Ordering)
-> (TimeoutId -> TimeoutId -> Bool)
-> (TimeoutId -> TimeoutId -> Bool)
-> (TimeoutId -> TimeoutId -> Bool)
-> (TimeoutId -> TimeoutId -> Bool)
-> (TimeoutId -> TimeoutId -> TimeoutId)
-> (TimeoutId -> TimeoutId -> TimeoutId)
-> Ord TimeoutId
TimeoutId -> TimeoutId -> Bool
TimeoutId -> TimeoutId -> Ordering
TimeoutId -> TimeoutId -> TimeoutId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimeoutId -> TimeoutId -> Ordering
compare :: TimeoutId -> TimeoutId -> Ordering
$c< :: TimeoutId -> TimeoutId -> Bool
< :: TimeoutId -> TimeoutId -> Bool
$c<= :: TimeoutId -> TimeoutId -> Bool
<= :: TimeoutId -> TimeoutId -> Bool
$c> :: TimeoutId -> TimeoutId -> Bool
> :: TimeoutId -> TimeoutId -> Bool
$c>= :: TimeoutId -> TimeoutId -> Bool
>= :: TimeoutId -> TimeoutId -> Bool
$cmax :: TimeoutId -> TimeoutId -> TimeoutId
max :: TimeoutId -> TimeoutId -> TimeoutId
$cmin :: TimeoutId -> TimeoutId -> TimeoutId
min :: TimeoutId -> TimeoutId -> TimeoutId
Ord, Int -> TimeoutId
TimeoutId -> Int
TimeoutId -> [TimeoutId]
TimeoutId -> TimeoutId
TimeoutId -> TimeoutId -> [TimeoutId]
TimeoutId -> TimeoutId -> TimeoutId -> [TimeoutId]
(TimeoutId -> TimeoutId)
-> (TimeoutId -> TimeoutId)
-> (Int -> TimeoutId)
-> (TimeoutId -> Int)
-> (TimeoutId -> [TimeoutId])
-> (TimeoutId -> TimeoutId -> [TimeoutId])
-> (TimeoutId -> TimeoutId -> [TimeoutId])
-> (TimeoutId -> TimeoutId -> TimeoutId -> [TimeoutId])
-> Enum TimeoutId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TimeoutId -> TimeoutId
succ :: TimeoutId -> TimeoutId
$cpred :: TimeoutId -> TimeoutId
pred :: TimeoutId -> TimeoutId
$ctoEnum :: Int -> TimeoutId
toEnum :: Int -> TimeoutId
$cfromEnum :: TimeoutId -> Int
fromEnum :: TimeoutId -> Int
$cenumFrom :: TimeoutId -> [TimeoutId]
enumFrom :: TimeoutId -> [TimeoutId]
$cenumFromThen :: TimeoutId -> TimeoutId -> [TimeoutId]
enumFromThen :: TimeoutId -> TimeoutId -> [TimeoutId]
$cenumFromTo :: TimeoutId -> TimeoutId -> [TimeoutId]
enumFromTo :: TimeoutId -> TimeoutId -> [TimeoutId]
$cenumFromThenTo :: TimeoutId -> TimeoutId -> TimeoutId -> [TimeoutId]
enumFromThenTo :: TimeoutId -> TimeoutId -> TimeoutId -> [TimeoutId]
Enum, Int -> TimeoutId -> ShowS
[TimeoutId] -> ShowS
TimeoutId -> String
(Int -> TimeoutId -> ShowS)
-> (TimeoutId -> String)
-> ([TimeoutId] -> ShowS)
-> Show TimeoutId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeoutId -> ShowS
showsPrec :: Int -> TimeoutId -> ShowS
$cshow :: TimeoutId -> String
show :: TimeoutId -> String
$cshowList :: [TimeoutId] -> ShowS
showList :: [TimeoutId] -> ShowS
Show)
newtype ClockId     = ClockId   [Int] deriving (ClockId -> ClockId -> Bool
(ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool) -> Eq ClockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClockId -> ClockId -> Bool
== :: ClockId -> ClockId -> Bool
$c/= :: ClockId -> ClockId -> Bool
/= :: ClockId -> ClockId -> Bool
Eq, Eq ClockId
Eq ClockId =>
(ClockId -> ClockId -> Ordering)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> Bool)
-> (ClockId -> ClockId -> ClockId)
-> (ClockId -> ClockId -> ClockId)
-> Ord ClockId
ClockId -> ClockId -> Bool
ClockId -> ClockId -> Ordering
ClockId -> ClockId -> ClockId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ClockId -> ClockId -> Ordering
compare :: ClockId -> ClockId -> Ordering
$c< :: ClockId -> ClockId -> Bool
< :: ClockId -> ClockId -> Bool
$c<= :: ClockId -> ClockId -> Bool
<= :: ClockId -> ClockId -> Bool
$c> :: ClockId -> ClockId -> Bool
> :: ClockId -> ClockId -> Bool
$c>= :: ClockId -> ClockId -> Bool
>= :: ClockId -> ClockId -> Bool
$cmax :: ClockId -> ClockId -> ClockId
max :: ClockId -> ClockId -> ClockId
$cmin :: ClockId -> ClockId -> ClockId
min :: ClockId -> ClockId -> ClockId
Ord, Int -> ClockId -> ShowS
[ClockId] -> ShowS
ClockId -> String
(Int -> ClockId -> ShowS)
-> (ClockId -> String) -> ([ClockId] -> ShowS) -> Show ClockId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClockId -> ShowS
showsPrec :: Int -> ClockId -> ShowS
$cshow :: ClockId -> String
show :: ClockId -> String
$cshowList :: [ClockId] -> ShowS
showList :: [ClockId] -> ShowS
Show)
newtype VectorClock = VectorClock { VectorClock -> Map IOSimThreadId Int
getVectorClock :: Map IOSimThreadId Int }
  deriving (forall x. VectorClock -> Rep VectorClock x)
-> (forall x. Rep VectorClock x -> VectorClock)
-> Generic VectorClock
forall x. Rep VectorClock x -> VectorClock
forall x. VectorClock -> Rep VectorClock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VectorClock -> Rep VectorClock x
from :: forall x. VectorClock -> Rep VectorClock x
$cto :: forall x. Rep VectorClock x -> VectorClock
to :: forall x. Rep VectorClock x -> VectorClock
Generic
  deriving Int -> VectorClock -> ShowS
[VectorClock] -> ShowS
VectorClock -> String
(Int -> VectorClock -> ShowS)
-> (VectorClock -> String)
-> ([VectorClock] -> ShowS)
-> Show VectorClock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VectorClock -> ShowS
showsPrec :: Int -> VectorClock -> ShowS
$cshow :: VectorClock -> String
show :: VectorClock -> String
$cshowList :: [VectorClock] -> ShowS
showList :: [VectorClock] -> ShowS
Show via Quiet VectorClock

ppVectorClock :: VectorClock -> String
ppVectorClock :: VectorClock -> String
ppVectorClock (VectorClock Map IOSimThreadId Int
m) = String
"VectorClock " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> Context -> Context
forall a. a -> [a] -> [a]
intersperse String
", " ((IOSimThreadId, Int) -> String
ppStepId ((IOSimThreadId, Int) -> String)
-> [(IOSimThreadId, Int)] -> Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map IOSimThreadId Int -> [(IOSimThreadId, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList Map IOSimThreadId Int
m)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

unTimeoutId :: TimeoutId -> Int
unTimeoutId :: TimeoutId -> Int
unTimeoutId (TimeoutId Int
a) = Int
a

type ThreadLabel = String
type TVarLabel   = String

data TVar s a = TVar {

       -- | The identifier of this var.
       --
       forall s a. TVar s a -> TVarId
tvarId      :: !TVarId,

       -- | Label.
       forall s a. TVar s a -> STRef s (Maybe String)
tvarLabel   :: !(STRef s (Maybe TVarLabel)),

       -- | The var's current value
       --
       forall s a. TVar s a -> STRef s a
tvarCurrent :: !(STRef s a),

       -- | A stack of undo values. This is only used while executing a
       -- transaction.
       --
       forall s a. TVar s a -> STRef s [a]
tvarUndo    :: !(STRef s [a]),

       -- | Thread Ids of threads blocked on a read of this var. It is
       -- represented in reverse order of thread wakeup, without duplicates.
       --
       -- To avoid duplicates efficiently, the operations rely on a copy of the
       -- thread Ids represented as a set.
       --
       forall s a.
TVar s a -> STRef s ([IOSimThreadId], Set IOSimThreadId)
tvarBlocked :: !(STRef s ([IOSimThreadId], Set IOSimThreadId)),

       -- | The vector clock of the current value.
       --
       forall s a. TVar s a -> STRef s VectorClock
tvarVClock  :: !(STRef s VectorClock),

       -- | Callback to construct a trace which will be attached to the dynamic
       -- trace.
       forall s a.
TVar s a -> STRef s (Maybe (Maybe a -> a -> ST s TraceValue))
tvarTrace   :: !(STRef s (Maybe (Maybe a -> a -> ST s TraceValue)))
     }

instance Eq (TVar s a) where
    TVar {tvarId :: forall s a. TVar s a -> TVarId
tvarId = TVarId
a} == :: TVar s a -> TVar s a -> Bool
== TVar {tvarId :: forall s a. TVar s a -> TVarId
tvarId = TVarId
b} = TVarId
a TVarId -> TVarId -> Bool
forall a. Eq a => a -> a -> Bool
== TVarId
b

data SomeTVar s where
  SomeTVar :: !(TVar s a) -> SomeTVar s

data Deschedule = Yield
                | Interruptable
                | Blocked BlockedReason
                | Terminated
                | Sleep
  deriving Int -> Deschedule -> ShowS
[Deschedule] -> ShowS
Deschedule -> String
(Int -> Deschedule -> ShowS)
-> (Deschedule -> String)
-> ([Deschedule] -> ShowS)
-> Show Deschedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Deschedule -> ShowS
showsPrec :: Int -> Deschedule -> ShowS
$cshow :: Deschedule -> String
show :: Deschedule -> String
$cshowList :: [Deschedule] -> ShowS
showList :: [Deschedule] -> ShowS
Show

data ThreadStatus = ThreadRunning
                  | ThreadBlocked BlockedReason
                  | ThreadDone
  deriving (ThreadStatus -> ThreadStatus -> Bool
(ThreadStatus -> ThreadStatus -> Bool)
-> (ThreadStatus -> ThreadStatus -> Bool) -> Eq ThreadStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ThreadStatus -> ThreadStatus -> Bool
== :: ThreadStatus -> ThreadStatus -> Bool
$c/= :: ThreadStatus -> ThreadStatus -> Bool
/= :: ThreadStatus -> ThreadStatus -> Bool
Eq, Int -> ThreadStatus -> ShowS
[ThreadStatus] -> ShowS
ThreadStatus -> String
(Int -> ThreadStatus -> ShowS)
-> (ThreadStatus -> String)
-> ([ThreadStatus] -> ShowS)
-> Show ThreadStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ThreadStatus -> ShowS
showsPrec :: Int -> ThreadStatus -> ShowS
$cshow :: ThreadStatus -> String
show :: ThreadStatus -> String
$cshowList :: [ThreadStatus] -> ShowS
showList :: [ThreadStatus] -> ShowS
Show)

data BlockedReason = BlockedOnSTM
                   | BlockedOnDelay
                   | BlockedOnThrowTo
  deriving (BlockedReason -> BlockedReason -> Bool
(BlockedReason -> BlockedReason -> Bool)
-> (BlockedReason -> BlockedReason -> Bool) -> Eq BlockedReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockedReason -> BlockedReason -> Bool
== :: BlockedReason -> BlockedReason -> Bool
$c/= :: BlockedReason -> BlockedReason -> Bool
/= :: BlockedReason -> BlockedReason -> Bool
Eq, Int -> BlockedReason -> ShowS
[BlockedReason] -> ShowS
BlockedReason -> String
(Int -> BlockedReason -> ShowS)
-> (BlockedReason -> String)
-> ([BlockedReason] -> ShowS)
-> Show BlockedReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockedReason -> ShowS
showsPrec :: Int -> BlockedReason -> ShowS
$cshow :: BlockedReason -> String
show :: BlockedReason -> String
$cshowList :: [BlockedReason] -> ShowS
showList :: [BlockedReason] -> ShowS
Show)

--
-- Utils
--

ppList :: (a -> String) -> [a] -> String
ppList :: forall a. (a -> String) -> [a] -> String
ppList a -> String
pp [a]
as = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Context -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> Context -> Context
forall a. a -> [a] -> [a]
intersperse String
", " ((a -> String) -> [a] -> Context
forall a b. (a -> b) -> [a] -> [b]
map a -> String
pp [a]
as)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"