input-output-hk / io-sim

Haskell's IO simulator which closely follows core packages (base, async, stm).

io-sim

IOSim is a simulator monad that supports:

• asynchronous exceptions
• simulated time
• timeout API
• software transaction memory (STM)
• concurrency: both low-level forkIO as well as async style
• strict STM
• access to lazy ST
• schedule discovery (see IOSimPOR)
• event log
• dynamic tracing
• tracing committed changes to TVar, TMVars, etc.
• labeling of threads, TVar's, etc.

io-classes provides an interface, which allows writing code that can be run in both real IO and IOSim. It is a drop-in replacement for IO, and supports interfaces commonly known from base, exceptions, stm, async, or time packages.

One of the principles of io-classes was to stay as close to IO as possible, thus most of the IO instances are directly referring to base or async API. However, we made some distinctions, which are reported below.

io-classes supports a novel hierarchy for error-handling monads as well as more familiar exception style. The new hierarchy provides bracket and finally functions in the MonadThrow class, while catch style operators are provided by a super-class MonadCatch. Both bracket and finally are the most common functions used to write code with robust exception handling, exposing them through the more basic MonadThrow class informs the reader / reviewer that no tricky error handling is done in that section of the code base.

IOSim exposes a detailed trace, which can be enhanced by labeling threads, or mutable variables, tracing Dynamic values (which can be recovered from the trace), or simple String based tracing. Although it's agnostic concerning the logging framework, it worked for us particularly well using contra-tracer. It has been used to develop, test, and debug a complex, highly concurrent, distributed system (ouroboros-network), in particular

• write network simulations, to verify a complex networking stack;
• write disk IO simulations, to verify a database implementation.

Supporting material

• Philipp Kant (@kantp) at Bobconf 2022
• Armando Santos (@bolt12) at ZuriHac 2022

Packages

• io-sim: provides two simulator interpreters: IOSim and IOSimPOR - an enhanced IOSim version with schedule discovery capabilities.
• io-classes: class bases interface, which allows to to abstract over the monad
• [strict-stm]: strict STM operations
• [si-timers]: non-standard timers API

Issues

New issues should be reported in this repository.

io-sim's Issues

fused-effects + GenServer + LinearType + IOSim = COOL!!

https://github.com/EMQ-YangM/fused-effects-process/blob/master/src/Control/Effect/T.hs

io-sim is very useful. Thanks for making such a useful thing.

Control.Monad.IOSim.STM.isEmptyTBQueueDefault

Describe the bug

The implementation of Control.Monad.IOSim.STM.isEmptyTBQueueDefault is wrong.

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

Line 172 in 0df93fe

isEmptyTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool

Additional context

-- wrong
isEmptyTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault (TBQueue queue _size) = do
  (xs, _, _, _) <- readTVar queue
  case xs of
    _:_ -> return False
    []  -> return True
----------------------------------------


-- right
isEmptyTBQueueDefault :: MonadSTM m => TBQueueDefault m a -> STM m Bool
isEmptyTBQueueDefault (TBQueue queue _size) = do
  (xs, _, ys, _) <- readTVar queue
  case xs of
    (_:_) -> return False
    [] -> case ys of
               [] -> return True
               _  -> return False

pr: #44
@coot

Export registerDelay from `...MonadSTM.TVar`

stm package exports it from Control.Concurrent.STM.TVar module, we ought to do the same after #24 and #9 are merged.

Make it possible to generate schedules

I understand that running IOSim s computations is purely deterministic: Every run will trigger the exact same scheduling of threads. This is great as it provides fast execution, but unless one wants to invest time and energy in IOSimPOR it does not actually help us spot the kind of problems in concurrent code stemming from "surprising" reordering of executions.

It seems to me that quick-checking code with IOSim would be even more powerful if the runtime was able to randomly select among runnable actions, generating and covering more possible execution schedules. I have only a vague understanding of io-sim's internals but this could be exposed at the API level through a function with an additional argument, like:

runSimTraceRandom :: forall g a . RandomGen g => g -> (forall s . IOSim s a) -> Trace a

Are you willing to implement it?

• Are you? 😃

Publishing IOSim on Hackage

`propExploration` test failure

      propExploration:                         FAIL (743.31s)
        *** Failed! Falsified (after 52 tests and 76 shrinks):
        AreNotEqual
        Shrink2 {getShrink2 = Tasks [Task [WhenSet 0 0],Task [],Task [ThrowTo 1],Task [WhenSet 0 0,ThrowTo 1],Task [ThrowTo 1],Task [ThrowTo 1,WhenSet 1 1]]}
        Schedule control: ControlAwait [ScheduleMod (RacyThreadId [5],2) ControlDefault [(RacyThreadId [4],0),(RacyThreadId [4],1),(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [3],2),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [1],2),(RacyThreadId [4],2),(RacyThreadId [4],3)]]
        Thread {5} (5) delayed at time Time 0s
          until after:
            Thread {1}
            Thread {1} (1)
            Thread {2}
            Thread {3}
            Thread {3} (3)
            Thread {4}
            Thread {4} (4)

        (...)

        InternalError "assertion failure: Thread {4} not runnable"
        assertion failure: Thread {4} not runnable
        Use --quickcheck-replay=564358 to reproduce.
        Use -p '/propExploration/' to rerun this test only.

full-log.txt

Publish io-sim and io-classes on Hackage

Packages

The list of packages to be published includes:

• io-classes
• io-sim
• strict-stm
• si-timers
• io-classes-mtl

Objective

Related issues are tracked in this project:

• essential: necessary to be done before publishing on Hackage
• optional: optional to be done before publishing on Hackage

Non exhaustive list of PRs

