From b379b130d9f8d1ef4c1bbbbbf43fe48586ec3a1f Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Thu, 31 Aug 2023 15:16:35 +0200 Subject: [PATCH] Propagate HasCallStack constraints in the `Switch` module for checked strict MVars. --- strict-checked-vars/CHANGELOG.md | 9 ++ .../Class/MonadMVar/Strict/Checked/Switch.hs | 86 +++++++++++++++---- strict-checked-vars/strict-checked-vars.cabal | 2 +- 3 files changed, 79 insertions(+), 18 deletions(-) diff --git a/strict-checked-vars/CHANGELOG.md b/strict-checked-vars/CHANGELOG.md index e028fe4c1..a013dd5cc 100644 --- a/strict-checked-vars/CHANGELOG.md +++ b/strict-checked-vars/CHANGELOG.md @@ -1,5 +1,14 @@ # Revision history of strict-checked-vars +## 0.1.0.4 + +* Propagate HasCallStack constraints in the `Switch` module for checked strict + MVars. + +## 0.1.0.3 + +* Make `writeTVar` more strict. + ## 0.1.0.2 * Make `newTVarWithInvariant`, `newTVarWithInvariantIO` and `newMVarWithInvariant` strict. diff --git a/strict-checked-vars/src/Control/Concurrent/Class/MonadMVar/Strict/Checked/Switch.hs b/strict-checked-vars/src/Control/Concurrent/Class/MonadMVar/Strict/Checked/Switch.hs index 867f3e02a..69a8abd90 100644 --- a/strict-checked-vars/src/Control/Concurrent/Class/MonadMVar/Strict/Checked/Switch.hs +++ b/strict-checked-vars/src/Control/Concurrent/Class/MonadMVar/Strict/Checked/Switch.hs @@ -32,36 +32,88 @@ module Control.Concurrent.Class.MonadMVar.Strict.Checked.Switch ( ) where #if CHECK_MVAR_INVARIANTS +import Control.Concurrent.Class.MonadMVar.Strict.Checked hiding + (checkInvariant, + modifyMVar, + modifyMVarMasked, + modifyMVarMasked_, + modifyMVar_, + newEmptyMVarWithInvariant, + newMVarWithInvariant, + putMVar, + swapMVar, + tryPutMVar) import qualified Control.Concurrent.Class.MonadMVar.Strict.Checked as StrictMVar.Checked -import Control.Concurrent.Class.MonadMVar.Strict.Checked hiding (checkInvariant, newMVarWithInvariant, newEmptyMVarWithInvariant) #else -import qualified Control.Concurrent.Class.MonadMVar.Strict as StrictMVar -import Control.Concurrent.Class.MonadMVar.Strict +import Control.Concurrent.Class.MonadMVar.Strict hiding + (modifyMVar, + modifyMVarMasked, + modifyMVarMasked_, + modifyMVar_, + putMVar, + swapMVar, + tryPutMVar) +import qualified Control.Concurrent.Class.MonadMVar.Strict as StrictMVar #endif -import GHC.Stack (HasCallStack) +import GHC.Stack (HasCallStack) newEmptyMVarWithInvariant :: MonadMVar m => (a -> Maybe String) -> m (StrictMVar m a) -#if CHECK_MVAR_INVARIANTS -newEmptyMVarWithInvariant = StrictMVar.Checked.newEmptyMVarWithInvariant -#else -newEmptyMVarWithInvariant _ = StrictMVar.newEmptyMVar -#endif newMVarWithInvariant :: (HasCallStack, MonadMVar m) => (a -> Maybe String) -> a -> m (StrictMVar m a) -#if CHECK_MVAR_INVARIANTS -newMVarWithInvariant = StrictMVar.Checked.newMVarWithInvariant -#else -newMVarWithInvariant _ = StrictMVar.newMVar -#endif + +putMVar :: (HasCallStack, MonadMVar m) => StrictMVar m a -> a -> m () + +swapMVar :: (HasCallStack, MonadMVar m) => StrictMVar m a -> a -> m a + +tryPutMVar :: (HasCallStack, MonadMVar m) => StrictMVar m a -> a -> m Bool + +modifyMVar_ :: (HasCallStack, MonadMVar m) + => StrictMVar m a + -> (a -> m a) + -> m () + +modifyMVar :: (HasCallStack, MonadMVar m) + => StrictMVar m a + -> (a -> m (a,b)) + -> m b + +modifyMVarMasked_ :: (HasCallStack, MonadMVar m) + => StrictMVar m a + -> (a -> m a) + -> m () + +modifyMVarMasked :: (HasCallStack, MonadMVar m) + => StrictMVar m a + -> (a -> m (a,b)) + -> m b checkInvariant :: HasCallStack => Maybe String -> a -> a + #if CHECK_MVAR_INVARIANTS -checkInvariant = StrictMVar.Checked.checkInvariant +newEmptyMVarWithInvariant = StrictMVar.Checked.newEmptyMVarWithInvariant +newMVarWithInvariant = StrictMVar.Checked.newMVarWithInvariant +putMVar = StrictMVar.Checked.putMVar +swapMVar = StrictMVar.Checked.swapMVar +tryPutMVar = StrictMVar.Checked.tryPutMVar +modifyMVar_ = StrictMVar.Checked.modifyMVar_ +modifyMVar = StrictMVar.Checked.modifyMVar +modifyMVarMasked_ = StrictMVar.Checked.modifyMVarMasked_ +modifyMVarMasked = StrictMVar.Checked.modifyMVarMasked +checkInvariant = StrictMVar.Checked.checkInvariant #else -checkInvariant = \_ a -> a -#endif \ No newline at end of file +newEmptyMVarWithInvariant _ = StrictMVar.newEmptyMVar +newMVarWithInvariant _ = StrictMVar.newMVar +putMVar = StrictMVar.putMVar +swapMVar = StrictMVar.swapMVar +tryPutMVar = StrictMVar.tryPutMVar +modifyMVar_ = StrictMVar.modifyMVar_ +modifyMVar = StrictMVar.modifyMVar +modifyMVarMasked_ = StrictMVar.modifyMVarMasked_ +modifyMVarMasked = StrictMVar.modifyMVarMasked +checkInvariant = \_ a -> a +#endif diff --git a/strict-checked-vars/strict-checked-vars.cabal b/strict-checked-vars/strict-checked-vars.cabal index c3ee536dd..c45408e4b 100644 --- a/strict-checked-vars/strict-checked-vars.cabal +++ b/strict-checked-vars/strict-checked-vars.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: strict-checked-vars -version: 0.1.0.3 +version: 0.1.0.4 synopsis: Strict MVars and TVars with invariant checking for IO and IOSim