From 276847a819b75787aee37c147593f8dbda42a045 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 6 Dec 2022 19:37:16 +0100 Subject: [PATCH 01/27] Removed deprecated terms They all have been deprecated for a very long time. --- .../src/Control/Monad/Class/MonadEventlog.hs | 14 ------ .../src/Control/Monad/Class/MonadFork.hs | 11 ----- .../Control/Monad/Class/MonadSTM/Internal.hs | 46 ------------------- .../src/Control/Monad/Class/MonadThrow.hs | 6 --- io-sim/src/Control/Monad/IOSim.hs | 6 +-- io-sim/src/Control/Monad/IOSim/Internal.hs | 5 +- io-sim/src/Control/Monad/IOSim/Types.hs | 25 ++-------- io-sim/src/Control/Monad/IOSimPOR/Internal.hs | 5 +- 8 files changed, 8 insertions(+), 110 deletions(-) diff --git a/io-classes/src/Control/Monad/Class/MonadEventlog.hs b/io-classes/src/Control/Monad/Class/MonadEventlog.hs index d50a7b4a..51cd9e3d 100644 --- a/io-classes/src/Control/Monad/Class/MonadEventlog.hs +++ b/io-classes/src/Control/Monad/Class/MonadEventlog.hs @@ -1,8 +1,5 @@ module Control.Monad.Class.MonadEventlog ( MonadEventlog (..) - -- * Deprecated API - , traceEventM - , traceMarkerM ) where import Control.Monad.Reader @@ -22,17 +19,6 @@ class Monad m => MonadEventlog m where -- profiling tools to help you keep clear which marker is which. traceMarkerIO :: String -> m () - -traceEventM :: MonadEventlog m => String -> m () -traceEventM = traceEventIO -{-# DEPRECATED traceEventM "Use traceEventIO" #-} - - -traceMarkerM :: MonadEventlog m => String -> m () -traceMarkerM = traceMarkerIO -{-# DEPRECATED traceMarkerM "Use traceEventIO" #-} - - -- -- Instances for IO -- diff --git a/io-classes/src/Control/Monad/Class/MonadFork.hs b/io-classes/src/Control/Monad/Class/MonadFork.hs index fb30c905..ea9c9200 100644 --- a/io-classes/src/Control/Monad/Class/MonadFork.hs +++ b/io-classes/src/Control/Monad/Class/MonadFork.hs @@ -7,9 +7,6 @@ module Control.Monad.Class.MonadFork ( MonadThread (..) , MonadFork (..) , labelThisThread - -- * Deprecated API - , fork - , forkWithUnmask ) where import qualified Control.Concurrent as IO @@ -41,14 +38,6 @@ class MonadThread m => MonadFork m where yield :: m () -fork :: MonadFork m => m () -> m (ThreadId m) -fork = forkIO -{-# DEPRECATED fork "use forkIO" #-} - -forkWithUnmask :: MonadFork m => ((forall a. m a -> m a) -> m ()) -> m (ThreadId m) -forkWithUnmask = forkIOWithUnmask -{-# DEPRECATED forkWithUnmask "use forkIO" #-} - instance MonadThread IO where type ThreadId IO = IO.ThreadId diff --git a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs index e9934cb5..b95a436a 100644 --- a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs +++ b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs @@ -28,8 +28,6 @@ module Control.Monad.Class.MonadSTM.Internal , MonadInspectSTM (..) , TraceValue (TraceValue, TraceDynamic, TraceString, DontTrace, traceDynamic, traceString) , MonadTraceSTM (..) - , LazyTVar - , LazyTMVar -- * Default 'TMVar' implementation , TMVarDefault (..) -- * Default 'TBQueue' implementation @@ -45,12 +43,6 @@ module Control.Monad.Class.MonadSTM.Internal -- * MonadThrow aliases , throwSTM , catchSTM - -- * Deprecated API - , newTVarM - , newTMVarM - , newTMVarMDefault - , newEmptyTMVarM - , newEmptyTMVarMDefault ) where import Prelude hiding (read) @@ -84,11 +76,6 @@ import GHC.Stack import Numeric.Natural (Natural) -{-# DEPRECATED LazyTVar "Renamed back to 'TVar'" #-} -{-# DEPRECATED LazyTMVar "Renamed back to 'TMVar'" #-} -type LazyTVar m = TVar m -type LazyTMVar m = TMVar m - -- The STM primitives class (Monad m, Monad (STM m)) => MonadSTM m where -- STM transactions @@ -397,19 +384,6 @@ swapTVarDefault var new = do return old -newTVarM :: MonadSTM m => a -> m (TVar m a) -newTVarM = newTVarIO -{-# DEPRECATED newTVarM "Use newTVarIO" #-} - -newTMVarM :: MonadSTM m => a -> m (TMVar m a) -newTMVarM = newTMVarIO -{-# DEPRECATED newTMVarM "Use newTMVarIO" #-} - -newEmptyTMVarM :: MonadSTM m => m (TMVar m a) -newEmptyTMVarM = newEmptyTMVarIO -{-# DEPRECATED newEmptyTMVarM "Use newEmptyTMVarIO" #-} - - -- | Labelled 'TVar's, 'TMVar's, 'TQueue's and 'TBQueue's. -- class MonadSTM m @@ -800,31 +774,11 @@ newTMVarDefault a = do t <- newTVar (Just a) return (TMVar t) -newTMVarIODefault :: MonadSTM m => a -> m (TMVarDefault m a) -newTMVarIODefault a = do - t <- newTVarM (Just a) - return (TMVar t) -{-# DEPRECATED newTMVarIODefault "MonadSTM provides a default implementation" #-} - -newTMVarMDefault :: MonadSTM m => a -> m (TMVarDefault m a) -newTMVarMDefault = newTMVarIODefault -{-# DEPRECATED newTMVarMDefault "Use newTMVarIODefault" #-} - newEmptyTMVarDefault :: MonadSTM m => STM m (TMVarDefault m a) newEmptyTMVarDefault = do t <- newTVar Nothing return (TMVar t) -newEmptyTMVarIODefault :: MonadSTM m => m (TMVarDefault m a) -newEmptyTMVarIODefault = do - t <- newTVarIO Nothing - return (TMVar t) -{-# DEPRECATED newEmptyTMVarIODefault "MonadSTM provides a default implementation" #-} - -newEmptyTMVarMDefault :: MonadSTM m => m (TMVarDefault m a) -newEmptyTMVarMDefault = newEmptyTMVarIODefault -{-# DEPRECATED newEmptyTMVarMDefault "Use newEmptyTMVarIODefault" #-} - takeTMVarDefault :: MonadSTM m => TMVarDefault m a -> STM m a takeTMVarDefault (TMVar t) = do m <- readTVar t diff --git a/io-classes/src/Control/Monad/Class/MonadThrow.hs b/io-classes/src/Control/Monad/Class/MonadThrow.hs index 5e4042d0..fba54fbf 100644 --- a/io-classes/src/Control/Monad/Class/MonadThrow.hs +++ b/io-classes/src/Control/Monad/Class/MonadThrow.hs @@ -19,8 +19,6 @@ module Control.Monad.Class.MonadThrow , ExitCase (..) , Handler (..) , catches - -- * Deprecated interfaces - , throwM ) where import Control.Exception (Exception (..), MaskingState, SomeException) @@ -58,10 +56,6 @@ class Monad m => MonadThrow m where a `finally` sequel = bracket_ (return ()) sequel a -throwM :: (MonadThrow m, Exception e) => e -> m a -throwM = throwIO -{-# DEPRECATED throwM "Use throwIO" #-} - -- | Catching exceptions. -- -- Covers standard utilities to respond to exceptions. diff --git a/io-sim/src/Control/Monad/IOSim.hs b/io-sim/src/Control/Monad/IOSim.hs index c592ce8f..dbb03b20 100644 --- a/io-sim/src/Control/Monad/IOSim.hs +++ b/io-sim/src/Control/Monad/IOSim.hs @@ -27,7 +27,7 @@ module Control.Monad.IOSim , unshareClock -- * Simulation trace , type SimTrace - , Trace (Cons, Nil, Trace, SimTrace, SimPORTrace, TraceDeadlock, TraceLoop, TraceMainReturn, TraceMainException, TraceRacesFound) + , Trace (Cons, Nil, SimTrace, SimPORTrace, TraceDeadlock, TraceLoop, TraceMainReturn, TraceMainException, TraceRacesFound) , SimResult (..) , SimEvent (..) , SimEventType (..) @@ -73,10 +73,6 @@ module Control.Monad.IOSim , readTimeout , cancelTimeout , awaitTimeout - -- * Deprecated interfaces - , SimM - , SimSTM - , TraceEvent ) where import Prelude diff --git a/io-sim/src/Control/Monad/IOSim/Internal.hs b/io-sim/src/Control/Monad/IOSim/Internal.hs index b810c63e..73d193b9 100644 --- a/io-sim/src/Control/Monad/IOSim/Internal.hs +++ b/io-sim/src/Control/Monad/IOSim/Internal.hs @@ -17,14 +17,12 @@ module Control.Monad.IOSim.Internal ( IOSim (..) - , SimM , runIOSim , runSimTraceST , traceM , traceSTM , STM , STMSim - , SimSTM , setCurrentTime , unshareClock , TimeoutException (..) @@ -34,11 +32,10 @@ module Control.Monad.IOSim.Internal , ThreadLabel , Labelled (..) , SimTrace - , Trace.Trace (SimTrace, Trace, TraceMainReturn, TraceMainException, TraceDeadlock) + , Trace.Trace (SimTrace, TraceMainReturn, TraceMainException, TraceDeadlock) , SimEvent (..) , SimResult (..) , SimEventType (..) - , TraceEvent , ppTrace , ppTrace_ , ppSimEvent diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index cc06cffd..108afe45 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -48,16 +48,13 @@ module Control.Monad.IOSim.Types , SimEvent (..) , SimResult (..) , SimTrace - , Trace.Trace (Trace, SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceRacesFound, TraceLoop) + , Trace.Trace (SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceRacesFound, TraceLoop) , ppTrace , ppTrace_ , ppSimEvent , ppDebug - , TraceEvent , Labelled (..) , module Control.Monad.IOSim.CommonTypes - , SimM - , SimSTM , Thrower (..) , Time (..) , addTime @@ -133,9 +130,6 @@ import qualified System.IO.Error as IO.Error (userError) {-# ANN module "HLint: ignore Use readTVarIO" #-} newtype IOSim s a = IOSim { unIOSim :: forall r. (a -> SimA s r) -> SimA s r } -type SimM s = IOSim s -{-# DEPRECATED SimM "Use IOSim" #-} - runIOSim :: IOSim s a -> SimA s a runIOSim (IOSim k) = k Return @@ -226,9 +220,6 @@ data StmA s a where -- Exported type type STMSim = STM -type SimSTM = STM -{-# DEPRECATED SimSTM "Use STMSim" #-} - -- -- Monad class instances -- @@ -799,13 +790,6 @@ ppDebug = appEndo . foldMap (Endo . Debug.trace . show) . Trace.toList -pattern Trace :: Time -> ThreadId -> Maybe ThreadLabel -> SimEventType -> SimTrace a - -> SimTrace a -pattern Trace time threadId threadLabel traceEvent trace = - Trace.Cons (SimEvent time threadId threadLabel traceEvent) - trace - -{-# DEPRECATED Trace "Use 'SimTrace' instead." #-} pattern SimTrace :: Time -> ThreadId -> Maybe ThreadLabel -> SimEventType -> SimTrace a -> SimTrace a @@ -841,7 +825,6 @@ pattern TraceLoop :: SimTrace a pattern TraceLoop = Trace.Nil Loop {-# COMPLETE SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceLoop #-} -{-# COMPLETE Trace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceLoop #-} data SimEventType @@ -895,9 +878,11 @@ data SimEventType | EventUnblocked [ThreadId] deriving Show -type TraceEvent = SimEventType -{-# DEPRECATED TraceEvent "Use 'SimEventType' instead." #-} +-- | A labelled value. +-- +-- For example 'labelThread' or `labelTVar' will insert a label to `ThreadId` +-- (or `TVarId`). data Labelled a = Labelled { l_labelled :: !a, l_label :: !(Maybe String) diff --git a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs index 8504f603..cf9159d6 100644 --- a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs +++ b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs @@ -18,14 +18,12 @@ module Control.Monad.IOSimPOR.Internal ( IOSim (..) - , SimM , runIOSim , runSimTraceST , traceM , traceSTM , STM , STMSim - , SimSTM , setCurrentTime , unshareClock , TimeoutException (..) @@ -35,11 +33,10 @@ module Control.Monad.IOSimPOR.Internal , ThreadLabel , Labelled (..) , SimTrace - , Trace.Trace (SimPORTrace, Trace, TraceMainReturn, TraceMainException, TraceDeadlock) + , Trace.Trace (SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock) , SimEvent (..) , SimResult (..) , SimEventType (..) - , TraceEvent , liftST , execReadTVar , controlSimTraceST From 40784b0a66f4a3d137b94a43ec1f4492ee72e416 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 6 Dec 2022 19:34:53 +0100 Subject: [PATCH 02/27] io-sim & io-classes: haddocks One hidden change is adding missing `EventThreadStatus` in `IOSim`. --- .../src/Control/Monad/Class/MonadFork.hs | 10 +- .../src/Control/Monad/Class/MonadTest.hs | 4 + io-sim/src/Control/Monad/IOSim.hs | 226 +++++++++++++----- io-sim/src/Control/Monad/IOSim/CommonTypes.hs | 8 + io-sim/src/Control/Monad/IOSim/Internal.hs | 10 +- io-sim/src/Control/Monad/IOSim/STM.hs | 4 +- io-sim/src/Control/Monad/IOSim/Types.hs | 191 ++++++++++++--- io-sim/src/Control/Monad/IOSimPOR/Internal.hs | 3 +- io-sim/src/Data/List/Trace.hs | 4 +- .../Monad/Class/MonadTimer/NonStandard.hs | 14 +- 10 files changed, 359 insertions(+), 115 deletions(-) diff --git a/io-classes/src/Control/Monad/Class/MonadFork.hs b/io-classes/src/Control/Monad/Class/MonadFork.hs index ea9c9200..77a7a9e6 100644 --- a/io-classes/src/Control/Monad/Class/MonadFork.hs +++ b/io-classes/src/Control/Monad/Class/MonadFork.hs @@ -5,8 +5,8 @@ module Control.Monad.Class.MonadFork ( MonadThread (..) - , MonadFork (..) , labelThisThread + , MonadFork (..) ) where import qualified Control.Concurrent as IO @@ -25,6 +25,10 @@ class (Monad m, Eq (ThreadId m), myThreadId :: m (ThreadId m) labelThread :: ThreadId m -> String -> m () +-- | Apply the label to the current thread +labelThisThread :: MonadThread m => String -> m () +labelThisThread label = myThreadId >>= \tid -> labelThread tid label + class MonadThread m => MonadFork m where @@ -66,7 +70,3 @@ instance MonadFork m => MonadFork (ReaderT e m) where in runReaderT (k restore') e throwTo e t = lift (throwTo e t) yield = lift yield - --- | Apply the label to the current thread -labelThisThread :: MonadThread m => String -> m () -labelThisThread label = myThreadId >>= \tid -> labelThread tid label diff --git a/io-classes/src/Control/Monad/Class/MonadTest.hs b/io-classes/src/Control/Monad/Class/MonadTest.hs index cb069b85..a53c645f 100644 --- a/io-classes/src/Control/Monad/Class/MonadTest.hs +++ b/io-classes/src/Control/Monad/Class/MonadTest.hs @@ -2,7 +2,11 @@ module Control.Monad.Class.MonadTest (MonadTest (..)) where import Control.Monad.Reader +-- | A helper monad for /IOSimPOR/. class Monad m => MonadTest m where + -- | mark a thread for schedule exploration. All threads that are forked by + -- it are also included in the exploration. + -- exploreRaces :: m () exploreRaces = return () diff --git a/io-sim/src/Control/Monad/IOSim.hs b/io-sim/src/Control/Monad/IOSim.hs index dbb03b20..a0319d63 100644 --- a/io-sim/src/Control/Monad/IOSim.hs +++ b/io-sim/src/Control/Monad/IOSim.hs @@ -14,14 +14,23 @@ module Control.Monad.IOSim , runSimStrictShutdown , Failure (..) , runSimTrace - , controlSimTrace + , runSimTraceST + -- ** Explore races using /IOSimPOR/ + -- $iosimpor , exploreSimTrace + , controlSimTrace , ScheduleMod (..) , ScheduleControl (..) - , runSimTraceST + -- *** Exploration options + , ExplorationSpec + , ExplorationOptions (..) + , stdExplorationOptions + , withScheduleBound + , withBranching + , withStepTimelimit + , withReplay + -- * Lift ST computations , liftST - , traceM - , traceSTM -- * Simulation time , setCurrentTime , unshareClock @@ -33,6 +42,9 @@ module Control.Monad.IOSim , SimEventType (..) , ThreadLabel , Labelled (..) + -- ** Dynamic Tracing + , traceM + , traceSTM -- ** Pretty printers , ppTrace , ppTrace_ @@ -56,14 +68,6 @@ module Control.Monad.IOSim , traceSelectTraceEventsSay -- ** IO printer , printTraceEventsSay - -- * Exploration options - , ExplorationSpec - , ExplorationOptions (..) - , stdExplorationOptions - , withScheduleBound - , withBranching - , withStepTimelimit - , withReplay -- * Eventlog , EventlogEvent (..) , EventlogMarker (..) @@ -80,6 +84,7 @@ import Prelude import Data.Bifoldable import Data.Dynamic (fromDynamic) import Data.List (intercalate) +import Data.Set (Set) import qualified Data.Set as Set import Data.Typeable (Typeable) @@ -163,7 +168,7 @@ detachTraceRaces trace = unsafePerformIO $ do go (SimPORTrace a b c d e trace) = SimPORTrace a b c d e $ go trace go (TraceRacesFound r trace) = saveRaces r $ go trace go t = t - return (readRaces,go trace) + return (readRaces, go trace) -- | Select all the traced values matching the expected type. This relies on -- the sim's dynamic trace facility. @@ -257,18 +262,18 @@ traceSelectTraceEventsSay = traceSelectTraceEvents fn fn (EventSay s) = Just s fn _ = Nothing --- | Simulation termination with failure +-- | Simulation terminated a failure. -- data Failure = - -- | The main thread terminated with an exception + -- | The main thread terminated with an exception. FailureException SomeException - -- | The threads all deadlocked + -- | The threads all deadlocked. | FailureDeadlock ![Labelled ThreadId] -- | The main thread terminated normally but other threads were still -- alive, and strict shutdown checking was requested. - -- See 'runSimStrictShutdown' + -- See 'runSimStrictShutdown'. | FailureSloppyShutdown [Labelled ThreadId] -- | An exception was thrown while evaluation the trace. @@ -306,14 +311,22 @@ runSimOrThrow mainAction = Left e -> throw e Right x -> x --- | Like 'runSim' but also fail if when the main thread terminates, there --- are other threads still running or blocked. If one is trying to follow --- a strict thread cleanup policy then this helps testing for that. +-- | Like 'runSim' but fail when the main thread terminates if there are other +-- threads still running or blocked. If one is trying to follow a strict thread +-- cleanup policy then this helps testing for that. -- runSimStrictShutdown :: forall a. (forall s. IOSim s a) -> Either Failure a runSimStrictShutdown mainAction = traceResult True (runSimTrace mainAction) -traceResult :: Bool -> SimTrace a -> Either Failure a +-- | Fold through the trace and return either a 'Failure' or the simulation +-- result, i.e. the return value of the main thread. +-- +traceResult :: Bool + -- ^ if True the simulation will fail if there are any threads which + -- didn't terminated when the main thread terminated. + -> SimTrace a + -- ^ simulation trace + -> Either Failure a traceResult strict = unsafePerformIO . eval where eval :: SimTrace a -> IO (Either Failure a) @@ -334,6 +347,8 @@ traceResult strict = unsafePerformIO . eval go (TraceDeadlock _ threads) = pure $ Left (FailureDeadlock threads) go TraceLoop{} = error "Impossible: traceResult TraceLoop{}" +-- | Turn 'SimTrace' into a list of timestamped events. +-- traceEvents :: SimTrace a -> [(Time, ThreadId, Maybe ThreadLabel, SimEventType)] traceEvents (SimTrace time tid tlbl event t) = (time, tid, tlbl, event) : traceEvents t @@ -342,6 +357,8 @@ traceEvents (SimPORTrace time tid _ tlbl event t) = (time, tid, tlbl, event) traceEvents _ = [] +-- | Pretty print a timestamped event. +-- ppEvents :: [(Time, ThreadId, Maybe ThreadLabel, SimEventType)] -> String ppEvents events = @@ -370,20 +387,42 @@ ppEvents events = runSimTrace :: forall a. (forall s. IOSim s a) -> SimTrace a runSimTrace mainAction = runST (runSimTraceST mainAction) -controlSimTrace :: forall a. - Maybe Int - -> ScheduleControl - -- ^ note: must be either `ControlDefault` or `ControlAwait`. - -> (forall s. IOSim s a) - -> SimTrace a -controlSimTrace limit control mainAction = - runST (controlSimTraceST limit control mainAction) - +-- +-- IOSimPOR +-- +-- +-- $iosimpor +-- +-- /IOSimPOR/ is a different interpreter of 'IOSim' which has the ability to +-- discover race conditions and replay the simulation using a schedule which +-- reverts them. For extended documentation how to use it see +-- [here](https://github.com/input-output-hk/io-sim/blob/main/io-sim/how-to-use-IOSimPOR.md). +-- +-- /IOSimPOR/ only discovers races between events which happen in the same time +-- slot. In /IOSim/ and /IOSimPOR/ time only moves explicitly through timer +-- events, e.g. things like `Control.Monad.Class.MonadTimer.SI.threadDelay`, +-- `Control.Monad.Class.MonadTimer.SI.registerDelay` or the +-- `Control.Monad.Class.MonadTimer.NonStandard.MonadTimeout` api. The usual +-- quickcheck techniques can help explore different schedules of +-- threads too. + +-- | Execute a simulation, discover & revert races. Note that this will execute +-- the simulation multiple times with different schedules, and thus it's much +-- more costly than a simple `runSimTrace` (also the simulation environments has +-- much more state to track and hence is slower). +-- +-- On property failure it will show the failing schedule (`ScheduleControl`) +-- which can be plugged to `controlSimTrace`. +-- exploreSimTrace :: forall a test. Testable test => (ExplorationOptions -> ExplorationOptions) + -- ^ modify default exploration options -> (forall s. IOSim s a) + -- ^ a simulation to run -> (Maybe (SimTrace a) -> SimTrace a -> test) + -- ^ a callback which receives the previous trace (e.g. before reverting + -- a race condition) and current trace -> Property exploreSimTrace optsf mainAction k = case explorationReplay opts of @@ -392,42 +431,49 @@ exploreSimTrace optsf mainAction k = let size = cacheSize() in size `seq` tabulate "Modified schedules explored" [bucket size] True Just control -> - replaySimTrace opts mainAction control k + replaySimTrace opts mainAction control (k Nothing) where opts = optsf stdExplorationOptions + explore :: Int -> Int -> ScheduleControl -> Maybe (SimTrace a) -> Property explore n m control passingTrace = -- ALERT!!! Impure code: readRaces must be called *after* we have -- finished with trace. - let (readRaces,trace0) = detachTraceRaces $ - controlSimTrace (explorationStepTimelimit opts) control mainAction + let (readRaces, trace0) = detachTraceRaces $ + controlSimTrace + (explorationStepTimelimit opts) control mainAction (sleeper,trace) = compareTraces passingTrace trace0 - in (counterexample ("Schedule control: " ++ show control) $ - counterexample (case sleeper of Nothing -> "No thread delayed" - Just ((t,tid,lab),racing) -> - showThread (tid,lab) ++ - " delayed at time "++ - show t ++ - "\n until after:\n" ++ - unlines (map ((" "++).showThread) $ Set.toList racing) - ) $ - k passingTrace trace) .&&| - let limit = (n+m-1) `div` m - -- To ensure the set of schedules explored is deterministic, we filter out - -- cached ones *after* selecting the children of this node. - races = filter (not . cached) . take limit $ readRaces() - branching = length races - in -- tabulate "Races explored" (map show races) $ - tabulate "Branching factor" [bucket branching] $ - tabulate "Race reversals per schedule" [bucket (raceReversals control)] $ - conjoinPar - [ --Debug.trace "New schedule:" $ - --Debug.trace (" "++show r) $ - --counterexample ("Schedule control: " ++ show r) $ - explore n' ((m-1) `max` 1) r (Just trace0) - | (r,n') <- zip races (divide (n-branching) branching) ] - + in ( counterexample ("Schedule control: " ++ show control) + $ counterexample + (case sleeper of + Nothing -> "No thread delayed" + Just ((t,tid,lab),racing) -> + showThread (tid,lab) ++ + " delayed at time "++ + show t ++ + "\n until after:\n" ++ + unlines (map ((" "++).showThread) $ Set.toList racing) + ) + $ k passingTrace trace + ) + .&&| let limit = (n+m-1) `div` m + -- To ensure the set of schedules explored is deterministic, we + -- filter out cached ones *after* selecting the children of this + -- node. + races = filter (not . cached) . take limit $ readRaces () + branching = length races + in -- tabulate "Races explored" (map show races) $ + tabulate "Branching factor" [bucket branching] $ + tabulate "Race reversals per schedule" [bucket (raceReversals control)] $ + conjoinPar + [ --Debug.trace "New schedule:" $ + --Debug.trace (" "++show r) $ + --counterexample ("Schedule control: " ++ show r) $ + explore n' ((m-1) `max` 1) r (Just trace0) + | (r,n') <- zip races (divide (n-branching) branching) ] + + bucket :: Int -> String bucket n | n<10 = show n | n>=10 = buck n 1 | otherwise = error "Ord Int is not a total order!" -- GHC made me do it! @@ -435,6 +481,7 @@ exploreSimTrace optsf mainAction k = | n>=10 = buck (n `div` 10) (t*10) | otherwise = error "Ord Int is not a total order!" -- GHC made me do it! + divide :: Int -> Int -> [Int] divide n k = [ n `div` k + if i "" Just l -> " ("++l++")") + -- cache of explored schedules + cache :: IORef (Set ScheduleControl) + cache = unsafePerformIO cacheIO + + -- insert a schedule into the cache + cached :: ScheduleControl -> Bool + cached = unsafePerformIO . cachedIO + + -- compute cache size; it's a function to make sure that `GHC` does not + -- inline it (and share the same thunk). + cacheSize :: () -> Int + cacheSize = unsafePerformIO . cacheSizeIO + + -- + -- Caching in IO monad + -- + -- It is possible for the same control to be generated several times. -- To avoid exploring them twice, we keep a cache of explored schedules. - cache = unsafePerformIO $ newIORef $ + cacheIO :: IO (IORef (Set ScheduleControl)) + cacheIO = newIORef $ -- we use opts here just to be sure the reference cannot be -- lifted out of exploreSimTrace - if explorationScheduleBound opts>=0 + if explorationScheduleBound opts >=0 then Set.empty else error "exploreSimTrace: negative schedule bound" - cached m = unsafePerformIO $ atomicModifyIORef' cache $ \set -> + + cachedIO :: ScheduleControl -> IO Bool + cachedIO m = atomicModifyIORef' cache $ \set -> (Set.insert m set, Set.member m set) - cacheSize () = unsafePerformIO $ Set.size <$> readIORef cache + + cacheSizeIO :: () -> IO Int + cacheSizeIO () = Set.size <$> readIORef cache + + +-- | A specialised version of `controlSimTrace'. +-- +-- An internal function. +-- replaySimTrace :: forall a test. (Testable test) => ExplorationOptions + -- ^ race exploration options -> (forall s. IOSim s a) -> ScheduleControl - -> (Maybe (SimTrace a) -> SimTrace a -> test) + -- ^ a schedule control to reproduce + -> (SimTrace a -> test) + -- ^ a callback which receives the simulation trace. The trace + -- will not contain any race events -> Property replaySimTrace opts mainAction control k = let (_,trace) = detachTraceRaces $ - controlSimTrace (explorationStepTimelimit opts) control mainAction - in property (k Nothing trace) + controlSimTrace (explorationStepTimelimit opts) control mainAction + in property (k trace) + +-- | Run a simulation using a given schedule. This is useful to reproduce +-- failing cases without exploring the races. +-- +controlSimTrace :: forall a. + Maybe Int + -- ^ limit on the computation time allowed per scheduling step, for + -- catching infinite loops etc. + -> ScheduleControl + -- ^ a schedule to replay + -- + -- /note/: must be either `ControlDefault` or `ControlAwait`. + -> (forall s. IOSim s a) + -- ^ a simulation to run + -> SimTrace a +controlSimTrace limit control mainAction = + runST (controlSimTraceST limit control mainAction) raceReversals :: ScheduleControl -> Int raceReversals ControlDefault = 0 diff --git a/io-sim/src/Control/Monad/IOSim/CommonTypes.hs b/io-sim/src/Control/Monad/IOSim/CommonTypes.hs index 183771f3..5254577a 100644 --- a/io-sim/src/Control/Monad/IOSim/CommonTypes.hs +++ b/io-sim/src/Control/Monad/IOSim/CommonTypes.hs @@ -13,6 +13,14 @@ import Data.Map (Map) import Data.STRef.Lazy import Data.Set (Set) + +-- | 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 ThreadId = RacyThreadId [Int] | ThreadId [Int] -- non racy threads have higher priority deriving (Eq, Ord, Show) diff --git a/io-sim/src/Control/Monad/IOSim/Internal.hs b/io-sim/src/Control/Monad/IOSim/Internal.hs index 73d193b9..0728d455 100644 --- a/io-sim/src/Control/Monad/IOSim/Internal.hs +++ b/io-sim/src/Control/Monad/IOSim/Internal.hs @@ -117,7 +117,8 @@ labelledThreads threadMap = -- | Timers mutable variables. Supports 'newTimeout' api, the second --- one 'registerDelay', the third one 'threadDelay'. +-- one 'Control.Monad.Class.MonadTimer.SI.registerDelay', the third one +-- 'Control.Monad.Class.MonadTimer.SI.threadDelay'. -- data TimerCompletionInfo s = Timer !(TVar s TimeoutState) @@ -1017,9 +1018,10 @@ lookupThreadLabel tid threads = join (threadLabel <$> Map.lookup tid threads) -- | The most general method of running 'IOSim' is in 'ST' monad. One can --- recover failures or the result from 'SimTrace' with 'traceResult', or access --- 'SimEventType's generated by the computation with 'traceEvents'. A slightly --- more convenient way is exposed by 'runSimTrace'. +-- recover failures or the result from 'SimTrace' with +-- 'Control.Monad.IOSim.traceResult', or access 'SimEventType's generated by the +-- computation with 'Control.Monad.IOSim.traceEvents'. A slightly more +-- convenient way is exposed by 'Control.Monad.IOSim.runSimTrace'. -- runSimTraceST :: forall s a. IOSim s a -> ST s (SimTrace a) runSimTraceST mainAction = schedule mainThread initialState diff --git a/io-sim/src/Control/Monad/IOSim/STM.hs b/io-sim/src/Control/Monad/IOSim/STM.hs index 25f910e8..159cfc59 100644 --- a/io-sim/src/Control/Monad/IOSim/STM.hs +++ b/io-sim/src/Control/Monad/IOSim/STM.hs @@ -227,8 +227,8 @@ unGetTBQueueDefault (TBQueue queue _size) a = do -- Default MVar implementation in terms of STM (used by sim) -- --- | A default 'MVar' implementation based on `TVar`'s. An 'MVar' provides --- fairness guarantees. +-- | A default 'MonadMVar' implementation is based on `TVar`'s. An @MVar@ +-- guarantees fairness. -- -- /Implementation details:/ -- diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index 108afe45..52508d8b 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -133,9 +133,16 @@ newtype IOSim s a = IOSim { unIOSim :: forall r. (a -> SimA s r) -> SimA s r } runIOSim :: IOSim s a -> SimA s a runIOSim (IOSim k) = k Return +-- | 'IOSim' has the ability to story any 'Typeable' value in its trace which +-- can then be recovered with `selectTraceEventsDynamic` or +-- `selectTraceVentsDynamic'`. +-- traceM :: Typeable a => a -> IOSim s () traceM x = IOSim $ oneShot $ \k -> Output (toDyn x) (k ()) +-- | Trace a value, in the same was as `traceM` does, but from the `STM` monad. +-- This is primarily useful for debugging. +-- traceSTM :: Typeable a => a -> STMSim s () traceSTM x = STM $ oneShot $ \k -> OutputStm (toDyn x) (k ()) @@ -550,6 +557,10 @@ instance MonadAsync (IOSim s) where instance MonadST (IOSim s) where withLiftST f = f liftST +-- | Lift an 'StrictST.ST' computation to 'IOSim'. +-- +-- Note: you can use 'MonadST' to lift 'StrictST.ST' computations, this is just +-- a more convenient function just for 'IOSim'. liftST :: StrictST.ST s a -> IOSim s a liftST action = IOSim $ oneShot $ \k -> LiftST action k @@ -655,26 +666,30 @@ instance MonadEventlog (IOSim s) where traceEventIO = traceM . EventlogEvent traceMarkerIO = traceM . EventlogMarker --- | 'Trace' is a recursive data type, it is the trace of a 'IOSim' computation. --- The trace will contain information about thread sheduling, blocking on --- 'TVar's, and other internal state changes of 'IOSim'. More importantly it --- also supports traces generated by the computation with 'say' (which --- corresponds to using 'putStrLn' in 'IO'), 'traceEventM', or dynamically typed --- traces with 'traceM' (which generalise the @base@ library +-- | 'Trace' is a recursive data type, it is the trace of a 'IOSim' +-- computation. The trace will contain information about thread scheduling, +-- blocking on 'TVar's, and other internal state changes of 'IOSim'. More +-- importantly it also supports traces generated by the computation with 'say' +-- (which corresponds to using 'putStrLn' in 'IO'), 'traceEventM', or +-- dynamically typed traces with 'traceM' (which generalise the @base@ library -- 'Debug.Trace.traceM') -- --- It also contains information on races discovered. +-- It also contains information on discovered races. -- --- See also: 'traceEvents', 'traceResult', 'selectTraceEvents', --- 'selectTraceEventsDynamic' and 'printTraceEventsSay'. +-- See also: 'Control.Monad.IOSim.traceEvents', +-- 'Control.Monad.IOSim.traceResult', 'Control.Monad.IOSim.selectTraceEvents', +-- 'Control.Monad.IOSim.selectTraceEventsDynamic' and +-- 'Control.Monad.IOSim.printTraceEventsSay'. -- data SimEvent + -- | Used when using `IOSim`. = SimEvent { seTime :: !Time, seThreadId :: !ThreadId, seThreadLabel :: !(Maybe ThreadLabel), seType :: !SimEventType } + -- | Only used for /IOSimPOR/ | SimPOREvent { seTime :: !Time, seThreadId :: !ThreadId, @@ -682,11 +697,14 @@ data SimEvent seThreadLabel :: !(Maybe ThreadLabel), seType :: !SimEventType } + -- | Only used for /IOSimPOR/ | SimRacesFound [ScheduleControl] deriving Generic deriving Show via Quiet SimEvent +-- | Pretty print a 'SimEvent'. +-- ppSimEvent :: Int -- ^ width of the time -> Int -- ^ width of thread id -> Int -- ^ width of thread label @@ -717,14 +735,24 @@ ppSimEvent timeWidth tidWidth tLableWidth SimPOREvent {seTime, seThreadId, seSte ppSimEvent _ _ _ (SimRacesFound controls) = "RacesFound "++show controls +-- | A result type of a simulation. data SimResult a = MainReturn !Time a ![Labelled ThreadId] + -- ^ Return value of the main thread. | MainException !Time SomeException ![Labelled ThreadId] + -- ^ Exception thrown by the main thread. | Deadlock !Time ![Labelled ThreadId] + -- ^ Deadlock discovered in the simulation. Deadlocks are discovered if + -- simply the simulation cannot do any progress in a given time slot and + -- there's no event which would advance the time. | Loop + -- ^ Only returned by /IOSimPOR/ when a step execution took longer than + -- 'explorationStepTimelimit` was exceeded. deriving (Show, Functor) - +-- | A type alias for 'IOSim' simulation trace. It comes with useful pattern +-- synonyms. +-- type SimTrace a = Trace.Trace (SimResult a) SimEvent -- | Pretty print simulation trace. @@ -827,55 +855,114 @@ pattern TraceLoop = Trace.Nil Loop {-# COMPLETE SimTrace, SimPORTrace, TraceMainReturn, TraceMainException, TraceDeadlock, TraceLoop #-} +-- | Events recorded by the simulation. +-- data SimEventType - = EventSimStart ScheduleControl - | EventSay String + = EventSay String + -- ^ hold value of `say` | EventLog Dynamic + -- ^ hold a dynamic value of `Control.Monad.IOSim.traceM` | EventMask MaskingState + -- ^ masking state changed | EventThrow SomeException - | EventThrowTo SomeException ThreadId -- This thread used ThrowTo - | EventThrowToBlocked -- The ThrowTo blocked - | EventThrowToWakeup -- The ThrowTo resumed - | EventThrowToUnmasked (Labelled ThreadId) -- A pending ThrowTo was activated + -- ^ throw exception + | EventThrowTo SomeException ThreadId + -- ^ throw asynchronous exception (`throwTo`) + | EventThrowToBlocked + -- ^ the thread which executed `throwTo` is blocked + | EventThrowToWakeup + -- ^ the thread which executed `throwTo` is woken up + | EventThrowToUnmasked (Labelled ThreadId) + -- ^ a target thread of `throwTo` unmasked its exceptions, this is paired + -- with `EventThrowToWakeup` for threads which were blocked on `throwTo` | EventThreadForked ThreadId - | EventThreadFinished -- terminated normally - | EventThreadUnhandled SomeException -- terminated due to unhandled exception + -- ^ forked a thread + | EventThreadFinished + -- ^ thread terminated normally + | EventThreadUnhandled SomeException + -- ^ thread terminated by an unhandled exception + + -- + -- STM events + -- + + -- | committed STM transaction + | EventTxCommitted [Labelled TVarId] -- ^ stm tx wrote to these + [Labelled TVarId] -- ^ and created these + (Maybe Effect) -- ^ effect performed (only for `IOSimPOR`) + -- | aborted an STM transaction (by an exception) + -- + -- For /IOSimPOR/ it also holds performed effect. + | EventTxAborted (Maybe Effect) + -- | STM transaction blocked (due to `retry`) + | EventTxBlocked [Labelled TVarId] -- stm tx blocked reading these + (Maybe Effect) -- ^ effect performed (only for `IOSimPOR`) + | EventTxWakeup [Labelled TVarId] -- ^ changed vars causing retry + + | EventUnblocked [ThreadId] + -- ^ unblocked threads by a committed STM transaction - | EventTxCommitted [Labelled TVarId] -- tx wrote to these - [Labelled TVarId] -- and created these - (Maybe Effect) -- effect performed (only for `IOSimPOR`) - | EventTxAborted (Maybe Effect) -- effect performed (only for `IOSimPOR`) - | EventTxBlocked [Labelled TVarId] -- tx blocked reading these - (Maybe Effect) -- effect performed (only for `IOSimPOR`) - | EventTxWakeup [Labelled TVarId] -- changed vars causing retry + -- + -- Timeouts, Timers & Delays + -- | EventThreadDelay TimeoutId Time + -- ^ thread delayed | EventThreadDelayFired TimeoutId + -- ^ thread woken up after a delay | EventTimeoutCreated TimeoutId ThreadId Time + -- ^ new timeout created (via `timeout`) | EventTimeoutFired TimeoutId + -- ^ timeout fired | EventRegisterDelayCreated TimeoutId TVarId Time + -- ^ registered delay (via `registerDelay`) | EventRegisterDelayFired TimeoutId + -- ^ registered delay fired | EventTimerCreated TimeoutId TVarId Time + -- ^ a new 'Timeout' created (via `newTimeout`) | EventTimerUpdated TimeoutId Time + -- ^ a 'Timeout' was updated (via `updateTimeout`) | EventTimerCancelled TimeoutId + -- ^ a 'Timeout' was cancelled (via `cancelTimeout`) | EventTimerFired TimeoutId - - -- the following events are inserted to mark the difference between - -- a failed trace and a similar passing trace of the same action - | EventThreadSleep -- the labelling thread was runnable, - -- but its execution was delayed - | EventThreadWake -- until this point + -- ^ a 'Timeout` fired + + -- + -- threadStatus + -- + + -- | event traced when `threadStatus` is executed + | EventThreadStatus ThreadId -- ^ current thread + ThreadId -- ^ queried thread + + -- + -- /IOSimPOR/ events + -- + + | EventSimStart ScheduleControl + -- ^ /IOSimPOR/ event: new execution started exploring the given schedule. + | EventThreadSleep + -- ^ /IOSimPOR/ event: the labelling thread was runnable, but its execution + -- was delayed, until 'EventThreadWake'. + -- + -- Event inserted to mark a difference between a failed trace and a similar + -- passing trace. + | EventThreadWake + -- ^ /IOSimPOR/ event: marks when the thread was rescheduled by /IOSimPOR/ | EventDeschedule Deschedule + -- ^ /IOSim/ and /IOSimPOR/ event: a thread was descheduled | EventFollowControl ScheduleControl + -- ^ /IOSimPOR/ event: following given schedule | EventAwaitControl StepId ScheduleControl + -- ^ /IOSimPOR/ event: thread delayed to follow the given schedule | EventPerformAction StepId + -- ^ /IOSimPOR/ event: perform action of the given step | EventReschedule ScheduleControl - | EventUnblocked [ThreadId] deriving Show @@ -894,6 +981,8 @@ data Labelled a = Labelled { -- Executing STM Transactions -- +-- | Result of an STM computation. +-- data StmTxResult s a = -- | A committed transaction reports the vars that were written (in order -- of first write) so that the scheduler can unblock other threads that @@ -961,6 +1050,8 @@ data StmStack s b a where --- Schedules --- +-- | Modified execution schedule. +-- data ScheduleControl = ControlDefault -- ^ default scheduling mode | ControlAwait [ScheduleMod] @@ -975,6 +1066,8 @@ data ScheduleControl = ControlDefault -- when 'controlTargets' returns true. deriving (Eq, Ord, Show) +-- | A schedule modification inserted at given execution step. +-- data ScheduleMod = ScheduleMod{ -- | Step at which the 'ScheduleMod' is activated. scheduleModTarget :: StepId, @@ -988,6 +1081,9 @@ data ScheduleMod = ScheduleMod{ } deriving (Eq, Ord) +-- | Execution step is identified by the thread id and a monotonically +-- increasing number (thread specific). +-- type StepId = (ThreadId, Int) instance Show ScheduleMod where @@ -1004,11 +1100,42 @@ instance Show ScheduleMod where --- Exploration options --- +-- | Race exploration options. +-- data ExplorationOptions = ExplorationOptions{ explorationScheduleBound :: Int, + -- ^ This is an upper bound on the number of schedules with race reversals + -- that will be explored; a bound of zero means that the default schedule + -- will be explored, but no others. Setting the bound to zero makes + -- IOSimPOR behave rather like IOSim, in that only one schedule is + -- explored, but (a) IOSimPOR is considerably slower, because it still + -- collects information on potential races, and (b) the IOSimPOR schedule + -- is different (based on priorities, in contrast to IOSim's round-robin), + -- and plays better with shrinking. + -- + -- The default value is `100`. explorationBranching :: Int, + -- ^ The branching factor. This is the number of alternative schedules that + -- IOSimPOR tries to run, per race reversal. With the default parameters, + -- IOSimPOR will try to reverse the first 33 (100 div 3) races discovered + -- using the default schedule, then (if 33 or more races are discovered), + -- for each such reversed race, will run the reversal and try to reverse + -- two more races in the resulting schedule. A high branching factor will + -- explore more combinations of reversing fewer races, within the overall + -- schedule bound. A branching factor of one will explore only schedules + -- resulting from a single race reversal (unless there are fewer races + -- available to be reversed than the schedule bound). + -- + -- The default value is `3`. explorationStepTimelimit :: Maybe Int, + -- ^ Limit on the computation time allowed per scheduling step, for + -- catching infinite loops etc. + -- + -- The default value is `Nothing`. explorationReplay :: Maybe ScheduleControl + -- ^ A schedule to replay. + -- + -- The default value is `Nothing`. } deriving Show diff --git a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs index cf9159d6..59bb0f0d 100644 --- a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs +++ b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs @@ -160,7 +160,8 @@ labelledThreads threadMap = -- | Timers mutable variables. First one supports 'newTimeout' api, the second --- one 'registerDelay', the third one 'threadDelay'. +-- one 'Control.Monad.Class.MonadTimer.SI.registerDelay', the third one +-- 'Control.Monad.Class.MonadTimer.SI.threadDelay'. -- data TimerCompletionInfo s = Timer !(TVar s TimeoutState) diff --git a/io-sim/src/Data/List/Trace.hs b/io-sim/src/Data/List/Trace.hs index 2cc15191..7538e4d5 100644 --- a/io-sim/src/Data/List/Trace.hs +++ b/io-sim/src/Data/List/Trace.hs @@ -21,7 +21,7 @@ import Data.Bifunctor import Data.Bitraversable import Data.Functor.Classes --- | A 'cons' list with polymorphic 'nil', thus an octopus. +-- | A 'cons' list with polymorphic 'nil'. -- -- * @'Trace' Void a@ is an infinite stream -- * @'Trace' () a@ is isomorphic to @[a]@ @@ -58,7 +58,7 @@ toList = bifoldr (\_ bs -> bs) (:) [] fromList :: a -> [b] -> Trace a b fromList a = foldr Cons (Nil a) --- | Pretty print an 'Trace'. +-- | Pretty print a 'Trace'. -- ppTrace :: (a -> String) -> (b -> String) -> Trace a b -> String ppTrace sa sb (Cons b bs) = sb b ++ "\n" ++ ppTrace sa sb bs diff --git a/si-timers/src/Control/Monad/Class/MonadTimer/NonStandard.hs b/si-timers/src/Control/Monad/Class/MonadTimer/NonStandard.hs index c3562d63..6b4e34ba 100644 --- a/si-timers/src/Control/Monad/Class/MonadTimer/NonStandard.hs +++ b/si-timers/src/Control/Monad/Class/MonadTimer/NonStandard.hs @@ -13,13 +13,16 @@ -- | A non-standard interface for timer api. -- -- This module also provides a polyfill which allows to use timer api also on --- non-threaded RTS regardless of the architecture \/ OS. +-- non-threaded RTS regardless of the architecture \/ OS. Currently we support +-- `*nix`, `macOS`, `Windows` (and, unofficially `GHCJS`). -- --- We use it to provide 'MonadTimer IO' instance and to implement a cancellable --- timer, see 'registerDelayCancellable' below. +-- We use it to provide @'Control.Monad.Class.MonadTimer.MonadTimer' 'IO'@ +-- instance and to implement a cancellable timers, see +-- 'Control.Monad.Class.MonadTimer.SI.registerDelayCancellable'. -- -- You can expect we will deprecate it at some point (e.g. once GHC gets --- a better support for timers especially across different OSes). +-- a better support for timers especially across different execution +-- environments). -- module Control.Monad.Class.MonadTimer.NonStandard ( TimeoutState (..) @@ -74,6 +77,9 @@ data Timeout = TimeoutIO !(STM.TVar (STM.TVar Bool)) !(STM.TVar Bool) -- (as this would be very racy). You should create a new timeout if you need -- this functionality. -- +-- When native timer manager is supported (on `*nix` systems), it only holds +-- a `TVar` with `TimeoutState` and `GHC.TimeoutKey`. +-- newTimeout :: NewTimeout IO Timeout type NewTimeout m timeout = Int -> m timeout From cf700c3cb80e49327348ee9e9a8c21cd27d22699 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 8 Dec 2022 21:20:59 +0100 Subject: [PATCH 03/27] MonadAsync: added haddocks --- .../src/Control/Monad/Class/MonadAsync.hs | 54 +++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/io-classes/src/Control/Monad/Class/MonadAsync.hs b/io-classes/src/Control/Monad/Class/MonadAsync.hs index e150d941..8afd3ba6 100644 --- a/io-classes/src/Control/Monad/Class/MonadAsync.hs +++ b/io-classes/src/Control/Monad/Class/MonadAsync.hs @@ -56,43 +56,72 @@ class ( MonadSTM m asyncWithUnmask, asyncOnWithUnmask, waitCatchSTM, pollSTM #-} -- | An asynchronous action + -- + -- See 'Async.Async'. type Async m = (async :: Type -> Type) | async -> m + -- | See 'Async.async'. async :: m a -> m (Async m a) + -- | See 'Async.asyncBound'. asyncBound :: m a -> m (Async m a) + -- | See 'Async.asyncOn'. asyncOn :: Int -> m a -> m (Async m a) + -- | See 'Async.asyncThreadId'. asyncThreadId :: Async m a -> ThreadId m + -- | See 'Async.withAsync'. withAsync :: m a -> (Async m a -> m b) -> m b + -- | See 'Async.withAsyncBound'. withAsyncBound :: m a -> (Async m a -> m b) -> m b + -- | See 'Async.withAsyncOn'. withAsyncOn :: Int -> m a -> (Async m a -> m b) -> m b + -- | See 'Async.waitSTM'. waitSTM :: Async m a -> STM m a + -- | See 'Async.pollSTM'. pollSTM :: Async m a -> STM m (Maybe (Either SomeException a)) + -- | See 'Async.waitCatchSTM'. waitCatchSTM :: Async m a -> STM m (Either SomeException a) default waitSTM :: MonadThrow (STM m) => Async m a -> STM m a waitSTM action = waitCatchSTM action >>= either throwSTM return + -- | See 'Async.waitAnySTM'. waitAnySTM :: [Async m a] -> STM m (Async m a, a) + -- | See 'Async.waitAnyCatchSTM'. waitAnyCatchSTM :: [Async m a] -> STM m (Async m a, Either SomeException a) + -- | See 'Async.waitEitherSTM'. waitEitherSTM :: Async m a -> Async m b -> STM m (Either a b) + -- | See 'Async.waitEitherSTM_'. waitEitherSTM_ :: Async m a -> Async m b -> STM m () + -- | See 'Async.waitEitherCatchSTM'. waitEitherCatchSTM :: Async m a -> Async m b -> STM m (Either (Either SomeException a) (Either SomeException b)) + -- | See 'Async.waitBothSTM'. waitBothSTM :: Async m a -> Async m b -> STM m (a, b) + -- | See 'Async.wait'. wait :: Async m a -> m a + -- | See 'Async.poll'. poll :: Async m a -> m (Maybe (Either SomeException a)) + -- | See 'Async.waitCatch'. waitCatch :: Async m a -> m (Either SomeException a) + -- | See 'Async.cancel'. cancel :: Async m a -> m () + -- | See 'Async.cancelWith'. cancelWith :: Exception e => Async m a -> e -> m () + -- | See 'Async.uninterruptibleCancel'. uninterruptibleCancel :: Async m a -> m () + -- | See 'Async.waitAny'. waitAny :: [Async m a] -> m (Async m a, a) + -- | See 'Async.waitAnyCatch'. waitAnyCatch :: [Async m a] -> m (Async m a, Either SomeException a) + -- | See 'Async.waitAnyCancel'. waitAnyCancel :: [Async m a] -> m (Async m a, a) + -- | See 'Async.waitAnyCatchCancel'. waitAnyCatchCancel :: [Async m a] -> m (Async m a, Either SomeException a) + -- | See 'Async.waitEither'. waitEither :: Async m a -> Async m b -> m (Either a b) default waitAnySTM :: MonadThrow (STM m) => [Async m a] -> STM m (Async m a, a) @@ -133,24 +162,39 @@ class ( MonadSTM m -- | Note, IO-based implementations should override the default -- implementation. See the @async@ package implementation and comments. -- + -- + -- See 'Async.waitEitherCatch'. waitEitherCatch :: Async m a -> Async m b -> m (Either (Either SomeException a) (Either SomeException b)) + -- | See 'Async.waitEitherCancel'. waitEitherCancel :: Async m a -> Async m b -> m (Either a b) + -- | See 'Async.waitEitherCatchCancel'. waitEitherCatchCancel :: Async m a -> Async m b -> m (Either (Either SomeException a) (Either SomeException b)) + -- | See 'Async.waitEither_'. waitEither_ :: Async m a -> Async m b -> m () + -- | See 'Async.waitBoth'. waitBoth :: Async m a -> Async m b -> m (a, b) + -- | See 'Async.race'. race :: m a -> m b -> m (Either a b) + -- | See 'Async.race_'. race_ :: m a -> m b -> m () + -- | See 'Async.concurrently'. concurrently :: m a -> m b -> m (a,b) + -- | See 'Async.concurrently_'. concurrently_ :: m a -> m b -> m () + -- | See 'Async.concurrently_'. asyncWithUnmask :: ((forall b . m b -> m b) -> m a) -> m (Async m a) + -- | See 'Async.asyncOnWithUnmask'. asyncOnWithUnmask :: Int -> ((forall b . m b -> m b) -> m a) -> m (Async m a) + -- | See 'Async.withAsyncWithUnmask'. withAsyncWithUnmask :: ((forall c. m c -> m c) -> m a) -> (Async m a -> m b) -> m b + -- | See 'Async.withAsyncOnWithUnmask'. withAsyncOnWithUnmask :: Int -> ((forall c. m c -> m c) -> m a) -> (Async m a -> m b) -> m b + -- | See 'Async.compareAsyncs'. compareAsyncs :: Async m a -> Async m b -> Ordering -- default implementations @@ -279,21 +323,27 @@ instance ( Monoid a mempty = pure mempty +-- | See 'Async.mapConcurrently'. mapConcurrently :: (Traversable t, MonadAsync m) => (a -> m b) -> t a -> m (t b) mapConcurrently f = runConcurrently . traverse (Concurrently . f) +-- | See 'Async.forConcurrently'. forConcurrently :: (Traversable t, MonadAsync m) => t a -> (a -> m b) -> m (t b) forConcurrently = flip mapConcurrently +-- | See 'Async.mapConcurrently_'. mapConcurrently_ :: (Foldable f, MonadAsync m) => (a -> m b) -> f a -> m () mapConcurrently_ f = runConcurrently . foldMap (Concurrently . void . f) +-- | See 'Async.forConcurrently_'. forConcurrently_ :: (Foldable f, MonadAsync m) => f a -> (a -> m b) -> m () forConcurrently_ = flip mapConcurrently_ +-- | See 'Async.replicateConcurrently'. replicateConcurrently :: MonadAsync m => Int -> m a -> m [a] replicateConcurrently cnt = runConcurrently . sequenceA . replicate cnt . Concurrently +-- | See 'Async.replicateConcurrently_'. replicateConcurrently_ :: MonadAsync m => Int -> m a -> m () replicateConcurrently_ cnt = runConcurrently . fold . replicate cnt . Concurrently . void @@ -395,10 +445,12 @@ instance Exception ExceptionInLinkedThread where fromException = E.asyncExceptionFromException toException = E.asyncExceptionToException +-- | Like 'Async.link'. link :: (MonadAsync m, MonadFork m, MonadMask m) => Async m a -> m () link = linkOnly (not . isCancel) +-- | Like 'Async.linkOnly'. linkOnly :: forall m a. (MonadAsync m, MonadFork m, MonadMask m) => (SomeException -> Bool) -> Async m a -> m () linkOnly shouldThrow a = do @@ -416,10 +468,12 @@ linkOnly shouldThrow a = do exceptionInLinkedThread = ExceptionInLinkedThread (show linkedThreadId) +-- | Like 'Async.link2'. link2 :: (MonadAsync m, MonadFork m, MonadMask m) => Async m a -> Async m b -> m () link2 = link2Only (not . isCancel) +-- | Like 'Async.link2Only'. link2Only :: (MonadAsync m, MonadFork m, MonadMask m) => (SomeException -> Bool) -> Async m a -> Async m b -> m () link2Only shouldThrow left right = From 9117f96ccbc1b3dc330f1eeb6ffa1753076eef2b Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 6 Dec 2022 22:06:29 +0100 Subject: [PATCH 04/27] io-sim: public modules Only keep 'Control.Monad.IOSim' as public module. In 'ouroboros-network' we imported 'Control.Monad.IOSim.Types' just to have access to `ThreadId` type constructor, but this is already available by virtue of the associated type alias. --- io-sim/io-sim.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index ddb9e45e..964d93b6 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -42,9 +42,9 @@ library import: warnings hs-source-dirs: src exposed-modules: Data.List.Trace, - Control.Monad.IOSim, - Control.Monad.IOSim.Types + Control.Monad.IOSim other-modules: Control.Monad.IOSim.CommonTypes, + Control.Monad.IOSim.Types, Control.Monad.IOSim.Internal, Control.Monad.IOSim.InternalTypes, Control.Monad.IOSim.STM, From 5dffe9f37cf1b15ab3d5adce660ed8778a5783bd Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 7 Dec 2022 09:49:05 +0100 Subject: [PATCH 05/27] io-sim & strict-stm: provide NoThunks instances We still need to export the internal `execReadTVar` because `ouroboros-consensus` has a very non-standard `StrictMVar`. --- io-sim/io-sim.cabal | 2 ++ io-sim/src/Control/Monad/IOSim.hs | 2 +- io-sim/src/Control/Monad/IOSim/Internal.hs | 5 ++--- io-sim/src/Control/Monad/IOSim/Types.hs | 21 +++++++++++++++++++ io-sim/src/Control/Monad/IOSimPOR/Internal.hs | 4 +--- strict-stm/strict-stm.cabal | 3 ++- 6 files changed, 29 insertions(+), 8 deletions(-) diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 964d93b6..34fc4a7d 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -69,8 +69,10 @@ library exceptions >=0.10, containers, deque, + nothunks, parallel, psqueues >=0.2 && <0.3, + strict-stm ^>=0.6, si-timers ^>=0.6, time >=1.9.1 && <1.13, quiet, diff --git a/io-sim/src/Control/Monad/IOSim.hs b/io-sim/src/Control/Monad/IOSim.hs index a0319d63..a98e4390 100644 --- a/io-sim/src/Control/Monad/IOSim.hs +++ b/io-sim/src/Control/Monad/IOSim.hs @@ -96,7 +96,7 @@ import Control.Monad.ST.Lazy import Control.Monad.Class.MonadThrow as MonadThrow -import Control.Monad.IOSim.Internal +import Control.Monad.IOSim.Internal (runSimTraceST) import Control.Monad.IOSim.Types import Control.Monad.IOSimPOR.Internal (controlSimTraceST) import Control.Monad.IOSimPOR.QuickCheckUtils diff --git a/io-sim/src/Control/Monad/IOSim/Internal.hs b/io-sim/src/Control/Monad/IOSim/Internal.hs index 0728d455..001dc1c0 100644 --- a/io-sim/src/Control/Monad/IOSim/Internal.hs +++ b/io-sim/src/Control/Monad/IOSim/Internal.hs @@ -1277,9 +1277,8 @@ execNewTVar nextVid !mbLabel x = do tvarCurrent, tvarUndo, tvarBlocked, tvarVClock, tvarTrace} -execReadTVar :: TVar s a -> ST s a -execReadTVar TVar{tvarCurrent} = readSTRef tvarCurrent -{-# INLINE execReadTVar #-} + +-- 'execReadTVar' is defined in `Control.Monad.IOSim.Type` and shared with /IOSimPOR/ execWriteTVar :: TVar s a -> a -> ST s () execWriteTVar TVar{tvarCurrent} = writeSTRef tvarCurrent diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index 52508d8b..24fab839 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -65,6 +65,8 @@ module Control.Monad.IOSim.Types , readTimeout , cancelTimeout , awaitTimeout + -- * Low-level API + , execReadTVar ) where import Control.Applicative @@ -73,6 +75,8 @@ import Control.Exception (ErrorCall (..), asyncExceptionFromException, import Control.Monad import Control.Monad.Fix (MonadFix (..)) +import Control.Concurrent.Class.MonadSTM.Strict.TVar (StrictTVar) +import qualified Control.Concurrent.Class.MonadSTM.Strict.TVar as StrictTVar import Control.Monad.Class.MonadAsync hiding (Async) import qualified Control.Monad.Class.MonadAsync as MonadAsync import Control.Monad.Class.MonadEventlog @@ -97,6 +101,7 @@ import Control.Monad.Class.MonadTimer.SI (TimeoutState (..)) import qualified Control.Monad.Class.MonadTimer.SI as SI import Control.Monad.ST.Lazy import qualified Control.Monad.ST.Strict as StrictST +import Control.Monad.ST.Unsafe (unsafeSTToIO) import qualified Control.Monad.Catch as Exceptions import qualified Control.Monad.Fail as Fail @@ -114,6 +119,7 @@ import Data.Time.Clock (diffTimeToPicoseconds) import Data.Typeable import Data.Word (Word64) import qualified Debug.Trace as Debug +import NoThunks.Class (NoThunks (..)) import Text.Printf import GHC.Exts (oneShot) @@ -325,6 +331,11 @@ instance MonadThrow (IOSim s) where instance MonadEvaluate (IOSim s) where evaluate a = IOSim $ oneShot $ \k -> Evaluate a k +-- | Just like the IO instance, we don't actually check anything here +instance NoThunks (IOSim s a) where + showTypeOf _ = "IOSim" + wNoThunks _ctxt _act = return Nothing + instance Exceptions.MonadThrow (IOSim s) where throwM = MonadThrow.throwIO @@ -416,6 +427,16 @@ instance Exceptions.MonadMask (IOSim s) where c <- release resource (Exceptions.ExitCaseSuccess b) return (b, c) +instance NoThunks a => NoThunks (StrictTVar (IOSim s) a) where + showTypeOf _ = "StrictTVar IOSim" + wNoThunks ctxt tvar = do + a <- unsafeSTToIO . lazyToStrictST . execReadTVar . StrictTVar.toLazyTVar + $ tvar + noThunks ctxt a + +execReadTVar :: TVar s a -> ST s a +execReadTVar TVar{tvarCurrent} = readSTRef tvarCurrent +{-# INLINE execReadTVar #-} getMaskingStateImpl :: IOSim s MaskingState unblock, block, blockUninterruptible :: IOSim s a -> IOSim s a diff --git a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs index 59bb0f0d..2b363474 100644 --- a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs +++ b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs @@ -1517,9 +1517,7 @@ execNewTVar nextVid !mbLabel x = do tvarCurrent, tvarUndo, tvarBlocked, tvarVClock, tvarTrace} -execReadTVar :: TVar s a -> ST s a -execReadTVar TVar{tvarCurrent} = readSTRef tvarCurrent -{-# INLINE execReadTVar #-} +-- 'execReadTVar' is defined in `Control.Monad.IOSim.Type` and shared with /IOSim/ execWriteTVar :: TVar s a -> a -> ST s () execWriteTVar TVar{tvarCurrent} = writeSTRef tvarCurrent diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index 028182e7..b1f2f7c9 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -41,11 +41,12 @@ library Control.Concurrent.Class.MonadSTM.Strict.TMVar Control.Concurrent.Class.MonadSTM.Strict.TQueue Control.Concurrent.Class.MonadSTM.Strict.TVar - reexported-modules: Control.Concurrent.Class.MonadSTM.TSem as Control.Concurrent.Class.MonadSTM.Strict.TSem + reexported-modules: Control.Concurrent.Class.MonadSTM.TSem as Control.Concurrent.Class.MonadSTM.Strict.TSem default-language: Haskell2010 build-depends: base >= 4.9 && <4.18, array, stm >= 2.5 && <2.6, + io-classes ^>= 0.6 ghc-options: -Wall -Wno-unticked-promoted-constructors From bdc72e7d222795450e503a3ee4ae080e1f9a1cee Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 7 Dec 2022 10:01:05 +0100 Subject: [PATCH 06/27] Make all packages compatible with `ghc-8.6` and `ghc-8.8` This is not tested on CI, and it compiles with benign warnings. --- io-sim/src/Data/List/Trace.hs | 3 +++ io-sim/test/Test/Control/Monad/IOSim.hs | 2 ++ 2 files changed, 5 insertions(+) diff --git a/io-sim/src/Data/List/Trace.hs b/io-sim/src/Data/List/Trace.hs index 7538e4d5..ffdde8c2 100644 --- a/io-sim/src/Data/List/Trace.hs +++ b/io-sim/src/Data/List/Trace.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} module Data.List.Trace @@ -106,8 +107,10 @@ instance Monoid a => Monad (Trace a) where -- @bifoldMap Nil id@ is the @join@ of @Trace a@ o >>= f = bifoldMap Nil id $ fmap f o +#if MIN_VERSION_base(4,13,0) instance Monoid a => MonadFail (Trace a) where fail _ = mzero +#endif instance Monoid a => Alternative (Trace a) where empty = mempty diff --git a/io-sim/test/Test/Control/Monad/IOSim.hs b/io-sim/test/Test/Control/Monad/IOSim.hs index a9ce9772..285b0d30 100644 --- a/io-sim/test/Test/Control/Monad/IOSim.hs +++ b/io-sim/test/Test/Control/Monad/IOSim.hs @@ -339,6 +339,8 @@ prop_mfix_lazy (NonEmpty env) = ( #if MIN_VERSION_base(4,13,0) MonadFail m +#else + Monad m #endif ) => m Char From 2be05a0f2533bb3f3e3e7228e38c2d1d08b74067 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 7 Dec 2022 10:07:47 +0100 Subject: [PATCH 07/27] io-sim: removed not needed GHC options --- io-sim/src/Control/Monad/IOSim/Internal.hs | 1 - io-sim/src/Control/Monad/IOSim/Types.hs | 4 ++-- io-sim/src/Control/Monad/IOSimPOR/Internal.hs | 1 - 3 files changed, 2 insertions(+), 4 deletions(-) diff --git a/io-sim/src/Control/Monad/IOSim/Internal.hs b/io-sim/src/Control/Monad/IOSim/Internal.hs index 001dc1c0..a7ca351c 100644 --- a/io-sim/src/Control/Monad/IOSim/Internal.hs +++ b/io-sim/src/Control/Monad/IOSim/Internal.hs @@ -10,7 +10,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-orphans #-} -- incomplete uni patterns in 'schedule' (when interpreting 'StmTxCommitted') -- and 'reschedule'. {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index 24fab839..0a380cf7 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -12,8 +12,8 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -{-# OPTIONS_GHC -Wno-partial-fields #-} +-- Needed for `SimEvent` type. +{-# OPTIONS_GHC -Wno-partial-fields #-} module Control.Monad.IOSim.Types ( IOSim (..) diff --git a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs index 2b363474..931e5f7f 100644 --- a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs +++ b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs @@ -11,7 +11,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-orphans #-} -- incomplete uni patterns in 'schedule' (when interpreting 'StmTxCommitted') -- and 'reschedule'. {-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-unused-matches #-} From 10af43ea151633d88b09bc0a03cbe61931fdd9af Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 7 Dec 2022 10:24:01 +0100 Subject: [PATCH 08/27] Updated default-extensions fields in cabal files --- io-classes/io-classes.cabal | 26 ++++++++++++++++++++------ io-sim/io-sim.cabal | 6 ++++++ si-timers/si-timers.cabal | 10 +++------- strict-stm/strict-stm.cabal | 8 ++++++++ 4 files changed, 37 insertions(+), 13 deletions(-) diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index 8adc5298..2cf23e4f 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -63,14 +63,28 @@ library Control.Monad.Class.MonadTest default-language: Haskell2010 other-extensions: CPP - TypeFamilies - TypeFamilyDependencies - MultiParamTypeClasses - FunctionalDependencies - FlexibleInstances + DataKinds + DefaultSignatures + DeriveFunctor + DeriveGeneric + DerivingStrategies + ExistentialQuantification + ExplicitNamespaces FlexibleContexts - ScopedTypeVariables + FlexibleInstances + FunctionalDependencies + GADTs + GeneralisedNewtypeDeriving + MultiParamTypeClasses + NamedFieldPuns + QuantifiedConstraints RankNTypes + ScopedTypeVariables + StandaloneDeriving + TypeFamilies + TypeFamilyDependencies + TypeOperators + UndecidableInstances build-depends: base >=4.9 && <4.18, array, async >=2.1, diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 34fc4a7d..8e2cdfae 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -55,12 +55,18 @@ library default-language: Haskell2010 other-extensions: BangPatterns, CPP, + DeriveFunctor, + DeriveGeneric, + DerivingVia, ExistentialQuantification, + ExplicitNamespaces, + FlexibleContexts, FlexibleInstances, GADTSyntax, GeneralizedNewtypeDeriving, MultiParamTypeClasses, NamedFieldPuns, + NumericUnderscores, RankNTypes, ScopedTypeVariables, TypeFamilies diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index fe8091d8..26a5972b 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -46,13 +46,9 @@ library other-extensions: BangPatterns, CPP, ConstraintKinds, - ExistentialQuantification, - FlexibleInstances, - GADTSyntax, - GeneralizedNewtypeDeriving, - MultiParamTypeClasses, - NamedFieldPuns, - RankNTypes, + DefaultSignatures, + DeriveGeneric, + NumericUnderscores, ScopedTypeVariables, TypeFamilies build-depends: base >=4.9 && <4.18, diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index b1f2f7c9..667654db 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -43,6 +43,14 @@ library Control.Concurrent.Class.MonadSTM.Strict.TVar reexported-modules: Control.Concurrent.Class.MonadSTM.TSem as Control.Concurrent.Class.MonadSTM.Strict.TSem default-language: Haskell2010 + default-extensions: BangPatterns, + CPP, + ExplicitNamespaces, + FlexibleContexts, + FlexibleInstances, + GADTs, + NamedFieldPuns, + TypeOperators build-depends: base >= 4.9 && <4.18, array, stm >= 2.5 && <2.6, From 632e4b320deba07c3c2dc9665237f0c334607079 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 7 Dec 2022 10:43:43 +0100 Subject: [PATCH 09/27] Updated authors & maintainers in cabal files Listing authors & maintains in alphabetic order (by name). --- io-classes/io-classes.cabal | 4 ++-- io-sim/io-sim.cabal | 4 ++-- si-timers/si-timers.cabal | 6 +++--- strict-stm/strict-stm.cabal | 4 ++-- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index 2cf23e4f..4fc72942 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -8,8 +8,8 @@ license-files: LICENSE NOTICE copyright: 2019-2023 Input Output Global Inc (IOG) -author: Alexander Vieth, Marcin Szamotulski, Duncan Coutts -maintainer: +author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas Winant +maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.4 diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 8e2cdfae..0d88afff 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -8,8 +8,8 @@ license-files: LICENSE NOTICE copyright: 2019-2023 Input Output Global Inc (IOG) -author: Duncan Coutts, Marcin Szamotulski, Alexander Vieth -maintainer: +author: Alexander Vieth, Duncan Coutts, John Hughes, Marcin Szamotulski +maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Testing build-type: Simple tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.4 diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index 26a5972b..448d6a88 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -9,8 +9,8 @@ license-files: LICENSE NOTICE copyright: 2022-2023 Input Output Global Inc (IOG) -author: Duncan Coutts, Marcin Szamotulski, Neil Davis -maintainer: Marcin Szamotulski +author: Duncan Coutts, Neil Davis, Marcin Szamotulski +maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.3 @@ -22,7 +22,7 @@ flag asserts source-repository head type: git - location: https://github.com/input-output-hk/ouroboros-network + location: https://github.com/input-output-hk/io-sim subdir: io-sim common warnings diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index 667654db..084cffa6 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -10,8 +10,8 @@ license-files: LICENSE NOTICE copyright: 2019-2023 Input Output Global Inc (IOG) -author: Alexander Vieth, Marcin Szamotulski, Duncan Coutts -maintainer: +author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas Winant +maintainer: Duncan Coutts dunca@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.4 From 66e08a7dc040cbfac3ef40a653b86bc642b8d4ff Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 7 Dec 2022 21:18:42 +0100 Subject: [PATCH 10/27] cabal files: use concise syntax of tested-with --- io-classes/io-classes.cabal | 2 +- io-sim/io-sim.cabal | 2 +- si-timers/si-timers.cabal | 2 +- strict-stm/strict-stm.cabal | 4 ++-- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index 4fc72942..82f0a5ce 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -12,7 +12,7 @@ author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple -tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.4 +tested-with: GHC == { 8.10, 9.2, 9.4 } source-repository head type: git diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 0d88afff..1b35e461 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -12,7 +12,7 @@ author: Alexander Vieth, Duncan Coutts, John Hughes, Marcin Szamotu maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Testing build-type: Simple -tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.4 +tested-with: GHC == { 8.10, 9.2, 9.4 } flag asserts description: Enable assertions diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index 448d6a88..2ea15139 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -13,7 +13,7 @@ author: Duncan Coutts, Neil Davis, Marcin Szamotulski maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple -tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.3 +tested-with: GHC == { 8.10, 9.2, 9.4 } flag asserts description: Enable assertions diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index 084cffa6..110eb77e 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.0 +cabal-version: 3.0 name: strict-stm version: 0.6.0.0 synopsis: Strict STM interface polymorphic over stm implementation. @@ -14,7 +14,7 @@ author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas maintainer: Duncan Coutts dunca@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple -tested-with: GHC == 8.10.7, GHC == 9.2.5, GHC == 9.4.4 +tested-with: GHC == { 8.10, 9.2, 9.4 } source-repository head type: git From 6159af910759c42d42dcbff6042141fd81e62983 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 8 Dec 2022 12:54:01 +0100 Subject: [PATCH 11/27] io-classes: updated README.md file Also include the README.md and CHANGELOG.md in dist bundle created by `cabal`. --- io-classes/README.md | 126 +++++++++++++++++++++++------------- io-classes/io-classes.cabal | 2 + 2 files changed, 84 insertions(+), 44 deletions(-) diff --git a/io-classes/README.md b/io-classes/README.md index 43dab3e5..6bc3cbb0 100644 --- a/io-classes/README.md +++ b/io-classes/README.md @@ -1,70 +1,69 @@ -# Simulator Monad Class Hierarchy +# IO Monad Class Hierarchy This package provides a monad class hierarchy which is an interface for both the -[io-sim](https://hackage.haskell.org/package/io-sim) and -[IO](https://hackage.haskell.org/package/base-4.14.0.0/docs/GHC-IO.html#t:IO) -monads. It was developed with the following constraints in mind: +[`io-sim`] and [`IO`] monads. It was developed with the following constraints +in mind: * be a drop in replacement for `IO` monad; -* `IO` instances does not alter its original semantics, providing a shallow - bindings to `async`, `base`, `stm` and `exception` packages; +* `IO` instances do not alter its original semantics, providing a shallow + bindings to [`async`], [`base`], [`stm`] and [`exceptions`] packages as well + as timer api; * provide zero cost abstractions. -There are a few departures from this principles, usually visible in type -signature, which we discuss in this document. When using `IO`, for most of the -interfaces, `GHC` can optimise away the provided abstractions with `-o1` -optimisation level. +We provde also non standard extensions of this api: + +* [`strict-stm`]: strict `TVar`'s, and other mutable `STM` variables, with + suport of the [`nothunks`] library; +* [`si-timers`]: timers api: + - 32-bit safe API using `DiffTime` measured in seconds (rather than time in + microseconds represented as `Int` as in `base`) + - cancellble timeouts. + +[`strict-stm`] and [`nothunks`] were successfuly used in large code base to +eliminate space leaks and keep that property over long development cycles. ## Exception Class Hierarchy This package provides an alternative class hierarchy giving access to -exceptions api. The `exception` package class hierarchy is also supported by -`io-sim`, so you can also use either one. +exceptions api. The [`exception`] package class hierarchy is also supported by +[`io-sim`], so you can also use either one. - The `MonadThrow` defined in this package allows to work with exceptions -without having explicit access to `catch` or `mask`. It only provides access -to `throwIO`, `bracket`, `bracket_` and `finally`. `MonadCatch` class provides +The `MonadThrow` defined in this package allows to work with exceptions without +having explicit access to `catch` or `mask`. It only provides access to +`throwIO`, `bracket`, `bracket_` and `finally`. `MonadCatch` class provides api which allows to work with exceptions, e.g. `catch` or `bracketOnError`, and `MonadMask` gives access to low level `mask` and friends. This division makes -code review process somewhat easier. Using only `MonadThrow` constraint the +code review process somewhat easier. Using only `MonadThrow` constraint, the reviewer can be sure that no low level exception api is used, which usually -requires more care, and still allows to do resource handling right. +requires more care. Still `MonadThrow` is general enough to to do resource +handling right. ## Time and Timer APIs -We follow the tradition of splitting time into two units of measures: as unit -of time differences, which has monoidal nature and as a unit of time which is -a G-set for the former. We use -[DiffTime](https://hackage.haskell.org/package/time-1.10/docs/Data-Time-Clock.html#t:DiffTime) -for the former and a newtype wrapper `Time` for the later (provided for this -package). `DiffTime` is used consistently across all the type classes which is -one of the few departures from the `base` interface. One example is -[threadDelay](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadTimer.html#v:threadDela) -(provided by `MonadDelay`) which is using `DiffTime` (being in seconds) rather -than passing microseconds as an `Int` - as it is done by `base` package. -Provided `threadDelay` function is safely against overflows, this is especially -important on `32`-bit architectures (with the original `base` -approach on 32-architectures, the maximal delay is slightly more than `30` +The time and timer APIs of this package follows closely the API exposed by +[`base`] and [`time`] packages. We separately packaged a more conveneint API +in [`si-timers`] (ref [SI]), which provides monoidal action of `DiffTime` on +monotonic time as well as exposes 32-bit safe timer API (on 32-bit systems time +in microseconds represented as an `Int` can only holds timeouts of ~35 minutes). -`MonadTimer` class provides a unified interface to `GHC` event manager api as -defined in -[GHC.Event](https://hackage.haskell.org/package/base/docs/GHC-Event.html). We -expose instances also for architectures which do not provide this `GHC` -interface, like `Windows` or `GHCJS`. +`Control.Monad.Class.MonadTimer.NonStandard.MonadTimeout` provides a low level +timeout abstraction. On systems which support native timer manager it's used +to implement its API, which is very efficient even for low latency timeouts. +On other platforms (e.g. `Windows`), it's good enough for subsecond timeouts +but it's not good enough for fine grained timeouts (e.g. sub milliseconds) as +it relays on GHC thread scheduler. We support `MonadTimeout` on `Linux`, +`MacOS`, `Windows` and `IOSim` (and unofficially on `GHCJS`). + +`MonadDelay` and `MonadTimer` classes provide the well established interface to +delays & timers. -A good example of usage of this interface is an implementation of platform -independent (Windows!) and reliable implementation of -[timeout](https://github.com/input-output-hk/ouroboros-network/blob/master/network-mux/src/Network/Mux/Timeout.hs#L225) -function (which lives outside of this package). Note that since it is using -only type classes constraints from this package it also works in -[IOSim](https://hackage.haskell.org/package/io-sim/docs/Control-Monad-IOSim.html#t:IOSim) -monad. ## Software Transactional Memory API -We provide two interfaces to `stm` api: lazy and strict one which is provided -in a seprate library `strict-stm`. +We provide two interfaces to `stm` api: lazy, included in `io-classes`; and +strict one provided by [`strict-stm`]. + ## Threads API @@ -76,6 +75,7 @@ the latter by Both are shallow abstractions around APIs exposed by the `base` and `async` packages. + ## Some other APIs * [MonadEventlog](https://hackage.haskell.org/package/io-sim-classes/docs/Control-Monad-Class-MonadEventlog.html#t:MonadEventlog): @@ -84,3 +84,41 @@ packages. eventlog interface. * [MonadST](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadST.html#t:MonadST): provides a way to lift `ST`-computations. * [MonadSay](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadSay.html#t:MonadSay): dummy debugging interface + + +## Debuging & Insepction + +We provide quite extended debuging & insepction api. This proved to be +extremely helpful when analysing complex deadlocks or livelocks or writing +complex quickcheck properties of a highly concurrent system. Some of this is +only possible because we can control execution environment of [`io-sim`]. + +* `labelThread` as part of `MonadThread` ([`IO`], [`io-sim`], which is also + part of `GHC` API, ref [`labelThread`][labelThread-base]); +* `MonadLabelledSTM` which allows to label various `STM` mutable variables, + e.g. `TVar`, `MVar`, etc. ([`io-sim`], not provided by `GHC`); +* `MonadInspectSTM` which allows to inspect values of `STM` mutable variables + when they are commited. ([`io-sim`], not provided by `GHC`). + + +## Monad transformers + +We provide support for monad transformers (although at this stage it might have +its limitations and so there might be some rought edges. PRs are welcomed, +[contributing]). + +[SI]: https://www.wikiwand.com/en/International_System_of_Units +[`DiffTime`]: https://hackage.haskell.org/package/time-1.10/docs/Data-Time-Clock.html#t:DiffTime +[`IO`]: https://hackage.haskell.org/package/base-4.14.0.0/docs/GHC-IO.html#t:IO +[`async`]: https://hackage.haskell.org/package/async +[`base`]: https://hackage.haskell.org/package/base +[`exceptions`]: https://hackage.haskell.org/package/exceptions +[`io-sim`]: https://hackage.haskell.org/package/io-sim +[`si-timers`]: https://hackage.haskell.org/package/si-timers +[`stm`]: https://hackage.haskell.org/package/stm +[`strict-stm`]: https://hackage.haskell.org/package/strict-stm +[`threadDelay`]: https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadTimer.html#v:threadDela +[`time`]: https://hackage.haskell.org/package/time +[contributing]: https://www.github.com/input-output-hk/io-sim/tree/master/CONTRIBUTING.md +[`nothunks`]: https://hackage.haskell.org/package/nothunks +[labelThread-base]: https://hackage.haskell.org/package/base-4.17.0.0/docs/GHC-Conc-Sync.html#v:labelThread diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index 82f0a5ce..c31e0a8b 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -12,6 +12,8 @@ author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple +extra-source-files: CHANGELOG.md + README.md tested-with: GHC == { 8.10, 9.2, 9.4 } source-repository head From 28fbfa9c3fbbb222ffb8760e2721adb3a8946b13 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 8 Dec 2022 13:32:27 +0100 Subject: [PATCH 12/27] io-sim: updated README.md file --- io-sim/README.md | 36 ++++++++++++++++++++++-------------- io-sim/io-sim.cabal | 2 ++ 2 files changed, 24 insertions(+), 14 deletions(-) diff --git a/io-sim/README.md b/io-sim/README.md index eeacaeab..6247756d 100644 --- a/io-sim/README.md +++ b/io-sim/README.md @@ -1,7 +1,8 @@ -# Simulator Monad +# IOSim - IO Simulator Monad -A pure simulator monad built on top of the `ST` monad which supports: +A pure simulator monad built on top of the lazy `ST` monad which supports: + * optional dynamic race discovery and schedule exploration * synchronous and asynchronous exceptions; including: throwing, catching and masking synchronous and asynchronous exceptions; * concurrency (using simulated threads), with interfaces shaped by the @@ -11,21 +12,25 @@ A pure simulator monad built on top of the `ST` monad which supports: * timeouts; * dynamically typed traces and event log tracing; * lifting any `ST` computations; - * deadlock detection. + * inspection of `STM` mutable data structures; + * deadlock detection; + * `MonadFix` instances for both `IOSim` and its corresponding `STM` monad. -`io-sim` is a drop-in replacement for the `IO` monad. It was designed to write easily -testable Haskell networking code. Using -[io-classes](https://hackage.haskell.org/package/io-classes) library -one can write code that can run in both: real `IO` and the `SimM` monad. One -of the design goals was to keep the api as close as possible to `base`, -`exceptions`, `async` and `stm` packages. +`io-sim` together with [`io-classes`] is a drop-in replacement for the `IO` +monad (with some ramifications). It was designed to write easily testable +Haskell code (including simulating socket programming or disk IO). Using +[`io-classes`] and [`si-timers`] libraries one can write code that can run in +both: real `IO` and the `IOSim` monad provided by this package. One of the +design goals was to keep the api as close as possible to `base`, `exceptions`, +`async` and `stm` packages. -As a design choice `IOSim` does not support `MVar`s by default, but they can be -simulated using `stm` interface. - -`io-sim` supports both `io-classes` class hierarchy and `base` -/ `exceptions` class hierarchies (they diverge in some detail). +`io-sim` package also provides two interpreters, a standard one and `IOSimPOR` +which supports dynamic discovery or race conditions and schedule exploration +with partial order reduction. +`io-sim` provides api to explore trace produced by a simulation. It can +contain arbitrary Haskell terms, a feature that is very useful to build +property based tests using `QuickCheck`. The package contains thorough tests, including tests of `STM` against the original specification (as described in [Composable Memory @@ -33,3 +38,6 @@ Transactions](https://research.microsoft.com/en-us/um/people/simonpj/papers/stm/ and its `GHC` implementation. This can be seen in both ways: as a check that our implementation matches the specification and the `GHC` implementation, but also the other way around: that `GHC`s `STM` implementation meets the specification. + +[`io-classes`]: https://hackage.haskell.org/package/io-classes +[`si-timers`]: https://hackage.haskell.org/package/si-timers diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 1b35e461..709f7b2c 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -12,6 +12,8 @@ author: Alexander Vieth, Duncan Coutts, John Hughes, Marcin Szamotu maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Testing build-type: Simple +extra-source-files: CHANGELOG.md + README.md tested-with: GHC == { 8.10, 9.2, 9.4 } flag asserts From dce6e234641747d8d0617bbe69e7231948180ee4 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 8 Dec 2022 15:00:14 +0100 Subject: [PATCH 13/27] si-timers: updated README.md file --- README.md | 1 + si-timers/README.md | 18 ++++++++++++++++++ si-timers/si-timers.cabal | 2 ++ 3 files changed, 21 insertions(+) create mode 100644 si-timers/README.md diff --git a/README.md b/README.md index a42874f1..aa792c42 100644 --- a/README.md +++ b/README.md @@ -61,6 +61,7 @@ a complex, highly-concurrent, distributed system * `io-classes`: class bases interface, which allows to to abstract over the monad * `strict-stm`: strict STM operations +* `si-timers`: non standard timers API ## Differences from `base`, `async` or `exceptions` packages diff --git a/si-timers/README.md b/si-timers/README.md new file mode 100644 index 00000000..a00fe0b2 --- /dev/null +++ b/si-timers/README.md @@ -0,0 +1,18 @@ +# [SI] Timers + +The `si-timers` package provides delays & timeouts which are safe on 32-bit +systems; cancellable timeouts (see `registerDelayCancellable`); a refined +interface for monotonic `Time`. `Time` is given with left monoid action of +`DiffTime` (which encodes the notion of time differences). The +`MonadMonotonicTime`, `MonadDelay` type classes & `MonadTimers` (type synonym) +API provide a consistent interface for working with delays and timeouts. + +`si-timers` package also defined a low level `MonadTimout` type class. On +system with a native timer manager (e.g. `Linux`, `MacOS`, `FreeBSD`), it's +very efficient but for other platforms (e.g. `Windows`), it might not be the +right API for low latency timeouts needed for example for low level networking +code, because it relies on `GHC`'s `RTS` thread scheduling. + +The `SI` comes from the [International System of Units][SI]. + +[SI]: https://www.wikiwand.com/en/International_System_of_Units diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index 2ea15139..a5c55c8a 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -13,6 +13,8 @@ author: Duncan Coutts, Neil Davis, Marcin Szamotulski maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple +extra-source-files: CHANGELOG.md + README.md tested-with: GHC == { 8.10, 9.2, 9.4 } flag asserts From c7be355084b6a430b3f259084dbee0203c64a001 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 8 Dec 2022 15:07:08 +0100 Subject: [PATCH 14/27] strict-stm: updated README.md file --- strict-stm/README.md | 24 +++++++++++------------- strict-stm/strict-stm.cabal | 2 ++ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/strict-stm/README.md b/strict-stm/README.md index 8c9972c0..3305a722 100644 --- a/strict-stm/README.md +++ b/strict-stm/README.md @@ -1,20 +1,18 @@ # Strict Software Transaction Memory The `strict-stm` package provides a strict interface to software transaction -memory. It builds on top of `io-classes` and thus it provides the interface -for both [STM](https://hackage.haskell.org/package/stm) as well as -[io-sim](https://github.com/input-output-hk/io-sim). +memory. It builds on top of [`io-classes`] and thus it provides the interface +for both [`stm`] as well as [`io-sim`]. # Novel testing / space-leak elimination approach The strict interface provides a novel way of testing / eliminating space-leaks -which might lurk in `stm` shared mutable variables. This together with an -interface build on top of -[ghc-heap](https://gitlab.haskell.org/ghc/ghc/-/tree/master/libraries/ghc-heap) -was successfully used to eliminate such bugs in a large system. We strongly -recommend to use `Control.Monad.Class.MonadSTM.Strict`. It exposes the -[MonadSTM](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadSTM.html#t:MonadSTM) -interface and gives access to -[StrictTVar](https://hackage.haskell.org/package/io-sim-classes/docs/Control-Monad-Class-MonadSTM-Strict.html#t:StrictTVar)'s -in place of non-strict -[TVar](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadSTM.html#t:TVar)'s. +which might lurk in `stm` shared mutable variables. Together with the +[`nothunks`] library it was successfully used to eliminate and keep a large +system ([`cardano-node`]) space leak free. + +[`cardano-node`]: https://www.github.com/input-output-hk/cardano-node +[`io-classes`]: https://hackage.haskell.org/package/io-classes +[`io-sim`]: https://hackage.haskell.org/package/io-sim +[`nothunks`]: https://hackage.haskell.org/package/nothunks +[`stm`]: https://hackage.haskell.org/package/stm diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index 110eb77e..e714d317 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -14,6 +14,8 @@ author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas maintainer: Duncan Coutts dunca@well-typed.com, Marcin Szamotulski coot@coot.me category: Control build-type: Simple +extra-source-files: CHANGELOG.md + README.md tested-with: GHC == { 8.10, 9.2, 9.4 } source-repository head From 3fe73bdfc7235333d342daf7a637c8b90a6aa8ee Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 13 Dec 2022 10:54:54 +0100 Subject: [PATCH 15/27] Removed description fields in .cabal files We provide READMEs. --- io-classes/io-classes.cabal | 1 - io-sim/io-sim.cabal | 1 - si-timers/si-timers.cabal | 1 - strict-stm/strict-stm.cabal | 3 --- 4 files changed, 6 deletions(-) diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index c31e0a8b..ffac10f1 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -2,7 +2,6 @@ cabal-version: 3.4 name: io-classes version: 0.6.0.0 synopsis: Type classes for concurrency with STM, ST and timing --- description: license: Apache-2.0 license-files: LICENSE diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 709f7b2c..398853f3 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -2,7 +2,6 @@ cabal-version: 3.4 name: io-sim version: 0.6.0.0 synopsis: A pure simulator for monadic concurrency with STM --- description: license: Apache-2.0 license-files: LICENSE diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index a5c55c8a..459ae788 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -3,7 +3,6 @@ name: si-timers version: 0.6.0.0 synopsis: Timers using SI units (seconds) which are safe on 32-bit platforms. --- description: license: Apache-2.0 license-files: LICENSE diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index e714d317..ad515930 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -2,9 +2,6 @@ cabal-version: 3.0 name: strict-stm version: 0.6.0.0 synopsis: Strict STM interface polymorphic over stm implementation. -description: The `strict-stm` package gives a strict interface to stm, - currently either one provided by `stm` package for the - `IO` monad or `io-sim` package for the `IOSim` monad. license: Apache-2.0 license-files: LICENSE From 1cb8121fbc62c3c6693034871d009e7d2691d1ca Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 13 Dec 2022 11:39:03 +0100 Subject: [PATCH 16/27] MonadMVar: added haddocks --- .../src/Control/Monad/Class/MonadMVar.hs | 20 +++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/io-classes/src/Control/Monad/Class/MonadMVar.hs b/io-classes/src/Control/Monad/Class/MonadMVar.hs index 5a35d18b..991484fe 100644 --- a/io-classes/src/Control/Monad/Class/MonadMVar.hs +++ b/io-classes/src/Control/Monad/Class/MonadMVar.hs @@ -25,23 +25,39 @@ class Monad m => MonadMVar m where type MVar m :: Type -> Type + -- | See 'IO.newEmptyMVar'. newEmptyMVar :: m (MVar m a) + -- | See 'IO.takeMVar'. takeMVar :: MVar m a -> m a + -- | See 'IO.putMVar'. putMVar :: MVar m a -> a -> m () + -- | See 'IO.tryTakeMVar'. tryTakeMVar :: MVar m a -> m (Maybe a) + -- | See 'IO.tryPutMVar'. tryPutMVar :: MVar m a -> a -> m Bool - readMVar :: MVar m a -> m a - tryReadMVar :: MVar m a -> m (Maybe a) + -- | See 'IO.isEmptyMVar'. isEmptyMVar :: MVar m a -> m Bool -- methods with a default implementation + -- | See 'IO.newMVar'. newMVar :: a -> m (MVar m a) + -- | See 'IO.readMVar'. + readMVar :: MVar m a -> m a + -- | See 'IO.tryReadMVar'. + tryReadMVar :: MVar m a -> m (Maybe a) + -- | See 'IO.swapMVar'. swapMVar :: MVar m a -> a -> m a + -- | See 'IO.withMVar'. withMVar :: MVar m a -> (a -> m b) -> m b + -- | See 'IO.withMVarMasked'. withMVarMasked :: MVar m a -> (a -> m b) -> m b + -- | See 'IO.modifyMVar_'. modifyMVar_ :: MVar m a -> (a -> m a) -> m () + -- | See 'IO.modifyMVar'. modifyMVar :: MVar m a -> (a -> m (a, b)) -> m b + -- | See 'IO.modifyMVarMasked_'. modifyMVarMasked_ :: MVar m a -> (a -> m a) -> m () + -- | See 'IO.modifyMVarMasked'. modifyMVarMasked :: MVar m a -> (a -> m (a,b)) -> m b default newMVar :: a -> m (MVar m a) From 0459cb1206c5f73e84926d7a38a3af601fe866f2 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 4 Jan 2023 11:09:31 +0100 Subject: [PATCH 17/27] Updated copyright field --- NOTICE | 2 +- io-classes/NOTICE | 2 +- io-sim/io-sim.cabal | 2 +- si-timers/NOTICE | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/NOTICE b/NOTICE index f3a42c2d..acd2b2cd 100644 --- a/NOTICE +++ b/NOTICE @@ -1,4 +1,4 @@ -Copyright 2022 Input Output (Hong Kong) Ltd. +Copyright 2019-2023 Input Output Global Inc (IOG) Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/io-classes/NOTICE b/io-classes/NOTICE index 2787a02a..acd2b2cd 100644 --- a/io-classes/NOTICE +++ b/io-classes/NOTICE @@ -1,4 +1,4 @@ -Copyright 2019-2023 Input Output (Hong Kong) Ltd. +Copyright 2019-2023 Input Output Global Inc (IOG) Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 398853f3..16cd789c 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -6,7 +6,7 @@ license: Apache-2.0 license-files: LICENSE NOTICE -copyright: 2019-2023 Input Output Global Inc (IOG) +copyright: 2022-2023 Input Output Global Inc (IOG) author: Alexander Vieth, Duncan Coutts, John Hughes, Marcin Szamotulski maintainer: Duncan Coutts duncan@well-typed.com, Marcin Szamotulski coot@coot.me category: Testing diff --git a/si-timers/NOTICE b/si-timers/NOTICE index 3a29844a..acd2b2cd 100644 --- a/si-timers/NOTICE +++ b/si-timers/NOTICE @@ -1,4 +1,4 @@ -Copyright 2019-2020 Input Output (Hong Kong) Ltd. +Copyright 2019-2023 Input Output Global Inc (IOG) Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. From 87c5781319038566f478f2ff7370a909a79853af Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 4 Jan 2023 11:34:24 +0100 Subject: [PATCH 18/27] Updated CONTRIBUTING.md file --- CONTRIBUTING.md | 42 +++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index f5f69cdb..bbf4637b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,8 +1,7 @@ # Building The project is build with `cabal-install`. You might need to run `cabal -update` after cloning the repository (to update [`Cardano Haskell -Packages`][CHaP] (`ChaP`) index). +update` after cloning the repository. # Design Principles @@ -12,14 +11,9 @@ the core packages, see [example](https://github.com/input-output-hk/io-sim/blob/main/io-classes/src/Control/Monad/Class/MonadSTM.hs?plain=1#L410-L446). Please keep this in mind when adding new functionality. -# Using in your project +# Roles and Responsibilities -Currently the package is published to [`CHaP`][CHaP]. In future it will be -published to `Hackage`. If you want to pull it from [`CHaP`][CHaP], this is -relatively easy to setup; for example, checkout the -[`cabal.project`](https://github.com/input-output-hk/typed-protocols/blob/master/cabal.project) -file. Alternatively, you can relay on `source-repository-package` stanza in -a `cabal.project` file. +Maintainers of each package are listed in the corresponding `*.cabal` file. # Testing @@ -67,7 +61,8 @@ Please follow local style. For a more detailed style guide see Each commit shall be small and preferably address one thing at a time. Well organised & documented commits make it much easier for the maintainers to -review them. +review them. Hacking sessions are great, but please take your time to organise +your work, this usually improves the quality too! New features should be well documented & tested, which means including new tests as necessary. You might be asked by the maintainers to write & include @@ -76,7 +71,7 @@ additional tests. Each commit should build & test, at least the package you are changing. You can update other packages from this repository in a subsequent commit. -Please use a draft PRs if the work is still in progress. +Please use a draft PR if the work is still in progress. We require all commits to be signed, see [this guide][gh-signing-commits]. @@ -85,21 +80,35 @@ issue, see [GitHub documentation][gh-link-issue]. Please include your changes in `CHANGELOG.md` files (per package). +We prefer to avoid merging commits, rebasing a well organised PR is usually +quite simple. + +## Code Style + +Please follow local style. For a more detailed style guide see +[link](https://github.com/input-output-hk/ouroboros-network/blob/master/docs/StyleGuide.md). + ## MonadSTM features If you are adding a new functionality to `MonadSTM`, don't forget to support it in `strict-stm` package. +## CI + +We run CI using [GitHub actions][ci]. + # Releases -The major version of `io-sim`, `io-classes` and `strict-stm` packages are kept -in sync. This means that if any of the packages introduces a breaking change -all major version SHOULD be bumped. The minor versions are kept independent. +The major version of `io-sim`, `io-classes`, `strict-stm` and `si-timers` +packages are kept in sync. This means that if any of the packages introduces +a breaking change all major version SHOULD be bumped. The minor versions are +kept independent. The `io-classes-mtl` is still experimental and thus it's not +following that principle. The drawback is that if you declare `io-classes ^>= 0.x` then you will need to bump it when new version of `io-sim` is published (even if there are no changes in `io-classes`). The con is that you just need to declare version of -`io-classes` to have a consistent ecosystem of the three packages. +`io-classes` to have a consistent ecosystem of the four packages. # Tips @@ -128,5 +137,4 @@ more lazy than `IO` monad. Thus if you want to use `Debug.Trace.traceM` inside [CHaP]: https://github.com/input-output-hk/cardano-haskell-packages/ [gh-link-issue]: https://docs.github.com/en/github/managing-your-work-on-github/linking-a-pull-request-to-an-issue [gh-signing-commits]: https://docs.github.com/en/authentication/managing-commit-signature-verification/signing-commits - - +[ci]: https://github.com/input-output-hk/io-sim/actions From 9e149fca8c34f1e1a5820544330a7a7f1c5f3c17 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 4 Jan 2023 11:34:49 +0100 Subject: [PATCH 19/27] Added SECURITY.md file Following the Cardano Engineering Handbook. --- SECURITY.md | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 SECURITY.md diff --git a/SECURITY.md b/SECURITY.md new file mode 100644 index 00000000..6d68e556 --- /dev/null +++ b/SECURITY.md @@ -0,0 +1,2 @@ +See the security file in the [Cardano engineering handbook](https://github.com/input-output-hk/cardano-engineering-handbook/blob/main/SECURITY.md). + From c9f4f39549b5d58cf89be8e1764c5b4bebe476c3 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 4 Jan 2023 15:01:31 +0100 Subject: [PATCH 20/27] Enhance documentation of MonadTraceSTM Expose MonadTraceSTM methods from `Control.Monad.Class.MonadSTM`, otherwise the methods are only documented in the internal module `Control.Monad.Class.MonadSTM.Internal`! --- .../src/Control/Concurrent/Class/MonadSTM.hs | 2 +- .../src/Control/Monad/Class/MonadSTM.hs | 16 ++++- .../Control/Monad/Class/MonadSTM/Internal.hs | 58 ++++++++++++++----- io-sim/src/Control/Monad/IOSim/Types.hs | 2 +- .../Concurrent/Class/MonadSTM/Strict.hs | 6 +- .../Class/MonadSTM/Strict/TBQueue.hs | 2 +- .../Concurrent/Class/MonadSTM/Strict/TMVar.hs | 2 +- .../Class/MonadSTM/Strict/TQueue.hs | 2 +- .../Concurrent/Class/MonadSTM/Strict/TVar.hs | 2 +- 9 files changed, 69 insertions(+), 23 deletions(-) diff --git a/io-classes/src/Control/Concurrent/Class/MonadSTM.hs b/io-classes/src/Control/Concurrent/Class/MonadSTM.hs index d53113cd..8349fae9 100644 --- a/io-classes/src/Control/Concurrent/Class/MonadSTM.hs +++ b/io-classes/src/Control/Concurrent/Class/MonadSTM.hs @@ -1,4 +1,4 @@ --- | This module corresponds to `Control.Concurrent.STM` in "stm" package +-- | This module corresponds to "Control.Concurrent.STM" in "stm" package -- module Control.Concurrent.Class.MonadSTM (module STM) diff --git a/io-classes/src/Control/Monad/Class/MonadSTM.hs b/io-classes/src/Control/Monad/Class/MonadSTM.hs index 8a1e1139..92512b8c 100644 --- a/io-classes/src/Control/Monad/Class/MonadSTM.hs +++ b/io-classes/src/Control/Monad/Class/MonadSTM.hs @@ -1,4 +1,4 @@ --- | This module corresponds to `Control.Monad.STM` in "stm" package +-- | This module corresponds to "Control.Monad.STM" in "stm" package -- {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} @@ -14,10 +14,20 @@ module Control.Monad.Class.MonadSTM ( MonadSTM (STM, atomically, retry, orElse, check) , throwSTM -- * non standard extensions + -- + -- $non-standard-extensions , MonadLabelledSTM - , MonadTraceSTM - , MonadInspectSTM (..) + , MonadTraceSTM (..) , TraceValue (..) + , MonadInspectSTM (..) ) where import Control.Monad.Class.MonadSTM.Internal + +-- $non-standard-extensions +-- +-- The non standard extensions include `MonadLabelledSTM` and `MonadTraceSTM` / +-- `MonadInspectSTM`. For `IO` these are all no-op, however they greatly +-- enhance [`IOSim`](https://hackage.haskell.org/package/io-sim) capabilities. +-- They are not only useful for debugging concurrency issues, but also to write +-- testable properties. diff --git a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs index b95a436a..6b64b3b6 100644 --- a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs +++ b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs @@ -76,18 +76,27 @@ import GHC.Stack import Numeric.Natural (Natural) --- The STM primitives +-- | The STM primitives parametrised by a monad `m`. +-- class (Monad m, Monad (STM m)) => MonadSTM m where - -- STM transactions + -- | The STM monad. type STM m = (stm :: Type -> Type) | stm -> m + -- | Atomically run an STM computation. + -- + -- See `STM.atomically`. atomically :: HasCallStack => STM m a -> m a + -- | A type of a 'TVar'. + -- + -- See `STM.TVar'. type TVar m :: Type -> Type newTVar :: a -> STM m (TVar m a) readTVar :: TVar m a -> STM m a writeTVar :: TVar m a -> a -> STM m () + -- | See `STM.retry`. retry :: STM m a + -- | See `STM.orElse`. orElse :: STM m a -> STM m a -> STM m a modifyTVar :: TVar m a -> (a -> a) -> STM m () @@ -103,6 +112,7 @@ class (Monad m, Monad (STM m)) => MonadSTM m where swapTVar :: TVar m a -> a -> STM m a swapTVar = swapTVarDefault + -- | See `STM.check`. check :: Bool -> STM m () check True = return () check _ = retry @@ -384,10 +394,15 @@ swapTVarDefault var new = do return old --- | Labelled 'TVar's, 'TMVar's, 'TQueue's and 'TBQueue's. +-- | Labelled `TVar`s & friends. +-- +-- The `IO` instances is no-op, the `IOSim` instance enhances simulation trace. +-- This is very useful when analysing low lever concurrency issues (e.g. +-- deadlocks, livelocks etc). -- class MonadSTM m => MonadLabelledSTM m where + -- | Name a `TVar`. labelTVar :: TVar m a -> String -> STM m () labelTMVar :: TMVar m a -> String -> STM m () labelTQueue :: TQueue m a -> String -> STM m () @@ -460,15 +475,21 @@ class MonadSTM m labelTChanIO = \v l -> atomically (labelTChan v l) --- | This type class is indented for 'io-sim', where one might want to access --- 'TVar' in the underlying 'ST' monad. +-- | This type class is indented for +-- ['io-sim'](https://hackage.haskell.org/package/io-sim), where one might want +-- to access a 'TVar' in the underlying 'ST' monad. -- class ( MonadSTM m , Monad (InspectMonad m) ) => MonadInspectSTM m where type InspectMonad m :: Type -> Type + -- | Return the value of a `TVar` as an `InspectMonad` computation. + -- + -- `inspectTVar` is useful if the value of a `TVar` observed by `traceTVar` + -- contains other `TVar`s. inspectTVar :: proxy m -> TVar m a -> InspectMonad m a + -- | Return the value of a `TMVar` as an `InspectMonad` computation. inspectTMVar :: proxy m -> TMVar m a -> InspectMonad m (Maybe a) -- TODO: inspectTQueue, inspectTBQueue @@ -480,8 +501,10 @@ instance MonadInspectSTM IO where -- | A GADT which instructs how to trace the value. The 'traceDynamic' will --- use dynamic tracing, e.g. 'Control.Monad.IOSim.traceM'; while 'traceString' --- will be traced with 'EventSay'. +-- use dynamic tracing, e.g. "Control.Monad.IOSim.traceM"; while 'traceString' +-- will be traced with 'EventSay'. The `IOSim`s dynamic tracing allows to +-- recover the value from the simulation trace (see +-- "Control.Monad.IOSim.selectTraceEventsDynamic"). -- data TraceValue where TraceValue :: forall tr. Typeable tr @@ -491,7 +514,7 @@ data TraceValue where -> TraceValue --- | Use only dynamic tracer. +-- | Use only a dynamic tracer. -- pattern TraceDynamic :: () => forall tr. Typeable tr => tr -> TraceValue pattern TraceDynamic tr <- TraceValue { traceDynamic = Just tr } @@ -520,14 +543,23 @@ pattern DontTrace <- TraceValue Nothing Nothing -- class MonadInspectSTM m => MonadTraceSTM m where - -- | Construct a trace out of previous & new value of a 'TVar'. The callback - -- is called whenever an stm transaction which modifies the 'TVar' is + {-# MINIMAL traceTVar, traceTQueue, traceTBQueue #-} + + -- | Construct a trace output out of previous & new value of a 'TVar'. The + -- callback is called whenever an stm transaction which modifies the 'TVar' is -- committed. -- - -- This is supported by 'IOSim' and 'IOSimPOR'; 'IO' has a trivial instance. + -- This is supported by 'IOSim' (and 'IOSimPOR'); 'IO' has a trivial instance. + -- + -- The simplest example is: + -- + -- > + -- > traceTVar (Proxy @m) tvar (\_ -> TraceString . show) + -- > + -- + -- Note that the interpretation of `TraceValue` depends on the monad `m` + -- itself (see 'TraceValue'). -- - {-# MINIMAL traceTVar, traceTQueue, traceTBQueue #-} - traceTVar :: proxy m -> TVar m a -> (Maybe a -> a -> InspectMonad m TraceValue) diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index 0a380cf7..e8e95b90 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -141,7 +141,7 @@ runIOSim (IOSim k) = k Return -- | 'IOSim' has the ability to story any 'Typeable' value in its trace which -- can then be recovered with `selectTraceEventsDynamic` or --- `selectTraceVentsDynamic'`. +-- `selectTraceEventsDynamic'`. -- traceM :: Typeable a => a -> IOSim s () traceM x = IOSim $ oneShot $ \k -> Output (toDyn x) (k ()) diff --git a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict.hs b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict.hs index f4476375..133a2250 100644 --- a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict.hs +++ b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict.hs @@ -4,7 +4,11 @@ module Control.Concurrent.Class.MonadSTM.Strict (module STM) where -import Control.Monad.Class.MonadSTM as STM +import Control.Monad.Class.MonadSTM as STM hiding ( traceTVar, traceTVarIO, + traceTMVar, traceTMVarIO, + traceTQueue, traceTQueueIO, + traceTBQueue, traceTBQueueIO + ) import Control.Concurrent.Class.MonadSTM.Strict.TVar as STM import Control.Concurrent.Class.MonadSTM.Strict.TMVar as STM import Control.Concurrent.Class.MonadSTM.Strict.TChan as STM diff --git a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TBQueue.hs b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TBQueue.hs index d5b0ed28..7b02c94b 100644 --- a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TBQueue.hs +++ b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TBQueue.hs @@ -35,7 +35,7 @@ module Control.Concurrent.Class.MonadSTM.Strict.TBQueue import qualified Control.Concurrent.Class.MonadSTM.TBQueue as Lazy -import Control.Monad.Class.MonadSTM +import Control.Monad.Class.MonadSTM hiding (traceTBQueue, traceTBQueueIO) import Numeric.Natural (Natural) diff --git a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs index 9567b416..2623b53d 100644 --- a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs +++ b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TMVar.hs @@ -38,7 +38,7 @@ module Control.Concurrent.Class.MonadSTM.Strict.TMVar import qualified Control.Concurrent.Class.MonadSTM.TMVar as Lazy -import Control.Monad.Class.MonadSTM +import Control.Monad.Class.MonadSTM hiding (traceTMVar, traceTMVarIO) type LazyTMVar m = Lazy.TMVar m diff --git a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TQueue.hs b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TQueue.hs index 343fed9a..d12e25c2 100644 --- a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TQueue.hs +++ b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TQueue.hs @@ -34,7 +34,7 @@ module Control.Concurrent.Class.MonadSTM.Strict.TQueue import qualified Control.Concurrent.Class.MonadSTM.TQueue as Lazy -import Control.Monad.Class.MonadSTM +import Control.Monad.Class.MonadSTM hiding (traceTQueue, traceTQueueIO) type LazyTQueue m = Lazy.TQueue m diff --git a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TVar.hs b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TVar.hs index eeed40b4..7fd0124b 100644 --- a/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TVar.hs +++ b/strict-stm/src/Control/Concurrent/Class/MonadSTM/Strict/TVar.hs @@ -40,7 +40,7 @@ module Control.Concurrent.Class.MonadSTM.Strict.TVar ) where import qualified Control.Concurrent.Class.MonadSTM.TVar as Lazy -import Control.Monad.Class.MonadSTM +import Control.Monad.Class.MonadSTM hiding (traceTVar, traceTVarIO) import GHC.Stack From 532a23f71c678df49f33724a0914d7e8964da9c9 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 4 Jan 2023 17:58:57 +0100 Subject: [PATCH 21/27] io-sim: no need to expose execReadTVar It's exposed as a method of the `MoandInspectSTM`. --- io-sim/src/Control/Monad/IOSim.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/io-sim/src/Control/Monad/IOSim.hs b/io-sim/src/Control/Monad/IOSim.hs index a98e4390..f266b479 100644 --- a/io-sim/src/Control/Monad/IOSim.hs +++ b/io-sim/src/Control/Monad/IOSim.hs @@ -72,7 +72,6 @@ module Control.Monad.IOSim , EventlogEvent (..) , EventlogMarker (..) -- * Low-level API - , execReadTVar , newTimeout , readTimeout , cancelTimeout From bfb45484c1b498a5eda7a711195f2af540ee9d46 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 31 Jan 2023 17:05:07 +0100 Subject: [PATCH 22/27] io-classes: removed default implementations for MonadSTM They are exported and reused in `io-sim`. --- .../src/Control/Monad/Class/MonadMVar.hs | 4 +- .../Control/Monad/Class/MonadSTM/Internal.hs | 255 +++++------------- io-sim/src/Control/Monad/IOSim/Types.hs | 28 ++ 3 files changed, 98 insertions(+), 189 deletions(-) diff --git a/io-classes/src/Control/Monad/Class/MonadMVar.hs b/io-classes/src/Control/Monad/Class/MonadMVar.hs index 991484fe..345df0e5 100644 --- a/io-classes/src/Control/Monad/Class/MonadMVar.hs +++ b/io-classes/src/Control/Monad/Class/MonadMVar.hs @@ -3,9 +3,7 @@ {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE TypeOperators #-} -module Control.Monad.Class.MonadMVar - ( MonadMVar (..) - ) where +module Control.Monad.Class.MonadMVar (MonadMVar (..)) where import qualified Control.Concurrent.MVar as IO import Control.Monad.Class.MonadThrow diff --git a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs index 6b64b3b6..8938677b 100644 --- a/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs +++ b/io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs @@ -28,23 +28,83 @@ module Control.Monad.Class.MonadSTM.Internal , MonadInspectSTM (..) , TraceValue (TraceValue, TraceDynamic, TraceString, DontTrace, traceDynamic, traceString) , MonadTraceSTM (..) - -- * Default 'TMVar' implementation + -- * MonadThrow aliases + , throwSTM + , catchSTM + -- * Default implementations + -- $default-implementations + -- + -- ** Default 'TMVar' implementation , TMVarDefault (..) - -- * Default 'TBQueue' implementation + , newTMVarDefault + , newEmptyTMVarDefault + , takeTMVarDefault + , tryTakeTMVarDefault + , putTMVarDefault + , tryPutTMVarDefault + , readTMVarDefault + , tryReadTMVarDefault + , swapTMVarDefault + , isEmptyTMVarDefault + , labelTMVarDefault + , traceTMVarDefault + -- ** Default 'TBQueue' implementation , TQueueDefault (..) - -- * Default 'TBQueue' implementation + , newTQueueDefault + , writeTQueueDefault + , readTQueueDefault + , tryReadTQueueDefault + , isEmptyTQueueDefault + , peekTQueueDefault + , tryPeekTQueueDefault + , flushTQueueDefault + , unGetTQueueDefault + , labelTQueueDefault + -- ** Default 'TBQueue' implementation , TBQueueDefault (..) - -- * Default 'TArray' implementation + , newTBQueueDefault + , writeTBQueueDefault + , readTBQueueDefault + , tryReadTBQueueDefault + , peekTBQueueDefault + , tryPeekTBQueueDefault + , isEmptyTBQueueDefault + , isFullTBQueueDefault + , lengthTBQueueDefault + , flushTBQueueDefault + , unGetTBQueueDefault + , labelTBQueueDefault + -- ** Default 'TArray' implementation , TArrayDefault (..) - -- * Default 'TSem' implementation + -- ** Default 'TSem' implementation , TSemDefault (..) - -- * Default 'TChan' implementation + , newTSemDefault + , waitTSemDefault + , signalTSemDefault + , signalTSemNDefault + , labelTSemDefault + -- ** Default 'TChan' implementation , TChanDefault (..) - -- * MonadThrow aliases - , throwSTM - , catchSTM + , newTChanDefault + , newBroadcastTChanDefault + , writeTChanDefault + , readTChanDefault + , tryReadTChanDefault + , peekTChanDefault + , tryPeekTChanDefault + , dupTChanDefault + , unGetTChanDefault + , isEmptyTChanDefault + , cloneTChanDefault + , labelTChanDefault ) where +-- $default-implementations +-- +-- The default implementations are based on a `TVar` defined in the class. They +-- are tailored towards `IOSim` rather than instances which would like to derive +-- from `IO` or monad transformers. + import Prelude hiding (read) import qualified Control.Concurrent.STM.TArray as STM @@ -192,14 +252,6 @@ class (Monad m, Monad (STM m)) => MonadSTM m where -- default implementations -- - default newTMVar :: TMVar m ~ TMVarDefault m - => a -> STM m (TMVar m a) - newTMVar = newTMVarDefault - - default newEmptyTMVar :: TMVar m ~ TMVarDefault m - => STM m (TMVar m a) - newEmptyTMVar = newEmptyTMVarDefault - newTVarIO = atomically . newTVar readTVarIO = atomically . readTVar newTMVarIO = atomically . newTMVar @@ -209,175 +261,6 @@ class (Monad m, Monad (STM m)) => MonadSTM m where newTChanIO = atomically newTChan newBroadcastTChanIO = atomically newBroadcastTChan - default takeTMVar :: TMVar m ~ TMVarDefault m - => TMVar m a -> STM m a - takeTMVar = takeTMVarDefault - - default tryTakeTMVar :: TMVar m ~ TMVarDefault m - => TMVar m a -> STM m (Maybe a) - tryTakeTMVar = tryTakeTMVarDefault - - default putTMVar :: TMVar m ~ TMVarDefault m => TMVar m a -> a -> STM m () - putTMVar = putTMVarDefault - - default tryPutTMVar :: TMVar m ~ TMVarDefault m => TMVar m a -> a -> STM m Bool - tryPutTMVar = tryPutTMVarDefault - - default readTMVar :: TMVar m ~ TMVarDefault m - => TMVar m a -> STM m a - readTMVar = readTMVarDefault - - default tryReadTMVar :: TMVar m ~ TMVarDefault m - => TMVar m a -> STM m (Maybe a) - tryReadTMVar = tryReadTMVarDefault - - default swapTMVar :: TMVar m ~ TMVarDefault m - => TMVar m a -> a -> STM m a - swapTMVar = swapTMVarDefault - - default isEmptyTMVar :: TMVar m ~ TMVarDefault m - => TMVar m a -> STM m Bool - isEmptyTMVar = isEmptyTMVarDefault - - default newTQueue :: TQueue m ~ TQueueDefault m - => STM m (TQueue m a) - newTQueue = newTQueueDefault - - default writeTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> a -> STM m () - writeTQueue = writeTQueueDefault - - default readTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> STM m a - readTQueue = readTQueueDefault - - default tryReadTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> STM m (Maybe a) - tryReadTQueue = tryReadTQueueDefault - - default isEmptyTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> STM m Bool - isEmptyTQueue = isEmptyTQueueDefault - - default unGetTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> a -> STM m () - unGetTQueue = unGetTQueueDefault - - default peekTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> STM m a - peekTQueue = peekTQueueDefault - - default tryPeekTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> STM m (Maybe a) - tryPeekTQueue = tryPeekTQueueDefault - - default flushTQueue :: TQueue m ~ TQueueDefault m - => TQueue m a -> STM m [a] - flushTQueue = flushTQueueDefault - - default newTBQueue :: TBQueue m ~ TBQueueDefault m - => Natural -> STM m (TBQueue m a) - newTBQueue = newTBQueueDefault - - default writeTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> a -> STM m () - writeTBQueue = writeTBQueueDefault - - default readTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m a - readTBQueue = readTBQueueDefault - - default tryReadTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m (Maybe a) - tryReadTBQueue = tryReadTBQueueDefault - - default isEmptyTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m Bool - isEmptyTBQueue = isEmptyTBQueueDefault - - default peekTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m a - peekTBQueue = peekTBQueueDefault - - default tryPeekTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m (Maybe a) - tryPeekTBQueue = tryPeekTBQueueDefault - - default isFullTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m Bool - isFullTBQueue = isFullTBQueueDefault - - default lengthTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m Natural - lengthTBQueue = lengthTBQueueDefault - - default flushTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> STM m [a] - flushTBQueue = flushTBQueueDefault - - default unGetTBQueue :: TBQueue m ~ TBQueueDefault m - => TBQueue m a -> a -> STM m () - unGetTBQueue = unGetTBQueueDefault - - default newTSem :: TSem m ~ TSemDefault m - => Integer -> STM m (TSem m) - newTSem = newTSemDefault - - default waitTSem :: TSem m ~ TSemDefault m - => TSem m -> STM m () - waitTSem = waitTSemDefault - - default signalTSem :: TSem m ~ TSemDefault m - => TSem m -> STM m () - signalTSem = signalTSemDefault - - default signalTSemN :: TSem m ~ TSemDefault m - => Natural -> TSem m -> STM m () - signalTSemN = signalTSemNDefault - - default newTChan :: TChan m ~ TChanDefault m - => STM m (TChan m a) - newTChan = newTChanDefault - - default newBroadcastTChan :: TChan m ~ TChanDefault m - => STM m (TChan m a) - newBroadcastTChan = newBroadcastTChanDefault - - default writeTChan :: TChan m ~ TChanDefault m - => TChan m a -> a -> STM m () - writeTChan = writeTChanDefault - - default readTChan :: TChan m ~ TChanDefault m - => TChan m a -> STM m a - readTChan = readTChanDefault - - default tryReadTChan :: TChan m ~ TChanDefault m - => TChan m a -> STM m (Maybe a) - tryReadTChan = tryReadTChanDefault - - default peekTChan :: TChan m ~ TChanDefault m - => TChan m a -> STM m a - peekTChan = peekTChanDefault - - default tryPeekTChan :: TChan m ~ TChanDefault m - => TChan m a -> STM m (Maybe a) - tryPeekTChan = tryPeekTChanDefault - - default dupTChan :: TChan m ~ TChanDefault m - => TChan m a -> STM m (TChan m a) - dupTChan = dupTChanDefault - - default unGetTChan :: TChan m ~ TChanDefault m - => TChan m a -> a -> STM m () - unGetTChan = unGetTChanDefault - - default isEmptyTChan :: TChan m ~ TChanDefault m - => TChan m a -> STM m Bool - isEmptyTChan = isEmptyTChanDefault - - default cloneTChan :: TChan m ~ TChanDefault m - => TChan m a -> STM m (TChan m a) - cloneTChan = cloneTChanDefault stateTVarDefault :: MonadSTM m => TVar m s -> (s -> (a, s)) -> STM m a diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index e8e95b90..9f3b6244 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -488,6 +488,17 @@ instance MonadSTM (IOSim s) where retry = STM $ oneShot $ \_ -> Retry orElse a b = STM $ oneShot $ \k -> OrElse (runSTM a) (runSTM b) k + newTMVar = MonadSTM.newTMVarDefault + newEmptyTMVar = MonadSTM.newEmptyTMVarDefault + takeTMVar = MonadSTM.takeTMVarDefault + tryTakeTMVar = MonadSTM.tryTakeTMVarDefault + putTMVar = MonadSTM.putTMVarDefault + tryPutTMVar = MonadSTM.tryPutTMVarDefault + readTMVar = MonadSTM.readTMVarDefault + tryReadTMVar = MonadSTM.tryReadTMVarDefault + swapTMVar = MonadSTM.swapTMVarDefault + isEmptyTMVar = MonadSTM.isEmptyTMVarDefault + newTQueue = newTQueueDefault readTQueue = readTQueueDefault tryReadTQueue = tryReadTQueueDefault @@ -510,6 +521,23 @@ instance MonadSTM (IOSim s) where isFullTBQueue = isFullTBQueueDefault unGetTBQueue = unGetTBQueueDefault + newTSem = MonadSTM.newTSemDefault + waitTSem = MonadSTM.waitTSemDefault + signalTSem = MonadSTM.signalTSemDefault + signalTSemN = MonadSTM.signalTSemNDefault + + newTChan = MonadSTM.newTChanDefault + newBroadcastTChan = MonadSTM.newBroadcastTChanDefault + writeTChan = MonadSTM.writeTChanDefault + readTChan = MonadSTM.readTChanDefault + tryReadTChan = MonadSTM.tryReadTChanDefault + peekTChan = MonadSTM.peekTChanDefault + tryPeekTChan = MonadSTM.tryPeekTChanDefault + dupTChan = MonadSTM.dupTChanDefault + unGetTChan = MonadSTM.unGetTChanDefault + isEmptyTChan = MonadSTM.isEmptyTChanDefault + cloneTChan = MonadSTM.cloneTChanDefault + instance MonadInspectSTM (IOSim s) where type InspectMonad (IOSim s) = ST s inspectTVar _ TVar { tvarCurrent } = readSTRef tvarCurrent From c46155f93e322677d34ce8171b5b49724055f355 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Fri, 14 Apr 2023 16:31:45 +0200 Subject: [PATCH 23/27] Bump versions to 1.0.0.0 Except of `io-classes-mtl` which is still an experimental. Also update `CHANGELOG` files. --- io-classes-mtl/io-classes-mtl.cabal | 2 +- io-classes/CHANGELOG.md | 2 ++ io-classes/io-classes.cabal | 2 +- io-sim/CHANGELOG.md | 2 ++ io-sim/io-sim.cabal | 8 ++++---- si-timers/CHANGELOG.md | 2 +- si-timers/si-timers.cabal | 4 ++-- strict-mvar/CHANGELOG.md | 2 +- strict-mvar/strict-mvar.cabal | 4 ++-- strict-stm/CHANGELOG.md | 2 ++ strict-stm/strict-stm.cabal | 4 ++-- 11 files changed, 20 insertions(+), 14 deletions(-) diff --git a/io-classes-mtl/io-classes-mtl.cabal b/io-classes-mtl/io-classes-mtl.cabal index f999eb44..7fd49aad 100644 --- a/io-classes-mtl/io-classes-mtl.cabal +++ b/io-classes-mtl/io-classes-mtl.cabal @@ -41,7 +41,7 @@ library array, mtl, - io-classes ^>= 0.6.0.0, + io-classes ^>= 1.0.0.0, si-timers, diff --git a/io-classes/CHANGELOG.md b/io-classes/CHANGELOG.md index 9ca76861..5064b990 100644 --- a/io-classes/CHANGELOG.md +++ b/io-classes/CHANGELOG.md @@ -2,6 +2,8 @@ ## next version +## 1.0.0.0 + ### Breaking changes * `MonadMonotonicTime` morphed into `MonadMonotonicTimeNSec` which supports diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index ffac10f1..5ca69409 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: io-classes -version: 0.6.0.0 +version: 1.0.0.0 synopsis: Type classes for concurrency with STM, ST and timing license: Apache-2.0 license-files: diff --git a/io-sim/CHANGELOG.md b/io-sim/CHANGELOG.md index 06aa4477..35814338 100644 --- a/io-sim/CHANGELOG.md +++ b/io-sim/CHANGELOG.md @@ -2,6 +2,8 @@ ## next version +## 1.0.0.0 + ### Breaking changes * Support refactored `MonadTimer`, and new `MonadTimerFancy`, `MonadTimeNSec` diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 16cd789c..c159c5cd 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: io-sim -version: 0.6.0.0 +version: 1.0.0.0 synopsis: A pure simulator for monadic concurrency with STM license: Apache-2.0 license-files: @@ -72,15 +72,15 @@ library ScopedTypeVariables, TypeFamilies build-depends: base >=4.9 && <4.18, - io-classes ^>=0.6, + io-classes ^>=1.0, exceptions >=0.10, containers, deque, nothunks, parallel, psqueues >=0.2 && <0.3, - strict-stm ^>=0.6, - si-timers ^>=0.6, + strict-stm ^>=1.0, + si-timers ^>=1.0, time >=1.9.1 && <1.13, quiet, QuickCheck, diff --git a/si-timers/CHANGELOG.md b/si-timers/CHANGELOG.md index cefddb91..ade6a936 100644 --- a/si-timers/CHANGELOG.md +++ b/si-timers/CHANGELOG.md @@ -1,6 +1,6 @@ # Changelog -## 0.6.0.0 +## 1.0.0.0 * initial version diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index 459ae788..20950259 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: si-timers -version: 0.6.0.0 +version: 1.0.0.0 synopsis: Timers using SI units (seconds) which are safe on 32-bit platforms. license: Apache-2.0 @@ -57,7 +57,7 @@ library stm, time >=1.9.1 && <1.13, - io-classes ^>=0.6 + io-classes ^>=1.0 if flag(asserts) ghc-options: -fno-ignore-asserts diff --git a/strict-mvar/CHANGELOG.md b/strict-mvar/CHANGELOG.md index fe89d200..d4f2c83a 100644 --- a/strict-mvar/CHANGELOG.md +++ b/strict-mvar/CHANGELOG.md @@ -1,6 +1,6 @@ # Revsion history of strict-mvar -## 0.6.0.0 +## 1.0.0.0 ## 0.1.0.0 diff --git a/strict-mvar/strict-mvar.cabal b/strict-mvar/strict-mvar.cabal index 465a87fa..043552df 100644 --- a/strict-mvar/strict-mvar.cabal +++ b/strict-mvar/strict-mvar.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: strict-mvar -version: 0.1.0.0 +version: 1.0.0.0 synopsis: Strict MVars for implementations of the `io-classes` MVar interface description: Strict MVars for implementations of the `io-classes` MVar interface. license: Apache-2.0 @@ -30,7 +30,7 @@ library exposed-modules: Control.Concurrent.Class.MonadMVar.Strict default-language: Haskell2010 build-depends: base >= 4.9 && <4.18, - io-classes ^>= 0.6 + io-classes ^>= 1.0 ghc-options: -Wall -Wno-unticked-promoted-constructors -Wcompat diff --git a/strict-stm/CHANGELOG.md b/strict-stm/CHANGELOG.md index ab979708..20fb7308 100644 --- a/strict-stm/CHANGELOG.md +++ b/strict-stm/CHANGELOG.md @@ -1,5 +1,7 @@ # Changelog +## 1.0.0.0 + ## 0.6.0.0 ## 0.5.0.0 diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index ad515930..93aea803 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: strict-stm -version: 0.6.0.0 +version: 1.0.0.0 synopsis: Strict STM interface polymorphic over stm implementation. license: Apache-2.0 license-files: @@ -54,7 +54,7 @@ library array, stm >= 2.5 && <2.6, - io-classes ^>= 0.6 + io-classes ^>= 1.0 ghc-options: -Wall -Wno-unticked-promoted-constructors -Wcompat From 9b8b4b391edd0a049e02bc4d451af0bf5aba308e Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 18 Apr 2023 17:19:03 +0200 Subject: [PATCH 24/27] Downgrade to cabal-version: 3.0 That's the latest version supported by hackage. --- io-classes/io-classes.cabal | 2 +- io-sim/io-sim.cabal | 2 +- si-timers/si-timers.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index 5ca69409..37e0b29c 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.4 +cabal-version: 3.0 name: io-classes version: 1.0.0.0 synopsis: Type classes for concurrency with STM, ST and timing diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index c159c5cd..5044b7bb 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.4 +cabal-version: 3.0 name: io-sim version: 1.0.0.0 synopsis: A pure simulator for monadic concurrency with STM diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index 20950259..9397a37b 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.4 +cabal-version: 3.0 name: si-timers version: 1.0.0.0 synopsis: Timers using SI units (seconds) which are safe on 32-bit From dbdb17fe492321f4be7527b75692d69afea9705d Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 18 Apr 2023 17:48:02 +0200 Subject: [PATCH 25/27] Updated meta data & documentation --- io-classes-mtl/io-classes-mtl.cabal | 4 ++++ io-classes/io-classes.cabal | 4 ++++ io-sim/io-sim.cabal | 6 +++++- si-timers/README.md | 3 +++ si-timers/si-timers.cabal | 6 ++++-- strict-mvar/strict-mvar.cabal | 9 +++++++-- strict-stm/strict-stm.cabal | 7 ++++++- 7 files changed, 33 insertions(+), 6 deletions(-) diff --git a/io-classes-mtl/io-classes-mtl.cabal b/io-classes-mtl/io-classes-mtl.cabal index 7fd49aad..320c61a2 100644 --- a/io-classes-mtl/io-classes-mtl.cabal +++ b/io-classes-mtl/io-classes-mtl.cabal @@ -2,6 +2,10 @@ cabal-version: 3.0 name: io-classes-mtl version: 0.1.0.0 synopsis: Experimental MTL instances for io-classes +description: + MTL instances for + [io-classes](https://hackage.hasekll.org/package/io-classes) package. + Some of the instances are novel and some are still experimental. license: Apache-2.0 license-files: LICENSE diff --git a/io-classes/io-classes.cabal b/io-classes/io-classes.cabal index 37e0b29c..443bd33e 100644 --- a/io-classes/io-classes.cabal +++ b/io-classes/io-classes.cabal @@ -2,6 +2,10 @@ cabal-version: 3.0 name: io-classes version: 1.0.0.0 synopsis: Type classes for concurrency with STM, ST and timing +description: + IO Monad class hierarchy compatible with + [io-sim](https://hackage.haskell.org/package/io-sim), 'base', 'async', + 'stm', 'exceptions' & 'time' packages. license: Apache-2.0 license-files: LICENSE diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal index 5044b7bb..92cbbaa5 100644 --- a/io-sim/io-sim.cabal +++ b/io-sim/io-sim.cabal @@ -1,7 +1,11 @@ cabal-version: 3.0 name: io-sim version: 1.0.0.0 -synopsis: A pure simulator for monadic concurrency with STM +synopsis: A pure simulator for monadic concurrency with STM. +description: + A pure simulator monad with support of concurency (base, async), stm, + synchronous and asynchronous exceptions, timeouts & delays, dynamic traces, + and more. license: Apache-2.0 license-files: LICENSE diff --git a/si-timers/README.md b/si-timers/README.md index a00fe0b2..97c7b639 100644 --- a/si-timers/README.md +++ b/si-timers/README.md @@ -13,6 +13,9 @@ very efficient but for other platforms (e.g. `Windows`), it might not be the right API for low latency timeouts needed for example for low level networking code, because it relies on `GHC`'s `RTS` thread scheduling. +`si-timers` are compatible with `io-sim`. + The `SI` comes from the [International System of Units][SI]. [SI]: https://www.wikiwand.com/en/International_System_of_Units +[`io-sim`]: https://hackage.haskell.org/package/io-sim diff --git a/si-timers/si-timers.cabal b/si-timers/si-timers.cabal index 9397a37b..0257f0f2 100644 --- a/si-timers/si-timers.cabal +++ b/si-timers/si-timers.cabal @@ -1,8 +1,10 @@ cabal-version: 3.0 name: si-timers version: 1.0.0.0 -synopsis: Timers using SI units (seconds) which are safe on 32-bit - platforms. +synopsis: timers using SI units (seconds) +description: + Timers using SI units (seconds) which are safe on 32-bit platforms and + compatible with [io-sim](https://hackage.haskell.org/package/io-sim). license: Apache-2.0 license-files: LICENSE diff --git a/strict-mvar/strict-mvar.cabal b/strict-mvar/strict-mvar.cabal index 043552df..500cc4c8 100644 --- a/strict-mvar/strict-mvar.cabal +++ b/strict-mvar/strict-mvar.cabal @@ -1,8 +1,11 @@ cabal-version: 3.0 name: strict-mvar version: 1.0.0.0 -synopsis: Strict MVars for implementations of the `io-classes` MVar interface -description: Strict MVars for implementations of the `io-classes` MVar interface. +synopsis: Strict MVars for IO and IOSim +description: + Strict @MVar@ interface compatible with + [IO](https://hackage.haskell.org/package/base-4.18.0.0/docs/Prelude.html#t:IO) + & [io-sim](https://hackage.haskell.org/package/io-sim). license: Apache-2.0 license-files: LICENSE @@ -12,6 +15,8 @@ author: IOHK Engineering Team maintainer: operations@iohk.io category: Control build-type: Simple +extra-source-files: CHANGELOG.md + README.md tested-with: GHC == { 8.10.7, 9.2.5, 9.4.4 } source-repository head diff --git a/strict-stm/strict-stm.cabal b/strict-stm/strict-stm.cabal index 93aea803..c1e5b442 100644 --- a/strict-stm/strict-stm.cabal +++ b/strict-stm/strict-stm.cabal @@ -2,6 +2,11 @@ cabal-version: 3.0 name: strict-stm version: 1.0.0.0 synopsis: Strict STM interface polymorphic over stm implementation. +description: + Strict STM interface provided on top of + [io-classes](https://hackage.haskell.org/package/io-classes) and thus + compatible with [stm](https://hackage.haskell.org/package/stm) + & [io-sim](https://hackage.haskell.org/package/io-sim). license: Apache-2.0 license-files: LICENSE @@ -67,4 +72,4 @@ library ghc-options: -fno-ignore-asserts if flag(checktvarinvariant) - cpp-options: -DCHECK_TVAR_INVARIANT + cpp-options: -DCHECK_TVAR_INVARIAN From f65c910b42855b5316a8f687787760e79d01091e Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 18 Apr 2023 20:28:54 +0200 Subject: [PATCH 26/27] Check grammar of READMES & the CONTRIBUTING.md guide. --- CONTRIBUTING.md | 33 ++++++++------- README.md | 41 +++++++++--------- io-classes-mtl/README.md | 8 ++-- io-classes/README.md | 90 ++++++++++++++++++++-------------------- io-sim/README.md | 19 +++++---- strict-mvar/README.md | 2 +- strict-stm/README.md | 2 +- 7 files changed, 98 insertions(+), 97 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index bbf4637b..fe777c6d 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,12 +1,12 @@ # Building -The project is build with `cabal-install`. You might need to run `cabal +The project is built with `cabal-install`. You might need to run `cabal update` after cloning the repository. # Design Principles We designed `io-classes` to be as close as possible to what `base` package -provides. Almost all `IO` instances instantiate with api provided by one of +provides. Almost all `IO` instances instantiate with API provided by one of the core packages, see [example](https://github.com/input-output-hk/io-sim/blob/main/io-classes/src/Control/Monad/Class/MonadSTM.hs?plain=1#L410-L446). Please keep this in mind when adding new functionality. @@ -54,13 +54,13 @@ package ouroboros-network-testing # Code Style -Please follow local style. For a more detailed style guide see +Please follow the local style. For a more detailed style guide see [link](https://github.com/input-output-hk/ouroboros-network/blob/master/docs/StyleGuide.md). # Pull Requests -Each commit shall be small and preferably address one thing at a time. Well -organised & documented commits make it much easier for the maintainers to +Each commit shall be small and preferably address one thing at a time. +Well-organised & documented commits make it much easier for the maintainers to review them. Hacking sessions are great, but please take your time to organise your work, this usually improves the quality too! @@ -75,22 +75,22 @@ Please use a draft PR if the work is still in progress. We require all commits to be signed, see [this guide][gh-signing-commits]. -If your pull requests resolves an existing issue, please link your PR to that +If your pull requests resolve an existing issue, please link your PR to the issue, see [GitHub documentation][gh-link-issue]. -Please include your changes in `CHANGELOG.md` files (per package). +Please include your changes in the `CHANGELOG.md` files (per package). -We prefer to avoid merging commits, rebasing a well organised PR is usually +We prefer to avoid merging commits, rebasing a well-organised PR is usually quite simple. ## Code Style -Please follow local style. For a more detailed style guide see +Please follow the local style. For a more detailed style guide see [link](https://github.com/input-output-hk/ouroboros-network/blob/master/docs/StyleGuide.md). ## MonadSTM features -If you are adding a new functionality to `MonadSTM`, don't forget to support it +If you are adding new functionality to `MonadSTM`, don't forget to support it in `strict-stm` package. ## CI @@ -100,14 +100,14 @@ We run CI using [GitHub actions][ci]. # Releases The major version of `io-sim`, `io-classes`, `strict-stm` and `si-timers` -packages are kept in sync. This means that if any of the packages introduces -a breaking change all major version SHOULD be bumped. The minor versions are +packages are kept in sync. This means that if any of the packages introduce +a breaking change all major versions SHOULD be bumped. The minor versions are kept independent. The `io-classes-mtl` is still experimental and thus it's not following that principle. The drawback is that if you declare `io-classes ^>= 0.x` then you will need to -bump it when new version of `io-sim` is published (even if there are no changes -in `io-classes`). The con is that you just need to declare version of +bump it when a new version of `io-sim` is published (even if there are no changes +in `io-classes`). The con is that you just need to declare the version of `io-classes` to have a consistent ecosystem of the four packages. # Tips @@ -116,7 +116,7 @@ in `io-classes`). The con is that you just need to declare version of Both `ppTrace` and `ppTrace_` are strict. They evaluate the trace before they produce any result, thus they are not useful when your trace diverges. This -can happen if evaluation encounters unhandled exception e.g. one of assertion +can happen if the evaluation encounters an unhandled exception e.g. an assertion fires (either internal or otherwise). In that case, instead of `ppTrace` you can use `Data.Trace.toList` and simply `traverse print` the list. This will give you the trace up to the point of failure. @@ -124,7 +124,7 @@ give you the trace up to the point of failure. ## `IOSim` and `STMSim` monads are based on lazy `ST` monad This means that any action is forced only when the result is needed. This is -more lazy than `IO` monad. Thus if you want to use `Debug.Trace.traceM` inside +lazier than `IO` monad. Thus if you want to use `Debug.Trace.traceM` inside `schedule` function you need to: ```hs ... @@ -138,3 +138,4 @@ more lazy than `IO` monad. Thus if you want to use `Debug.Trace.traceM` inside [gh-link-issue]: https://docs.github.com/en/github/managing-your-work-on-github/linking-a-pull-request-to-an-issue [gh-signing-commits]: https://docs.github.com/en/authentication/managing-commit-signature-verification/signing-commits [ci]: https://github.com/input-output-hk/io-sim/actions + diff --git a/README.md b/README.md index aa792c42..c7774fd3 100644 --- a/README.md +++ b/README.md @@ -3,33 +3,32 @@ # io-sim - -`IOSim` is an simulator monad which supports: +`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 +* concurrency: both low-level `forkIO` as well as `async` style * strict STM * access to lazy ST * schedule discovery (see [IOSimPOR][io-sim-por-how-to]) -* eventlog +* event log * dynamic tracing * tracing committed changes to `TVar`, `TMVar`s, etc. -* labelling of threads, `TVar`'s, etc. +* labeling of threads, `TVar`'s, etc. -`io-classes` provides an interface, which allows to write code which can be run +`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. +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. +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 more -familiar `exception` style. The new hierarchy provides `bracket` and +`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, @@ -37,12 +36,12 @@ 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 labelling threads, -or mutable variables, tracing `Dynamic` values (which can be recovered from the -trace) or simple `String` based tracing. Although its agnostic with respect to +`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][contra-tracer]. It has been used to develop, test and debug -a complex, highly-concurrent, distributed system +[contra-tracer][contra-tracer]. It has been used to develop, test, and debug +a complex, highly concurrent, distributed system ([ouroboros-network][ouroboros-network]), in particular * write network simulations, to verify a complex networking stack; @@ -61,10 +60,10 @@ a complex, highly-concurrent, distributed system * `io-classes`: class bases interface, which allows to to abstract over the monad * `strict-stm`: strict STM operations -* `si-timers`: non standard timers API +* `si-timers`: non-standard timers API -## Differences from `base`, `async` or `exceptions` packages +## Differences from `base`, `async`, or `exceptions` packages ### Major differences @@ -83,11 +82,11 @@ type Async :: (Type -> Type) -> Type -> Type ``` The first type of kind `Type -> Type` describes the monad which could be -instantiated to `IO`, `IOSim` or some other monad stack build with monad +instantiated to `IO`, `IOSim` or some other monad stacks built with monad transformers. The same applies to many other types, e.g. `TVar`, `TMVar`. The following types although similar to the originals are not the same as the -ones that come from `base`, `async`, or `excpetions` packages: +ones that come from `base`, `async`, or `exceptions` packages: * `Handler` (origin: `base`) * `MaskingState` (origin: `base`) diff --git a/io-classes-mtl/README.md b/io-classes-mtl/README.md index 60b90e89..0910c69b 100644 --- a/io-classes-mtl/README.md +++ b/io-classes-mtl/README.md @@ -2,16 +2,16 @@ `ReaderT` instances are included in `io-classes`, but all other instances are included in this package. Some of them are rather novel and experimental -others might be less so. This code is not really tested, neither it has run -in production environment as we know (let us know if you do!). +others might be less so. This code is not well tested, and some of it hasn't run +in a production environment as we know (let us know if you do!). The `MonadSTM` instances for monad transformers are somewhat novel. The `STM` monad is transformed together with the base monad. This means that the -transfomer primitive operations are available in `STM`. For example you an +transformer primitive operations are available in `STM`. For example you an `STM` transaction can lock updating the state of the current thread. We haven't included `MonadAsync` instances (although we have an experimental -branch how this could be done). It could work like the `lifted-async` +branch how this could be done). It could work like the `lifted-async` package. But we feel this can be controversial, so it's not included. The design goal is to follow `exception` package instances, but since we don't diff --git a/io-classes/README.md b/io-classes/README.md index 6bc3cbb0..a6377274 100644 --- a/io-classes/README.md +++ b/io-classes/README.md @@ -1,74 +1,72 @@ # IO Monad Class Hierarchy -This package provides a monad class hierarchy which is an interface for both the -[`io-sim`] and [`IO`] monads. It was developed with the following constraints -in mind: +This package provides a monad class hierarchy which is an interface for both +the [`io-sim`] and [`IO`] monads. It was developed with the following +constraints in mind: -* be a drop in replacement for `IO` monad; +* be a drop-in replacement for `IO` monad; * `IO` instances do not alter its original semantics, providing a shallow - bindings to [`async`], [`base`], [`stm`] and [`exceptions`] packages as well - as timer api; -* provide zero cost abstractions. + bindings to [`async`], [`base`], [`stm`], and [`exceptions`] packages as well + as timer API; +* provide zero-cost abstractions. -We provde also non standard extensions of this api: +We provide also non-standard extensions of this API: * [`strict-stm`]: strict `TVar`'s, and other mutable `STM` variables, with - suport of the [`nothunks`] library; + support of the [`nothunks`] library; * [`si-timers`]: timers api: - 32-bit safe API using `DiffTime` measured in seconds (rather than time in microseconds represented as `Int` as in `base`) - - cancellble timeouts. + - cancellable timeouts. -[`strict-stm`] and [`nothunks`] were successfuly used in large code base to +[`strict-stm`] and [`nothunks`] were successfully used in a large code base to eliminate space leaks and keep that property over long development cycles. ## Exception Class Hierarchy This package provides an alternative class hierarchy giving access to -exceptions api. The [`exception`] package class hierarchy is also supported by +exceptions API. The [`exception`] package class hierarchy is also supported by [`io-sim`], so you can also use either one. -The `MonadThrow` defined in this package allows to work with exceptions without +The `MonadThrow` defined in this package allows working with exceptions without having explicit access to `catch` or `mask`. It only provides access to -`throwIO`, `bracket`, `bracket_` and `finally`. `MonadCatch` class provides -api which allows to work with exceptions, e.g. `catch` or `bracketOnError`, and -`MonadMask` gives access to low level `mask` and friends. This division makes +`throwIO`, `bracket`, `bracket_`, and `finally`. `MonadCatch` class provides +API which allows working with exceptions, e.g. `catch` or `bracketOnError`, and +`MonadMask` gives access to low-level `mask` and friends. This division makes code review process somewhat easier. Using only `MonadThrow` constraint, the -reviewer can be sure that no low level exception api is used, which usually -requires more care. Still `MonadThrow` is general enough to to do resource +reviewer can be sure that no low-level exception API is used, which usually +requires more care. Still `MonadThrow` is general enough to do resource handling right. ## Time and Timer APIs The time and timer APIs of this package follows closely the API exposed by -[`base`] and [`time`] packages. We separately packaged a more conveneint API -in [`si-timers`] (ref [SI]), which provides monoidal action of `DiffTime` on +[`base`] and [`time`] packages. We separately packaged a more convenient API +in [`si-timers`] (ref [SI]), which provides a monoidal action of `DiffTime` on monotonic time as well as exposes 32-bit safe timer API (on 32-bit systems time -in microseconds represented as an `Int` can only holds timeouts of ~35 -minutes). +in microseconds represented as an `Int` can only hold timeouts of ~35 minutes). -`Control.Monad.Class.MonadTimer.NonStandard.MonadTimeout` provides a low level -timeout abstraction. On systems which support native timer manager it's used -to implement its API, which is very efficient even for low latency timeouts. +`Control.Monad.Class.MonadTimer.NonStandard.MonadTimeout` provides a low-level +timeout abstraction. On systems that support a native timer manager, it's used +to implement its API, which is very efficient even for low-latency timeouts. On other platforms (e.g. `Windows`), it's good enough for subsecond timeouts -but it's not good enough for fine grained timeouts (e.g. sub milliseconds) as -it relays on GHC thread scheduler. We support `MonadTimeout` on `Linux`, -`MacOS`, `Windows` and `IOSim` (and unofficially on `GHCJS`). +but it's not good enough for fine-grained timeouts (e.g. sub milliseconds) as +it relays on the GHC thread scheduler. We support `MonadTimeout` on `Linux`, +`MacOS`, `Windows`, and `IOSim` (and unofficially on `GHCJS`). -`MonadDelay` and `MonadTimer` classes provide the well established interface to +`MonadDelay` and `MonadTimer` classes provide a well-established interface to delays & timers. ## Software Transactional Memory API -We provide two interfaces to `stm` api: lazy, included in `io-classes`; and +We provide two interfaces to `stm` API: lazy, included in `io-classes`; and strict one provided by [`strict-stm`]. ## Threads API -We draw a line between `base` api and `async` api. The former one is provided -by +We draw a line between `base` API and `async` API. The former is provided by [MonadFork](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadFork.html#t:MonadFork) the latter by [MonadAsync](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadFork.html#t:MonadAsync). @@ -78,33 +76,30 @@ packages. ## Some other APIs -* [MonadEventlog](https://hackage.haskell.org/package/io-sim-classes/docs/Control-Monad-Class-MonadEventlog.html#t:MonadEventlog): - provides an API to the - [Debug.Trace](https://hackage.haskell.org/package/base/docs/Debug-Trace.html) - eventlog interface. -* [MonadST](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadST.html#t:MonadST): provides a way to lift `ST`-computations. -* [MonadSay](https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadSay.html#t:MonadSay): dummy debugging interface +* [MonadEventlog]: provides an API to the [Debug.Trace] event log interface. +* [MonadST]: provides a way to lift `ST`-computations. +* [MonadSay]: dummy debugging interface ## Debuging & Insepction -We provide quite extended debuging & insepction api. This proved to be +We provide quite extended debugging & inspection API. This proved to be extremely helpful when analysing complex deadlocks or livelocks or writing complex quickcheck properties of a highly concurrent system. Some of this is -only possible because we can control execution environment of [`io-sim`]. +only possible because we can control the execution environment of [`io-sim`]. * `labelThread` as part of `MonadThread` ([`IO`], [`io-sim`], which is also part of `GHC` API, ref [`labelThread`][labelThread-base]); -* `MonadLabelledSTM` which allows to label various `STM` mutable variables, +* `MonadLabelledSTM` which allows to label of various `STM` mutable variables, e.g. `TVar`, `MVar`, etc. ([`io-sim`], not provided by `GHC`); -* `MonadInspectSTM` which allows to inspect values of `STM` mutable variables - when they are commited. ([`io-sim`], not provided by `GHC`). +* `MonadInspectSTM` which allows inspecting values of `STM` mutable variables + when they are committed. ([`io-sim`], not provided by `GHC`). -## Monad transformers +## Monad Transformers We provide support for monad transformers (although at this stage it might have -its limitations and so there might be some rought edges. PRs are welcomed, +its limitations and so there might be some rough edges. PRs are welcomed, [contributing]). [SI]: https://www.wikiwand.com/en/International_System_of_Units @@ -122,3 +117,8 @@ its limitations and so there might be some rought edges. PRs are welcomed, [contributing]: https://www.github.com/input-output-hk/io-sim/tree/master/CONTRIBUTING.md [`nothunks`]: https://hackage.haskell.org/package/nothunks [labelThread-base]: https://hackage.haskell.org/package/base-4.17.0.0/docs/GHC-Conc-Sync.html#v:labelThread + +[MonadEventlog]: https://hackage.haskell.org/package/io-sim-classes/docs/Control-Monad-Class-MonadEventlog.html#t:MonadEventlog +[Debug.Trace]: https://hackage.haskell.org/package/base/docs/Debug-Trace.html +[MonadST]: https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadST.html#t:MonadST +[MonadSay]: https://hackage.haskell.org/package/io-classes/docs/Control-Monad-Class-MonadSay.html#t:MonadSay diff --git a/io-sim/README.md b/io-sim/README.md index 6247756d..d2bb3b4d 100644 --- a/io-sim/README.md +++ b/io-sim/README.md @@ -20,24 +20,25 @@ A pure simulator monad built on top of the lazy `ST` monad which supports: monad (with some ramifications). It was designed to write easily testable Haskell code (including simulating socket programming or disk IO). Using [`io-classes`] and [`si-timers`] libraries one can write code that can run in -both: real `IO` and the `IOSim` monad provided by this package. One of the -design goals was to keep the api as close as possible to `base`, `exceptions`, -`async` and `stm` packages. +both: the real `IO` and the `IOSim` monad provided by this package. One of the +design goals was to keep the API as close as possible to `base`, `exceptions`, +`async`, and `stm` packages. `io-sim` package also provides two interpreters, a standard one and `IOSimPOR` which supports dynamic discovery or race conditions and schedule exploration with partial order reduction. -`io-sim` provides api to explore trace produced by a simulation. It can +`io-sim` provides API to explore traces produced by a simulation. It can contain arbitrary Haskell terms, a feature that is very useful to build -property based tests using `QuickCheck`. +property-based tests using `QuickCheck`. -The package contains thorough tests, including tests of `STM` against the original -specification (as described in [Composable Memory +The package contains thorough tests, including tests of `STM` against the +original specification (as described in [Composable Memory Transactions](https://research.microsoft.com/en-us/um/people/simonpj/papers/stm/stm.pdf) and its `GHC` implementation. This can be seen in both ways: as a check that -our implementation matches the specification and the `GHC` implementation, but also -the other way around: that `GHC`s `STM` implementation meets the specification. +our implementation matches the specification and the `GHC` implementation, but +also the other way around: that `GHC`s `STM` implementation meets the +specification. [`io-classes`]: https://hackage.haskell.org/package/io-classes [`si-timers`]: https://hackage.haskell.org/package/si-timers diff --git a/strict-mvar/README.md b/strict-mvar/README.md index ca755894..97e3687f 100644 --- a/strict-mvar/README.md +++ b/strict-mvar/README.md @@ -1,4 +1,4 @@ -# Strict mutable variables +# Strict Mutable Variables The `strict-mvar` package provides a strict interface to mutable variables (`MVar`). It builds on top of `io-classes`, and thus it provides the interface diff --git a/strict-stm/README.md b/strict-stm/README.md index 3305a722..1b396233 100644 --- a/strict-stm/README.md +++ b/strict-stm/README.md @@ -6,7 +6,7 @@ for both [`stm`] as well as [`io-sim`]. # Novel testing / space-leak elimination approach -The strict interface provides a novel way of testing / eliminating space-leaks +The strict interface provides a novel way of testing/eliminating space-leaks which might lurk in `stm` shared mutable variables. Together with the [`nothunks`] library it was successfully used to eliminate and keep a large system ([`cardano-node`]) space leak free. From fd4e0842000d4a832be83ad296fd0377161eb431 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 18 Apr 2023 20:29:41 +0200 Subject: [PATCH 27/27] CONTRIBUTING: we now longer requires signed commits --- CONTRIBUTING.md | 2 -- 1 file changed, 2 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index fe777c6d..69bc94a2 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -73,8 +73,6 @@ can update other packages from this repository in a subsequent commit. Please use a draft PR if the work is still in progress. -We require all commits to be signed, see [this guide][gh-signing-commits]. - If your pull requests resolve an existing issue, please link your PR to the issue, see [GitHub documentation][gh-link-issue].