For recent work items to do look at the [project]((https://github.com/orgs/input-output-hk/projects/19/views/24).

• #10
• #17
• #20
• #24
• #25
• #27
• #32
• #39
• #40
• #41
• #16
• #35
• #9
• #47
• #57
• #60

Risks

none

Dependencies

none

Possible bug in MVar implementation

Describe the bug
Snippet of code in question when using MVar's deadlock. After just switching to TMVar's it runs fine.

To Reproduce
Run tests in this revision: IntersectMBO/ouroboros-network@4297c81 and wait for failure.

Expected behaviour
No deadlock.

Additional context

Working code snippet after having switched to TMVars. Logs here: ouroboros-network-framework-0.3.0.0-test.log

Upgrade io-sim to build with ghc-9.6

[x] Make it build.
[x] Add it to CI.
[x] Upload to CHaP Hackage.

Add bounds where appropriate

At least, it would be useful to have bound on typed-protocols and maybe some others, and also between the packages in this repo (since in practice they likely only build with the "same" version of the other packages).

Provide mtl instances for strict monad transformers

The io-classes-mtl only provides lazy versions.

Build failure with `ghc-9.4`

Describe the bug
The library fails to build with ghc-9.4

ghc-9.4.3.exe: C:\Users\profu\AppData\Roaming\cabal\store\ghc-9.4.3\hashable-1.4.1.0-b85d8bd3d622af2d3cc68965fab12f2069573e77\lib\libHShashable-1.4.1.0-b85d8bd3d622af2d3cc68965fab12f2069573e77.a(#7:LowLevel.o): Not a x86_64 PE+ file.
ghc-9.4.3.exe: Unknown COFF 4 type in getHeaderInfo.

PE format documentation.

To Reproduce
This can be reproduced locally and in our GitHub actions.

Desktop (please complete the following information):

• GHC version: 9.4.3
• io-sim version: 0.3.0
• io-classes version: 0.3.0

threadStatus is not well defined

See the ghc issue

Feature Request: Implement `threadStatus`

The threadStatus function is missing from the io-classes interface. We need it for an example in quickcheck-dynamic but it is not urgent.

Implement IORefs for both io-sim and io-sim-por

• io-sim
• io-sim-por

Add annotateIO to io-classes

annotateIO is added to base-4.20 published with ghc-9.10:

-- | Execute an 'IO' action, adding the given 'ExceptionContext'
-- to any thrown synchronous exceptions.
--
-- @since base-2.20.0.0
annotateIO :: forall e a. ExceptionAnnotation e => e -> IO a -> IO a
annotateIO ann (IO io) = IO (catch# io handler)
  where
    handler se = raiseIO# (addExceptionContext ann se)

This should be added to MonadThrow.

Remove the fancy timeout API from `io-classes`

Initially we can just remove it from io-classes, simplifications in io-sim can be done at a later stage.

ThreadStatus tests fails on windows

Describe the bug
The ThreadStatus tests fail on Windows but not on Linux and Mac. When we turn the tests
on in CI we get the following failures:

thread status died_own (IO):             FAIL
 *** Failed! Falsified (after 1 test):
 ThreadFinished /= ThreadBlocked BlockedOnMVar
 Use --quickcheck-replay=392463 to reproduce.
 Use -p '/thread status died_own (IO)/' to rerun this test only.

thread status mask (IO):                 FAIL
 *** Failed! Falsified (after 1 test):
 ThreadFinished /= ThreadBlocked BlockedOnMVar
 Use --quickcheck-replay=499493 to reproduce.
 Use -p '/thread status mask (IO)/' to rerun this test only.

This is surprising because the first test doesn't even use MVar's and the thread that has status ThreadBlocked
in the second test doesn't do any blocking operations!

To Reproduce
Turn on the tests mentioned above on windows.

Expected behaviour
We expect the tests to pass.

`concurrent` library as an alternative for `io-classes`

The concurrency package could be an alternative for io-classes.

Help users deal with MonadST now depending on PrimMonad

As of PR #141, it's no longer, for example, trivial to derive MonadST for a newtype monad.

• It'd be helpful if the Haddock on MonadST called out the dependence on PrimMonad, and ideally suggested how to workaround it. (If PrimState were a top-level family instead of associated, the PrimMonad instance wouldn't be required! Although, as Duncan mentioned in PR 141, PrimMonad does usefully enable the rest of the API from primitive.)

• Either add withLiftST k = k stToIO as a default, or at least spell it out in the Haddock.

• Etc?

Provide `StrictTMVar` in `strict-stm` package

IOSimPOR assertion failures

Recently two execution of the propExploration errored:

• https://github.com/input-output-hk/io-sim/actions/runs/4491097750/jobs/7899072815
• https://github.com/input-output-hk/io-sim/actions/runs/4413935534/jobs/7735014212?pr=73

Logs

    propExploration:                           FAIL (36.64s)
      *** Failed! (after 53 tests and 48 shrinks):
      Exception:
        Assertion failed
        CallStack (from HasCallStack):
          assert, called at src/Control/Monad/IOSimPOR/Internal.hs:990:5 in io-sim-0.4.0.0-inplace:Control.Monad.IOSimPOR.Internal
      Tasks [Task [WhenSet 9 0],Task [WhenSet 0 0],Task [WhenSet 10 10,WhenSet 10 9],Task [WhenSet 0 0]]
      Schedule control: ControlAwait [ScheduleMod (RacyThreadId [4],1) ControlDefault [(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)]]
      RacyThreadId [3] delayed at time Time 0s
        until after:
          RacyThreadId [4]
      
      Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventSimStart (ControlAwait [ScheduleMod (RacyThreadId [4],1) ControlDefault [(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)]]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventTxCommitted [] [Labelled (TVarId 0) Nothing] (Just (Effect {effectReads = fromList [], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 1 (Just "main") (EventTxCommitted [] [Labelled (TVarId 1) Nothing] (Just (Effect {effectReads = fromList [], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 1 (Just "main") (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (ThreadId []) 1 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 2 (Just "main") (EventThreadForked (RacyThreadId [1]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 2 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 3 (Just "main") (EventThreadForked (RacyThreadId [2]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 3 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 4 (Just "main") (EventThreadForked (RacyThreadId [3]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 4 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 5 (Just "main") (EventThreadForked (RacyThreadId [4]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 5 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 6 (Just "main") (EventTxCommitted [Labelled (TVarId 1) Nothing] [] (Just (Effect {effectReads = fromList [], effectWrites = fromList [TVarId 1], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 6 (Just "main") (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (ThreadId []) 6 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 7 (Just "main") (EventThreadDelay (Time 1000000000s))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 2) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 1 Nothing (EventFollowControl (ControlAwait [ScheduleMod (RacyThreadId [4],1) ControlDefault [(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)]]))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 1 Nothing (EventAwaitControl (RacyThreadId [4],1) (ControlFollow [(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing EventThreadSleep) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 1 Nothing (EventDeschedule Sleep)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing EventThreadWake) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventReschedule (ControlFollow [(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventPerformAction (RacyThreadId [3],0))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 3) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventReschedule (ControlFollow [(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventPerformAction (RacyThreadId [3],1))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventTxCommitted [Labelled (TVarId 0) Nothing] [] (Just (Effect {effectReads = fromList [TVarId 0], effectWrites = fromList [TVarId 0], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventReschedule (ControlFollow [(RacyThreadId [2],0),(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventPerformAction (RacyThreadId [2],0))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 4) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 1 Nothing (EventReschedule (ControlFollow [(RacyThreadId [2],1),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 1 Nothing (EventPerformAction (RacyThreadId [2],1))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 1 Nothing (EventTxBlocked [Labelled (TVarId 0) Nothing] (Just (Effect {effectReads = fromList [TVarId 0], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 1 Nothing (EventDeschedule Blocked)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventReschedule (ControlFollow [(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],2)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventPerformAction (RacyThreadId [1],0))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 5) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 1 Nothing (EventReschedule (ControlFollow [(RacyThreadId [1],1),(RacyThreadId [2],2)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 1 Nothing (EventPerformAction (RacyThreadId [1],1))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 1 Nothing (EventTxBlocked [Labelled (TVarId 0) Nothing] (Just (Effect {effectReads = fromList [TVarId 0], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 1 Nothing (EventDeschedule Blocked)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 2 Nothing (EventReschedule (ControlFollow [(RacyThreadId [2],2)] []))) 
      Assertion failed
      CallStack (from HasCallStack):
        assert, called at src/Control/Monad/IOSimPOR/Internal.hs:990:5 in io-sim-0.4.0.0-inplace:Control.Monad.IOSimPOR.Internal
      Use --quickcheck-replay=898967 to reproduce.
      Use -p '/propExploration/' to rerun this test only.

    propExploration:                           FAIL (44.78s)
      *** Failed! (after 66 tests and 44 shrinks):
      Exception:
        Assertion failed
        CallStack (from HasCallStack):
          assert, called at src\Control\Monad\IOSimPOR\Internal.hs:989:5 in io-sim-0.4.0.0-inplace:Control.Monad.IOSimPOR.Internal
      Tasks [Task [],Task [ThrowTo 4],Task [WhenSet 19 18,ThrowTo 0],Task [WhenSet 18 0,ThrowTo 2],Task [WhenSet 0 0]]
      Schedule control: ControlAwait [ScheduleMod (RacyThreadId [5],2) ControlDefault [(RacyThreadId [4],2),(RacyThreadId [3],2),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)]]
      RacyThreadId [4] delayed at time Time 0s
        until after:
          RacyThreadId [5]
      
      Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventSimStart (ControlAwait [ScheduleMod (RacyThreadId [5],2) ControlDefault [(RacyThreadId [4],2),(RacyThreadId [3],2),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)]]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventTxCommitted [] [Labelled (TVarId 0) Nothing] (Just (Effect {effectReads = fromList [], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (ThreadId []) 0 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 1 (Just "main") (EventTxCommitted [] [Labelled (TVarId 1) Nothing] (Just (Effect {effectReads = fromList [], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 1 (Just "main") (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (ThreadId []) 1 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 2 (Just "main") (EventThreadForked (RacyThreadId [1]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 2 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 3 (Just "main") (EventThreadForked (RacyThreadId [2]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 3 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 4 (Just "main") (EventThreadForked (RacyThreadId [3]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 4 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 5 (Just "main") (EventThreadForked (RacyThreadId [4]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 5 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 6 (Just "main") (EventThreadForked (RacyThreadId [5]))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 6 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 7 (Just "main") (EventTxCommitted [Labelled (TVarId 1) Nothing] [] (Just (Effect {effectReads = fromList [], effectWrites = fromList [TVarId 1], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (ThreadId []) 7 (Just "main") (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (ThreadId []) 7 (Just "main") (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (ThreadId []) 8 (Just "main") (EventThreadDelay (Time 1000000000s))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 2) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 1 Nothing (EventTxBlocked [Labelled (TVarId 0) Nothing] (Just (Effect {effectReads = fromList [TVarId 0], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 1 Nothing (EventDeschedule Blocked)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 3) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 1 Nothing (EventTxBlocked [Labelled (TVarId 0) Nothing] (Just (Effect {effectReads = fromList [TVarId 0], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 1 Nothing (EventDeschedule Blocked)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 4) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventTxCommitted [Labelled (TVarId 0) Nothing] [] (Just (Effect {effectReads = fromList [TVarId 0], effectWrites = fromList [TVarId 0], effectForks = fromList [], effectThrows = [], effectWakeup = [RacyThreadId [5],RacyThreadId [4]], effectStatusReads = [], effectStatusWrites = [RacyThreadId [5],RacyThreadId [4]]})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 1 Nothing (EventTxWakeup [Labelled (TVarId 0) Nothing])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 1 Nothing (EventTxWakeup [Labelled (TVarId 0) Nothing])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventUnblocked [RacyThreadId [5],RacyThreadId [4]])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 1 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 2 Nothing (EventFollowControl (ControlAwait [ScheduleMod (RacyThreadId [5],2) ControlDefault [(RacyThreadId [4],2),(RacyThreadId [3],2),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)]]))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 2 Nothing (EventAwaitControl (RacyThreadId [5],2) (ControlFollow [(RacyThreadId [4],2),(RacyThreadId [3],2),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 2 Nothing EventThreadSleep) (Cons (SimPOREvent (Time 0s) (RacyThreadId [5]) 2 Nothing (EventDeschedule Sleep)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 2 Nothing EventThreadWake) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 2 Nothing (EventReschedule (ControlFollow [(RacyThreadId [4],2),(RacyThreadId [3],2),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 2 Nothing (EventPerformAction (RacyThreadId [4],2))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 2 Nothing (EventTxCommitted [Labelled (TVarId 0) Nothing] [] (Just (Effect {effectReads = fromList [TVarId 0], effectWrites = fromList [TVarId 0], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 2 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [4]) 2 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 2 Nothing (EventReschedule (ControlFollow [(RacyThreadId [3],2),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 2 Nothing (EventPerformAction (RacyThreadId [3],2))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [3]) 2 Nothing (EventThrowTo (ExitFailure 0) (RacyThreadId [1]))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventReschedule (ControlFollow [(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventPerformAction (RacyThreadId [2],0))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventTxCommitted [] [Labelled (TVarId 5) Nothing] (Just (Effect {effectReads = fromList [TVarId 1], effectWrites = fromList [], effectForks = fromList [], effectThrows = [], effectWakeup = [], effectStatusReads = [], effectStatusWrites = []})))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventUnblocked [])) (Cons (SimPOREvent (Time 0s) (RacyThreadId [2]) 0 Nothing (EventDeschedule Yield)) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventReschedule (ControlFollow [(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [2],1)] []))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventPerformAction (RacyThreadId [1],0))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventThrow (ExitFailure 0))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventThreadUnhandled (ExitFailure 0))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 0 Nothing (EventDeschedule (Terminated FinishedDied))) (Cons (SimPOREvent (Time 0s) (RacyThreadId [1]) 1 Nothing (EventReschedule (ControlFollow [(RacyThreadId [1],1),(RacyThreadId [2],1)] []))) 
      Assertion failed
      CallStack (from HasCallStack):
        assert, called at src\Control\Monad\IOSimPOR\Internal.hs:989:5 in io-sim-0.4.0.0-inplace:Control.Monad.IOSimPOR.Internal
      Use --quickcheck-replay=721896 to reproduce.
      Use -p '/propExploration/' to rerun this test only.

a registerDelay timeout is truncating a threadDelay call

Describe the bug
A registerTimeout that happens to be ignored by the thread ends up truncating a subsequent threadDelay in the same thread.

To Reproduce
Steps to reproduce the behaviour:

My thread is calling registerTimeout, calling atomically on a transaction that is blocked on the timeout's TVar Bool and others, completing based on changes to the others, and then later calling threadDelay maxBound. When the registerTimeout fires, the thread is woken up (it happens to be after 2s, in this case) --- despite maxBound not having elapsed (there are other threads in my runIOSim* invocation).

I have a large repro, but there are lots of dependencies. I do not anticipate being able to easily minimize it. It involves a SI.registerDelay 10 and threadDelay maxBound (happens with or without the si-timers interface).

(I suspect the minimal repro needs to involve an STM transaction that would be retried when the timeout fires but ends up committing before that happens (because some other tvar changes in such a way that the makes the timeout irrelevant.)

Expected behaviour
Both:

• Nothing should truncate a call threadDelay.
• Once the timeout's TVar becomes dead code, nothing should be affected by the timeout triggering. (In my example, I would have happily called, say, clearTimeout if that kind of feature were already part of the io-classes API. Which actually would have masked this bug, I suspect!)

Desktop (please complete the following information):

$ cat cabal.project.freeze  | grep -e io-sim -e io-classes -e ghc | grep -e ==
             any.ghc-bignum ==1.2,
             any.ghc-boot-th ==9.2.8,
             any.ghc-heap ==9.2.8,
             any.ghc-prim ==0.8.0,
             any.io-classes ==1.3.1.0,
             any.io-classes-mtl ==0.1.0.2,
             any.io-sim ==1.3.1.0,

Additional context
Add any other context about the problem here. Attach io-sim or io-sim-por trace if possible.

I'll attach the trace as the first GitHub comment.

Add support for nested exception testing in Test/STM

Is your feature request related to a problem? Please describe.
Test/STM.hs contains a toy DSL which can be evaluated in a pure as well as the STM context. It is used to test the correctness of the io-sim STM implementation. The PR #16 implements the support for MonadCatch. However, the test code does not have support for nested exceptions. Adding a support for nested exception evaluation in Test/STM will make it a complete.

Describe the solution you'd like

• Add a support for multiple exception values (Currently ImmValue is treated as an exception type).
• Add another exception type (E.g. ImmValueException so that catch handler can do a type check).
• Make necessary changes to Expr generator and Expr evaluation.

Describe alternatives you've considered

• Write a test which runs in io-sim and io and has nested exception. However, it will be a unit test and will not test various scenarios when a test is generated through Expr generator.

Additional context
NA

Are you willing to implement it?

• Are you? 😃 - Already started working on it.

Add a link to the `io-sim` hackage pages in the README and/or repo description

`BlockReason` in `threadStatus` is inaccurate

BlockReason in threadStatus is BlockedOnOther too often. This needs fixing by e.g. taking MVars and STM transactions into account.

Add forkFinally to MonadFork

forkFinally

Add more functions to Data.List.trace

It would be nice to have things like:

• take :: Int -> Trace a b -> Trace a ()
• takeWhile :: (a -> Bool) -> Trace a b -> Trace a ()
• drop :: Int -> Trace a b -> Trace a b
• dropWhile :: (a -> Bool) -> Trace a b -> Trace a b

Monad transformer instances for `MonadThread`, `MonadFork` and `MonadAsync` classes

timeout in si-timers is not designed for 32-bit systems

Add Chan, QSem and QSenN

• Chan
• QSem
• QSemN

Add `writeTMVar` to `MonadSTM`

writeTMVar was added in stm-2.5.1.0, but it's not yet included in MonadSTM

Failed assertion when running ThreadNet tests, using v0.4

ouroboros-consensus tests fail when enabling assertion, using version 0.4. The following assertion is triggered.

See the full log.

strict-mvar package

Is your feature request related to a problem? Please describe.

We provide strict-stm but we lack strict-mvar. Using MVar provided by
io-sim we can improve the internal implementation of StrictMVar used in
ouroboros-consensus (they do not provide fair access).

Describe the solution you'd like

Provide a newtype wrapper for MVars with strict semantics.

Describe alternatives you've considered

Additional context

Are you willing to implement it?

• Are you? 😃

Compare `IOSim` to `IOSpec`

IOSpec is another free monad implementation of IO.

Add MonadSay instances for monad transformers

MonadSay only has StateT instance, there's no reason not to provide other instances as well.

Are you willing to implement it?

• Are you? 😃

Missing instances for `STM m` monad

• Semigroup a => Semigroup (STM m a)
• Monoid a => Monoid (STM m a)

Provide MonadTraceMVar

First provide MonadInspectMVar which is the analogy of MonadInspectSTM but for MVars.

class ( MonadMVar m
      , Monad (InspectMonadMVar m)
      )
    => MonadInspectMVar m where
    type InspectMonadMVar m :: Type -> Type
    inspectMVar :: proxy m -> MVar m a -> InspectMonadMVar m (Maybe a)

Then provide a type class

class MonadTraceMVar m where
  traceMVarIO :: proxy 
              -> MVar m a
              -> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
              -> m ()

and two instances: MonadTraceMVar IO and MonadTraceMVar (IOSim s).

Under this proposal, I also suggest we also rename the associated type family InspectMonad of MonadInspectSTM as InsepctMonadSTM.

Shouldn't this be spotted? result of waitAny doesn't seem to take different scheduling processes into account.

Maybe my interpretation - or my expectations are just wrong - but shouldn't exploreSimTrace consider that t1 or t2 could finish first?

someFunc :: IOSim s Int
someFunc = do
    exploreRaces
    t1 <- async $ do
        pure 5
    t2 <- async $ do
        pure 3
    (_, r) <- waitAny [t1, t2]
    pure $ r + 5

prop :: Property
prop = exploreSimTrace id someFunc $ \_ trace ->
      case traceResult False trace of
        Right r -> property $ r == 8
        Left e  -> counterexample (show e) False

I would have expected that a counter example will be discovered. However, to my surprise, this succeeds - with no modified schedules - which seems strange to me:

+++ OK, passed 100 tests.

Branching factor (100 in total):
100% 0

Modified schedules explored (100 in total):
100% 0

Race reversals per schedule (100 in total):
100% 0

For know I keep short and hope that the issue/my question is explained by the code-snippet. But please don't hesitate to contact me if I was unclear or if I could contribute further information.

Disclaimer: I just discovered the library and played around - so my assumptions could be misleading.

newTimeout is not safe on `32`-bit archs

As noted by @njd42 :

On a 32 bit machine with a timeout more than ~35min in the future defaultRegisterDelay would be invoked which, in turn, makes use of newTimeout. This calls GHC.registerTimeout where the intrinsic 32 bit constraint rears its ugly head again.

`strict-mvar`: propagate `HasCallStack` constraints

In Control.Concurrent.Class.MonadMVar.Strict.Checked, we check invariants using:

checkInvariant :: HasCallStack => Maybe String -> a -> a

However, none of the functions that use this have HasCallStack constraints themselves. We should add these. We should also add them to Control.Concurrent.Class.MonadMVar.Strict.

flushTQueue is broken

Describe the bug
flushTQueue in IOSim s does not empty the queue, while it does in IO

To Reproduce

Execute this program:

#!/usr/bin/env cabal
{- cabal:
build-depends: base, io-sim ^>= 1.3, io-classes ^>= 1.3
-}

import Control.Concurrent.Class.MonadSTM
import Control.Exception (assert)
import Control.Monad (unless)
import Control.Monad.IOSim

main :: IO ()
main = do
  emptyInIO <- emptyQueueAfterFlush
  unless emptyInIO $
    error "queue not emptied from IO"

  let emptyInIOSim = runSimOrThrow emptyQueueAfterFlush
  unless emptyInIOSim $
    error "queue not emptied from IOSim"

emptyQueueAfterFlush :: MonadSTM m => m Bool
emptyQueueAfterFlush = do
  q <- newTQueueIO
  atomically $ do
    writeTQueue q 1
    _ <- flushTQueue q
    isEmptyTQueue q

Expected behaviour
Same semantics of STM in IO and IOSim

Additional context
The flushQueueDefault looks wrong when compared with the one of io-classes and the real one from stm

IOSimPOR propExploration failure

Describe the bug
The following counterexample is found:

      propExploration:                         FAIL (61.59s)
        *** Failed! Falsified (after 47 tests and 64 shrinks):
        AreNotEqual
        Shrink2 {getShrink2 = Tasks [Task [WhenSet 0 0,ThrowTo 1],Task [],Task [WhenSet 0 0],Task [ThrowTo 1,WhenSet 1 1],Task [ThrowTo 1]]}
        Schedule control: ControlAwait [ScheduleMod (RacyThreadId [5],2) ControlDefault [(RacyThreadId [4],0),(RacyThreadId [4],1),(RacyThreadId [4],2),(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)]]
        Thread {5} (5) delayed at time Time 0s
          until after:
            Thread {1}
            Thread {1} (1)
            Thread {2}
            Thread {3}
            Thread {3} (3)
            Thread {4}
            Thread {4} (4)
        
        0s - Thread [].0 main - SimStart ControlAwait [ScheduleMod (RacyThreadId [5],2) ControlDefault [(RacyThreadId [4],0),(RacyThreadId [4],1),(RacyThreadId [4],2),(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)]]
        0s - Thread [].0 main - Say Tasks [Task [WhenSet 0 0,ThrowTo 1],Task [],Task [WhenSet 0 0],Task [ThrowTo 1,WhenSet 1 1],Task [ThrowTo 1]]
        0s - Thread [].0 main - TxCommitted [] [TVarId 0] Effect {  }
        0s - Thread [].0 main - Unblocked []
        0s - Thread [].0 main - Deschedule Yield
        0s - Thread [].0 main - Effect VectorClock [Thread [].0] Effect {  }
        0s - Thread [].1 main - TxCommitted [] [TVarId 1] Effect {  }
        0s - Thread [].1 main - Unblocked []
        0s - Thread [].1 main - Deschedule Yield
        0s - Thread [].1 main - Effect VectorClock [Thread [].1] Effect {  }
        0s - Thread [].2 main - TxCommitted [] [TVarId 2] Effect {  }
        0s - Thread [].2 main - Unblocked []
        0s - Thread [].2 main - Deschedule Yield
        0s - Thread [].2 main - Effect VectorClock [Thread [].2] Effect {  }
        0s - Thread [].3 main - Mask MaskedInterruptible
        0s - Thread [].3 main - ThreadForked Thread {1}
        0s - Thread [].3 main - Deschedule Yield
        0s - Thread [].3 main - Effect VectorClock [Thread [].3] Effect { forks = [Thread {1}] }
        0s - Thread [].4 main - Mask Unmasked
        0s - Thread [].4 main - Deschedule Interruptable
        0s - Thread [].4 main - Effect VectorClock [Thread [].4] Effect {  }
        0s - Thread [].5 main - TxCommitted [] [] Effect {  }
        0s - Thread [].5 main - Unblocked []
        0s - Thread [].5 main - Deschedule Yield
        0s - Thread [].5 main - Effect VectorClock [Thread [].5] Effect {  }
        0s - Thread [].6 main - TxCommitted [] [TVarId 3] Effect {  }
        0s - Thread [].6 main - Unblocked []
        0s - Thread [].6 main - Deschedule Yield
        0s - Thread [].6 main - Effect VectorClock [Thread [].6] Effect {  }
        0s - Thread [].7 main - Mask MaskedInterruptible
        0s - Thread [].7 main - ThreadForked Thread {2}
        0s - Thread [].7 main - Deschedule Yield
        0s - Thread [].7 main - Effect VectorClock [Thread [].7] Effect { forks = [Thread {2}] }
        0s - Thread [].8 main - Mask Unmasked
        0s - Thread [].8 main - Deschedule Interruptable
        0s - Thread [].8 main - Effect VectorClock [Thread [].8] Effect {  }
        0s - Thread [].9 main - TxCommitted [] [] Effect {  }
        0s - Thread [].9 main - Unblocked []
        0s - Thread [].9 main - Deschedule Yield
        0s - Thread [].9 main - Effect VectorClock [Thread [].9] Effect {  }
        0s - Thread [].10 main - TxCommitted [] [TVarId 4] Effect {  }
        0s - Thread [].10 main - Unblocked []
        0s - Thread [].10 main - Deschedule Yield
        0s - Thread [].10 main - Effect VectorClock [Thread [].10] Effect {  }
        0s - Thread [].11 main - Mask MaskedInterruptible
        0s - Thread [].11 main - ThreadForked Thread {3}
        0s - Thread [].11 main - Deschedule Yield
        0s - Thread [].11 main - Effect VectorClock [Thread [].11] Effect { forks = [Thread {3}] }
        0s - Thread [].12 main - Mask Unmasked
        0s - Thread [].12 main - Deschedule Interruptable
        0s - Thread [].12 main - Effect VectorClock [Thread [].12] Effect {  }
        0s - Thread [].13 main - TxCommitted [] [] Effect {  }
        0s - Thread [].13 main - Unblocked []
        0s - Thread [].13 main - Deschedule Yield
        0s - Thread [].13 main - Effect VectorClock [Thread [].13] Effect {  }
        0s - Thread [].14 main - TxCommitted [] [TVarId 5] Effect {  }
        0s - Thread [].14 main - Unblocked []
        0s - Thread [].14 main - Deschedule Yield
        0s - Thread [].14 main - Effect VectorClock [Thread [].14] Effect {  }
        0s - Thread [].15 main - Mask MaskedInterruptible
        0s - Thread [].15 main - ThreadForked Thread {4}
        0s - Thread [].15 main - Deschedule Yield
        0s - Thread [].15 main - Effect VectorClock [Thread [].15] Effect { forks = [Thread {4}] }
        0s - Thread [].16 main - Mask Unmasked
        0s - Thread [].16 main - Deschedule Interruptable
        0s - Thread [].16 main - Effect VectorClock [Thread [].16] Effect {  }
        0s - Thread [].17 main - TxCommitted [] [] Effect {  }
        0s - Thread [].17 main - Unblocked []
        0s - Thread [].17 main - Deschedule Yield
        0s - Thread [].17 main - Effect VectorClock [Thread [].17] Effect {  }
        0s - Thread [].18 main - TxCommitted [] [TVarId 6] Effect {  }
        0s - Thread [].18 main - Unblocked []
        0s - Thread [].18 main - Deschedule Yield
        0s - Thread [].18 main - Effect VectorClock [Thread [].18] Effect {  }
        0s - Thread [].19 main - Mask MaskedInterruptible
        0s - Thread [].19 main - ThreadForked Thread {5}
        0s - Thread [].19 main - Deschedule Yield
        0s - Thread [].19 main - Effect VectorClock [Thread [].19] Effect { forks = [Thread {5}] }
        0s - Thread [].20 main - Mask Unmasked
        0s - Thread [].20 main - Deschedule Interruptable
        0s - Thread [].20 main - Effect VectorClock [Thread [].20] Effect {  }
        0s - Thread [].21 main - TxCommitted [] [] Effect {  }
        0s - Thread [].21 main - Unblocked []
        0s - Thread [].21 main - Deschedule Yield
        0s - Thread [].21 main - Effect VectorClock [Thread [].21] Effect {  }
        0s - Thread [].22 main - TxCommitted [TVarId 1] [] Effect { writes = fromList [TVarId 1] }
        0s - Thread [].22 main - Unblocked []
        0s - Thread [].22 main - Deschedule Yield
        0s - Thread [].22 main - Effect VectorClock [Thread [].22] Effect { writes = fromList [TVarId 1] }
        0s - Thread [].23 main - TxBlocked [Labelled TVarId 2 async-RacyThreadId [1]] Effect { reads = fromList [TVarId 2] }
        0s - Thread [].23 main - Deschedule Blocked BlockedOnSTM
        0s - Thread [].23 main - Effect VectorClock [Thread [].23] Effect { reads = fromList [TVarId 2] }
        0s - Thread {5}.0  - Mask Unmasked
        0s - Thread {5}.0  - Deschedule Interruptable
        0s - Thread {5}.0  - Effect VectorClock [Thread {5}.0, Thread [].19] Effect {  }
        0s - Thread {5}.1 5 - TxCommitted [] [TVarId 7] Effect { reads = fromList [TVarId 1] }
        0s - Thread {5}.1 5 - Unblocked []
        0s - Thread {5}.1 5 - Deschedule Yield
        0s - Thread {5}.1 5 - Effect VectorClock [Thread {5}.1, Thread [].22] Effect { reads = fromList [TVarId 1] }
        0s - Thread {5}.2 5 - FollowControl ControlAwait [ScheduleMod (RacyThreadId [5],2) ControlDefault [(RacyThreadId [4],0),(RacyThreadId [4],1),(RacyThreadId [4],2),(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)]]
        0s - Thread {5}.2 5 - AwaitControl Thread {5}.2 ControlFollow [(RacyThreadId [4],0),(RacyThreadId [4],1),(RacyThreadId [4],2),(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {5}.2 5 - Deschedule Sleep
        0s - Thread {5}.2 5 - ThreadSleep
        0s - Thread {4}.0  - Reschedule ControlFollow [(RacyThreadId [4],0),(RacyThreadId [4],1),(RacyThreadId [4],2),(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {4}.0  - PerformAction Thread {4}.0
        0s - Thread {4}.0  - PerformAction Thread {4}.0
        0s - Thread {4}.0  - Mask Unmasked
        0s - Thread {4}.0  - Deschedule Interruptable
        0s - Thread {4}.0  - Effect VectorClock [Thread {4}.0, Thread [].15] Effect {  }
        0s - Thread {4}.1  - PerformAction Thread {4}.1
        0s - Thread {4}.1  - PerformAction Thread {4}.1
        0s - Thread {4}.1 4 - PerformAction Thread {4}.1
        0s - Thread {4}.1 4 - TxCommitted [] [TVarId 8] Effect { reads = fromList [TVarId 1] }
        0s - Thread {4}.1 4 - Unblocked []
        0s - Thread {4}.1 4 - Deschedule Yield
        0s - Thread {4}.1 4 - Effect VectorClock [Thread {4}.1, Thread [].22] Effect { reads = fromList [TVarId 1] }
        0s - Thread {4}.2  - Reschedule ControlFollow [(RacyThreadId [4],2),(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {4}.2 4 - PerformAction Thread {4}.2
        0s - Thread {4}.2 4 - ThrowTo (ExitFailure 0) Thread {2}
        0s - Thread {4}.2 4 - ThrowToBlocked
        0s - Thread {4}.2 4 - Deschedule Blocked BlockedOnThrowTo
        0s - Thread {4}.2 4 - Effect VectorClock [Thread {2}.0, Thread {4}.2, Thread [].22] Effect { throws = [Thread {2}] }
        0s - Thread {3}.0  - Reschedule ControlFollow [(RacyThreadId [3],0),(RacyThreadId [3],1),(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {3}.0  - PerformAction Thread {3}.0
        0s - Thread {3}.0  - PerformAction Thread {3}.0
        0s - Thread {3}.0  - Mask Unmasked
        0s - Thread {3}.0  - Deschedule Interruptable
        0s - Thread {3}.0  - Effect VectorClock [Thread {3}.0, Thread [].11] Effect {  }
        0s - Thread {3}.1  - PerformAction Thread {3}.1
        0s - Thread {3}.1  - PerformAction Thread {3}.1
        0s - Thread {3}.1 3 - PerformAction Thread {3}.1
        0s - Thread {3}.1 3 - TxCommitted [] [TVarId 9] Effect { reads = fromList [TVarId 1] }
        0s - Thread {3}.1 3 - Unblocked []
        0s - Thread {3}.1 3 - Deschedule Yield
        0s - Thread {3}.1 3 - Effect VectorClock [Thread {3}.1, Thread [].22] Effect { reads = fromList [TVarId 1] }
        0s - Thread {2}.0  - Reschedule ControlFollow [(RacyThreadId [2],0),(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {2}.0  - PerformAction Thread {2}.0
        0s - Thread {2}.0  - PerformAction Thread {2}.0
        0s - Thread {2}.0  - Mask Unmasked
        0s - Thread {2}.0  - Deschedule Interruptable
        0s - Thread {2}.0  - ThrowToUnmasked Labelled Thread {4} 4
        0s - Thread {2}.0  - Effect VectorClock [Thread {2}.0, Thread [].7] Effect { wakeup = [Thread {4}] }
        0s - Thread {4}.- 4 - ThrowToWakeup
        0s - Thread {2}.0  - Deschedule Yield
        0s - Thread {2}.0  - Effect VectorClock [Thread {2}.0, Thread {4}.2, Thread [].22] Effect { wakeup = [Thread {4}] }
        0s - Thread {1}.0  - Reschedule ControlFollow [(RacyThreadId [1],0),(RacyThreadId [1],1),(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {1}.0  - PerformAction Thread {1}.0
        0s - Thread {1}.0  - PerformAction Thread {1}.0
        0s - Thread {1}.0  - Mask Unmasked
        0s - Thread {1}.0  - Deschedule Interruptable
        0s - Thread {1}.0  - Effect VectorClock [Thread {1}.0, Thread [].3] Effect {  }
        0s - Thread {1}.1  - PerformAction Thread {1}.1
        0s - Thread {1}.1  - PerformAction Thread {1}.1
        0s - Thread {1}.1 1 - PerformAction Thread {1}.1
        0s - Thread {1}.1 1 - TxCommitted [] [TVarId 10] Effect { reads = fromList [TVarId 1] }
        0s - Thread {1}.1 1 - Unblocked []
        0s - Thread {1}.1 1 - Deschedule Yield
        0s - Thread {1}.1 1 - Effect VectorClock [Thread {1}.1, Thread [].22] Effect { reads = fromList [TVarId 1] }
        0s - Thread {3}.2  - Reschedule ControlFollow [(RacyThreadId [3],2),(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {3}.2 3 - PerformAction Thread {3}.2
        0s - Thread {3}.2 3 - TxCommitted [TVarId 0] [] Effect { reads = fromList [TVarId 0], writes = fromList [TVarId 0] }
        0s - Thread {3}.2 3 - Say 0
        0s - Thread {3}.2 3 - Unblocked []
        0s - Thread {3}.2 3 - Deschedule Yield
        0s - Thread {3}.2 3 - Effect VectorClock [Thread {3}.2, Thread [].22] Effect { reads = fromList [TVarId 0], writes = fromList [TVarId 0] }
        0s - Thread {3}.3  - Reschedule ControlFollow [(RacyThreadId [3],3),(RacyThreadId [3],4),(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {3}.3 3 - PerformAction Thread {3}.3
        0s - Thread {3}.3 3 - Mask MaskedInterruptible
        0s - Thread {3}.3 3 - Deschedule Interruptable
        0s - Thread {3}.3 3 - Effect VectorClock [Thread {3}.3, Thread [].22] Effect {  }
        0s - Thread {3}.4 3 - PerformAction Thread {3}.4
        0s - Thread {3}.4 3 - PerformAction Thread {3}.4
        0s - Thread {3}.4 3 - TxCommitted [Labelled TVarId 4 async-RacyThreadId [3]] [] Effect { reads = fromList [TVarId 4], writes = fromList [TVarId 4] }
        0s - Thread {3}.4 3 - Unblocked []
        0s - Thread {3}.4 3 - Deschedule Yield
        0s - Thread {3}.4 3 - Effect VectorClock [Thread {3}.4, Thread [].22] Effect { reads = fromList [TVarId 4], writes = fromList [TVarId 4] }
        0s - Thread {3}.5  - Reschedule ControlFollow [(RacyThreadId [3],5),(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {3}.5 3 - PerformAction Thread {3}.5
        0s - Thread {3}.5 3 - ThreadFinished
        0s - Thread {3}.5 3 - Deschedule Terminated
        0s - Thread {3}.5 3 - Effect VectorClock [Thread {3}.5, Thread [].22] Effect {  }
        0s - Thread {1}.2  - Reschedule ControlFollow [(RacyThreadId [1],2),(RacyThreadId [1],3)] []
        0s - Thread {1}.2 1 - PerformAction Thread {1}.2
        0s - Thread {1}.2 1 - TxBlocked [TVarId 0] Effect { reads = fromList [TVarId 0] }
        0s - Thread {1}.2 1 - Deschedule Blocked BlockedOnSTM
        0s - Thread {1}.2 1 - Effect VectorClock [Thread {1}.2, Thread {3}.2, Thread [].22] Effect { reads = fromList [TVarId 0] }
        InternalError "assertion failure: Thread {1} not runnable"
        assertion failure: Thread {1} not runnable
        Use --quickcheck-replay=901028 to reproduce.
        Use -p '/propExploration/' to rerun this test only.

Ref. I also reproduced it on Linux.

Write compatibility tests for `io` and `io-sim`'s stm APIs

• TMVarDefault
• TQueueDefault
• TBQueueDefault
• TArrayDefault
• TSemDefault
• TChanDefault

A bonus point for designing tests which check that the types have the same laziness semantics (what can be checked with nothunks).

threadDelay impl does not prevent underflow

Describe the bug
If the argument to threadDelay is "very negative", it will underflow.

To Reproduce
Steps to reproduce the behaviour: I didn't record them. I think pass a negative duration to threadDelay that is between -2X and -1X where X is the minBound of Int.

Expected behaviour
Every non-positive argument should have the same behavior.

Implement new thread api added in ghc-9.6.1

• listThreads
• threadLabel

ghc-9.6.1 release notes.

Is it possible to integrate with dejafu?

Is your feature request related to a problem? Please describe.
dejafu provided great facilities to test concurrent programs, tho dejafu using concurrency to provide IO classes which very similar to io-classes I believe. so Is it possible integrate with dejafu?

Describe the solution you'd like
fork dejafu, a new package called io-sim-dejafu which build on top of io-classes

Describe alternatives you've considered
is it possible to merge io-classes and concurrency?

Additional context
@barrucadu WDYT?

Are you willing to implement it?
Nah, just an idea 🤣

IOSimPOR failure

Steps to reproduce

Steps to reproduce the behaviour:

prop = propExploration (Tasks [Task [ThrowTo 1, WhenSet 0 0],
                               Task [Delay 1],
                               Task [WhenSet 0 0],
                               Task [WhenSet 1 0, ThrowTo 1]])

but requires a modified Task interpreter which is using aysnc & wait, instead of forkIO and threadDelay as a synchronisation primitive.

assert, called at src/Control/Monad/IOSimPOR/Internal.hs:956:71 in io-sim-1.2.0.0-inplace:Control.Monad.IOSimPOR.Internal

Trace

Time 0s - (RacyThreadId [1],2)  - EventEffect Effect { throws = [RacyThreadId [2]], }
-- ^ last scheduled step, `(RacyThreadId [1], 3)`, which does `WhenSet 0 0` would be blocked.
Time 0s - (RacyThreadId [4],4)  - EventThreadWake
Time 0s - (RacyThreadId [4],4)  - EventThrowTo (ExitFailure 0) (RacyThreadId [2])
-- ^ executes: ThrowTo 1 
Time 0s - (RacyThreadId [4],4)  - EventThrowToBlocked
Time 0s - (RacyThreadId [4],4)  - EventDeschedule (Blocked BlockedOnThrowTo)
Time 0s - (RacyThreadId [4],4)  - EventEffect Effect { throws = [RacyThreadId [2]], }
Time 0s - (RacyThreadId [2],0)  - EventMask Unmasked
Time 0s - (RacyThreadId [2],0)  - EventDeschedule Interruptable
Time 0s - (RacyThreadId [2],0)  - EventDeschedule Yield
Time 0s - (RacyThreadId [2],0)  - EventThrowToUnmasked (Labelled (RacyThreadId [4]) Nothing)
Time 0s - (RacyThreadId [4],-1)  - EventThrowToWakeup
-- ^ receives the exception, which interrupts the step before `Delay 1`
Time 0s - (RacyThreadId [2],0)  - EventEffect Effect { }
Time 0s - (RacyThreadId [4],5)  - EventMask MaskedInterruptible
Time 0s - (RacyThreadId [4],5)  - EventDeschedule Interruptable
Time 0s - (RacyThreadId [4],5)  - EventEffect Effect { }
Time 0s - (RacyThreadId [4],6)  - EventTxCommitted [Labelled (TVarId 5) (Just "async-RacyThreadId [4]")] [] (Just Effect { reads = fromList [TVarId 5], writes = fromList [TVarId 5], })
-- ^ task commits results to its `Async`
Time 0s - (RacyThreadId [4],6)  - EventUnblocked []
Time 0s - (RacyThreadId [4],6)  - EventDeschedule Yield
Time 0s - (RacyThreadId [4],6)  - EventEffect Effect { reads = fromList [TVarId 5], writes = fromList [TVarId 5], }
Time 0s - (RacyThreadId [4],7)  - EventThreadFinished
-- ^ task terminates
Time 0s - (RacyThreadId [4],7)  - EventDeschedule Terminated
Time 0s - (RacyThreadId [4],7)  - EventEffect Effect { }
Time 0s - (RacyThreadId [2],1)  - EventThrow (ExitFailure 0)
-- exception is thrown
Time 0s - (RacyThreadId [2],1)  - EventMask MaskedInterruptible
Time 0s - (RacyThreadId [2],1)  - EventEffect Effect { }
Time 0s - (RacyThreadId [2],2)  - EventMask MaskedInterruptible
Time 0s - (RacyThreadId [2],2)  - EventDeschedule Interruptable
Time 0s - (RacyThreadId [2],2)  - EventEffect Effect { }
Time 0s - (RacyThreadId [2],3)  - EventTxCommitted [Labelled (TVarId 3) (Just "async-RacyThreadId [2]")] [] (Just Effect { reads = fromList [TVarId 3], writes = fromList [TVarId 3], })
Time 0s - (RacyThreadId [2],3)  - EventUnblocked []
Time 0s - (RacyThreadId [2],3)  - EventDeschedule Yield
Time 0s - (RacyThreadId [2],3)  - EventEffect Effect { reads = fromList [TVarId 3], writes = fromList [TVarId 3], }
Time 0s - (RacyThreadId [2],4)  - EventThreadFinished
Time 0s - (RacyThreadId [2],4)  - EventDeschedule Terminated
Time 0s - (RacyThreadId [1],-1)  - EventThrowToWakeup
Time 0s - (RacyThreadId [2],4)  - EventEffect Effect { }
Time 0s - (RacyThreadId [1],3)  - EventTxBlocked [Labelled (TVarId 0) Nothing] (Just Effect { reads = fromList [TVarId 0], })
Time 0s - (RacyThreadId [1],3)  - EventDeschedule (Blocked BlockedOnSTM)
Time 0s - (RacyThreadId [1],3)  - EventEffect Effect { reads = fromList [TVarId 0], }
  , completeRaces = []})
-- ^ deadlock discovered
Deadlock (Time 0s) [Labelled (RacyThreadId [1]) Nothing,Labelled (RacyThreadId [2]) Nothing,Labelled (RacyThreadId [3]) Nothing,Labelled (RacyThreadId [4]) Nothing,Labelled (ThreadId []) (Just "main")]

deadlock in registerDelayCancellable in `io-sim`

Describe the bug

    MonadTimerCancellable
test: BlockedIndefinitely {blockedIndefinitelyCallStack = [("wrapBlockedIndefinitely",SrcLoc {srcLocPackage = "io-classes-0.6.0.0-inplace", srcLocModule = "Control.Monad.Class.MonadSTM.Internal", srcLocFile = "src/Control/Monad/Class/MonadSTM/Internal.hs", srcLocStartLine = 653, srcLocStartCol = 16, srcLocEndLine = 653, srcLocEndCol = 39}),("atomically",SrcLoc {srcLocPackage = "main", srcLocModule = "Test.Control.Monad.IOSim", srcLocFile = "test/Test/Control/Monad/IOSim.hs", srcLocStartLine = 276, srcLocStartCol = 6, srcLocEndLine = 276, srcLocEndCol = 32})], blockedIndefinitelyException = thread blocked indefinitely in an STM transaction}
      registerDelayCancellable (IOSim impl):   FAIL
        *** Failed! Timeout of 1000 microseconds exceeded. (after 93 tests):
        DelayWithCancel 9223372036854.775878s Nothing
        Use --quickcheck-replay=904735 to reproduce.
        Use -p '/registerDelayCancellable (IOSim impl)/' to rerun this test only.

From this CI run.

I wasn't able to reproduce it :/.

To Reproduce
Steps to reproduce the behaviour:

Expected behaviour
A clear and concise description of what you expected to happen.

Desktop (please complete the following information):

• GHC version: 8.10.7
• io-sim version: 1.0.0.0
• io-classes version: 1.0.0.0

Provide MoandFix instance for `STM m` monad.