Require strict-mutable-base >= 2.0.0.0

.github/workflows/haskell-ci.yml

@@ -233,6 +233,12 @@ jobs:
           allow-newer: fused-effects:*
           allow-newer: polysemy:*
 
+          source-repository-package
+            type:     git
+            location: https://github.com/arybczak/strict-mutable.git
+            tag:      a60db945dcc3283da2c5d45dadf423fadc2ff745
+            subdir:   strict-mutable-base
+
           package effectful-core
             ghc-options: -Werror
 

cabal.project

@@ -9,3 +9,10 @@ allow-newer: cleff:*
            , freer-simple:*
            , fused-effects:*
            , polysemy:*
+
+-- strict-mutable-base 2.0.0.0
+source-repository-package
+    type: git
+    location: https://github.com/arybczak/strict-mutable.git
+    tag: a60db945dcc3283da2c5d45dadf423fadc2ff745
+    subdir: strict-mutable-base

effectful-core/CHANGELOG.md

@@ -9,6 +9,7 @@
 * Tighten pre-requisites for `unconsEnv` and `unreplaceEnv`.
 * Add `localLendBorrow` to `Effectful.Dispatch.Dynamic`.
 * Require `primitive` >= 0.9.0.0.
+* Require `strict-mutable-base` >= 2.0.0.0.
 * **Bugfixes**:
   - `restoreStorageData` no longer shrinks the capacity of the storage, which
     could result in out of bounds reads when out of date references to the

effectful-core/effectful-core.cabal

@@ -75,7 +75,7 @@ library
                     , mtl                 >= 2.2.1
                     , monad-control       >= 1.0.3
                     , primitive           >= 0.9.0.0
-                    , strict-mutable-base >= 1.1.0.0
+                    , strict-mutable-base >= 2.0.0.0  && < 3
                     , transformers-base   >= 0.4.6
                     , unliftio-core       >= 0.2.0.1
 

effectful-core/src/Effectful/Internal/Env.hs

@@ -58,7 +58,7 @@ module Effectful.Internal.Env
 
 import Control.Monad
 import Control.Monad.Primitive
-import Data.IORef.Strict
+import Data.IORef.Strict qualified as S
 import Data.Primitive.PrimArray
 import Data.Primitive.SmallArray
 import Data.Primitive.Types
@@ -97,7 +97,7 @@ type role Env nominal
 data Env (es :: [Effect]) = Env
   { offset  :: !Int
   , refs    :: !(PrimArray Ref)
-  , storage :: !(IORef' Storage)
+  , storage :: !(S.IORef Storage)
   }
 
 -- | Reference to the effect in 'Storage'.
@@ -180,18 +180,18 @@ data StorageData = StorageData
 -- | Clone the storage to use it in a different thread.
 --
 -- @since 2.7.0.0
-cloneStorage :: HasCallStack => IORef' Storage -> IO (IORef' Storage)
+cloneStorage :: HasCallStack => S.IORef Storage -> IO (S.IORef Storage)
 cloneStorage storage0 = do
-  Storage version storageData0 <- readIORef' storage0
+  Storage version storageData0 <- S.readIORef storage0
   storageData <- copyStorageData storageData0
-  storage <- newIORef' $ Storage version storageData
+  storage <- S.newIORef $ Storage version storageData
   relinkStorageData storageData storage
   pure storage
 
 -- | Replace the storage of the environment.
 --
 -- @since 2.7.0.0
-replaceStorage :: Env es -> IORef' Storage -> IO (Env es)
+replaceStorage :: Env es -> S.IORef Storage -> IO (Env es)
 replaceStorage (Env offset refs _) storage = pure $ Env offset refs storage
 
 -- | Make a shallow copy of the 'StorageData'.
@@ -214,7 +214,7 @@ copyStorageData (StorageData storageSize vs0 es0 fs0) = do
 -- | Relink effects in the storage data to the given storage.
 --
 -- @since 2.7.0.0
-relinkStorageData :: HasCallStack => StorageData -> IORef' Storage -> IO ()
+relinkStorageData :: HasCallStack => StorageData -> S.IORef Storage -> IO ()
 relinkStorageData (StorageData storageSize _ es fs) storage = go storageSize
   where
     go = \case
@@ -234,7 +234,7 @@ relinkStorageData (StorageData storageSize _ es fs) storage = go storageSize
 -- @since 2.7.0.0
 backupStorageData :: HasCallStack => Env es -> IO StorageData
 backupStorageData env = do
-  storageData <- copyStorageData . (.data_) =<< readIORef' env.storage
+  storageData <- copyStorageData . (.data_) =<< S.readIORef env.storage
   -- Relinking to the same storage might seem weird, but relinkers need to run
   -- and make a copy of mutable data associated with statically dispatched
   -- effects if appropriate.
@@ -249,7 +249,7 @@ backupStorageData env = do
 -- @since 2.5.0.0
 restoreStorageData :: HasCallStack => StorageData -> Env es -> IO ()
 restoreStorageData (StorageData newSize vs1 es1 fs1) env = do
-  Storage version (StorageData oldSize vs0 es0 fs0) <- readIORef' env.storage
+  Storage version (StorageData oldSize vs0 es0 fs0) <- S.readIORef env.storage
   when (newSize /= oldSize) $ do
     error $ "newSize (" ++ show newSize ++ ") /= oldSize (" ++ show oldSize ++ ")"
   -- Since the time the backup was made the storage might've been grown by
@@ -285,7 +285,7 @@ restoreStorageData (StorageData newSize vs1 es1 fs1) env = do
       copySmallMutableArray fs 0 fs1 0 newSize
       pure fs
     else pure fs1
-  writeIORef' env.storage $ Storage version (StorageData newSize vs es fs)
+  S.writeIORef env.storage $ Storage version (StorageData newSize vs es fs)
 
 ----------------------------------------
 -- Relinker
@@ -328,7 +328,7 @@ type family EffectRep (d :: Dispatch) :: Effect -> Type
 emptyEnv :: HasCallStack => IO (Env '[])
 emptyEnv = Env 0
   <$> (unsafeFreezePrimArray =<< newPrimArray 0)
-  <*> (newIORef' =<< emptyStorage)
+  <*> (S.newIORef =<< emptyStorage)
 
 -- | Clone the environment to use it in a different thread.
 cloneEnv :: HasCallStack => Env es -> IO (Env es)
@@ -504,7 +504,7 @@ getLocation
   => Env es
   -> IO (Int, SmallMutableArray RealWorld AnyEffect)
 getLocation (Env offset refs storage) = do
-  Storage _ (StorageData _ vs es _) <- readIORef' storage
+  Storage _ (StorageData _ vs es _) <- S.readIORef storage
   storageVersion <- readPrimArray vs ref
   -- If version of the reference is different than version in the storage, it
   -- means that the effect in the storage is not the one that was initially
@@ -534,21 +534,21 @@ emptyStorage = Storage initialVersion <$> storageData
 -- | Insert an effect into the storage and return its reference.
 insertEffect
   :: HasCallStack
-  => IORef' Storage
+  => S.IORef Storage
   -> EffectRep (DispatchOf e) e
   -- ^ The representation of the effect.
   -> Relinker (EffectRep (DispatchOf e)) e
   -> IO Ref
 insertEffect storage e f = do
-  Storage version (StorageData size vs0 es0 fs0) <- readIORef' storage
+  Storage version (StorageData size vs0 es0 fs0) <- S.readIORef storage
   len0 <- getSizeofSmallMutableArray es0
   case size `compare` len0 of
     GT -> error $ "size (" ++ show size ++ ") > len0 (" ++ show len0 ++ ")"
     LT -> do
       writePrimArray   vs0 size version
       writeSmallArray' es0 size (toAnyEffect e)
       writeSmallArray' fs0 size (toAnyRelinker f)
-      writeIORef' storage $
+      S.writeIORef storage $
         Storage (bumpVersion version) (StorageData (size + 1) vs0 es0 fs0)
       pure $ Ref size version
     EQ -> do
@@ -566,15 +566,15 @@ insertEffect storage e f = do
       writePrimArray   vs size version
       writeSmallArray' es size (toAnyEffect e)
       writeSmallArray' fs size (toAnyRelinker f)
-      writeIORef' storage $
+      S.writeIORef storage $
         Storage (bumpVersion version) (StorageData (size + 1) vs es fs)
       pure $ Ref size version
 
 -- | Given a reference to an effect from the top of the stack, delete it from
 -- the storage.
-deleteEffect :: HasCallStack => IORef' Storage -> Ref -> IO ()
+deleteEffect :: HasCallStack => S.IORef Storage -> Ref -> IO ()
 deleteEffect storage (Ref ref version) = do
-  Storage currentVersion (StorageData size vs es fs) <- readIORef' storage
+  Storage currentVersion (StorageData size vs es fs) <- S.readIORef storage
   when (ref /= size - 1) $ do
     error $ "ref (" ++ show ref ++ ") /= size - 1 (" ++ show (size - 1) ++ ")"
   storageVersion <- readPrimArray vs ref
@@ -584,10 +584,10 @@ deleteEffect storage (Ref ref version) = do
   writePrimArray  vs ref undefinedVersion
   writeSmallArray es ref undefinedEffect
   writeSmallArray fs ref undefinedRelinker
-  writeIORef' storage $ Storage currentVersion (StorageData (size - 1) vs es fs)
+  S.writeIORef storage $ Storage currentVersion (StorageData (size - 1) vs es fs)
 
 -- | Relink the environment to use the new storage.
-relinkEnv :: IORef' Storage -> Env es -> IO (Env es)
+relinkEnv :: S.IORef Storage -> Env es -> IO (Env es)
 relinkEnv storage (Env offset refs _) = pure $ Env offset refs storage
 
 -- | Version of an unused slot.

effectful-core/src/Effectful/Internal/Unlift.hs

@@ -22,7 +22,7 @@ module Effectful.Internal.Unlift
   ) where
 
 import Control.Concurrent
-import Control.Concurrent.MVar.Strict
+import Control.Concurrent.MVar.Strict qualified as S
 import Control.Monad
 import Data.Coerce
 import Data.IntMap.Strict qualified as IM
@@ -163,10 +163,10 @@ ephemeralConcLimitedUnlift es0 uses k = do
   -- use. This can't be done from inside the callback as the environment might
   -- have already changed by then.
   esTemplate <- cloneEnv es0
-  mvUses <- newMVar' uses
+  mvUses <- S.newMVar uses
   let getEs = myThreadId >>= \case
         tid | tid0 == tid -> pure es0
-        _ -> modifyMVar' mvUses $ \case
+        _ -> S.modifyMVar mvUses $ \case
           0 -> error
              $ "Number of permitted calls (" ++ show uses ++ ") to the unlifting "
             ++ "function in other threads was exceeded. Please increase the limit "
@@ -217,18 +217,18 @@ persistentConcUnlift es0 cleanUp threads k = do
   -- use. This can't be done from inside the callback as the environment might
   -- have already changed by then.
   esTemplate <- cloneEnv es0
-  mvEntries <- newMVar' $ ThreadEntries threads IM.empty
+  mvEntries <- S.newMVar $ ThreadEntries threads IM.empty
   let getEs = myThreadId >>= \case
         tid | tid0 == tid -> pure es0
         tid -> do
-          te0 <- readMVar' mvEntries
+          te0 <- S.readMVar mvEntries
           let wkTid = weakThreadId tid
           case wkTid `IM.lookup` te0.entries of
             Just wkEs -> getWkTidEnv wkEs
             -- If the environment is not in the map, there is no point checking
-            -- again within modifyMVar' below, because this is the only thread
+            -- again within modifyMVar below, because this is the only thread
             -- that can put it there.
-            Nothing -> modifyMVar' mvEntries $ \te -> case te.capacity of
+            Nothing -> S.modifyMVar mvEntries $ \te -> case te.capacity of
               0 -> noCapacityError threads
               1 -> do
                 wkTidEs <- mkWeakThreadIdEnv tid wkTid esTemplate mvEntries cleanUp
@@ -264,13 +264,13 @@ persistentConcSingleUnlift es0 k = do
   -- by then.
   es <- cloneEnv es0
   -- GHC never labels threads as 0.
-  mvWeakTid <- newMVar' 0
+  mvWeakTid <- S.newMVar 0
   let getEs = myThreadId >>= \case
         tid | tid0 == tid -> pure es0
         tid -> do
           let wkTid = weakThreadId tid
-          readMVar' mvWeakTid >>= \case
-            0 -> modifyMVar' mvWeakTid $ \case
+          S.readMVar mvWeakTid >>= \case
+            0 -> S.modifyMVar mvWeakTid $ \case
               0 -> pure (wkTid, es)
               _ -> noCapacityError 1
             v | v == wkTid -> pure es
@@ -304,18 +304,18 @@ persistentConcUnlifts es0 les0 cleanUp threads k = do
   storageTemplate <- cloneStorage es0.storage
   esTemplate <- replaceStorage es0 storageTemplate
   lesTemplate <- replaceStorage les0 storageTemplate
-  mvEntries <- newMVar' $ ThreadEntries threads IM.empty
+  mvEntries <- S.newMVar $ ThreadEntries threads IM.empty
   let getEsLes = myThreadId >>= \case
         tid | tid0 == tid -> pure (es0, les0)
         tid -> do
-          te0 <- readMVar' mvEntries
+          te0 <- S.readMVar mvEntries
           let wkTid = weakThreadId tid
           case wkTid `IM.lookup` te0.entries of
             Just wkEsLes -> getWkTidEnv wkEsLes
             -- If the environments are not in the map, there is no point
-            -- checking again within modifyMVar' below, because this is the only
+            -- checking again within modifyMVar below, because this is the only
             -- thread that can put them there.
-            Nothing -> modifyMVar' mvEntries $ \te -> case te.capacity of
+            Nothing -> S.modifyMVar mvEntries $ \te -> case te.capacity of
               0 -> noCapacityError threads
               1 -> do
                 wkTidEsLes <- mkWeakThreadIdEnv tid wkTid (esTemplate, lesTemplate) mvEntries cleanUp
@@ -360,13 +360,13 @@ persistentConcSingleUnlifts es0 les0 k = do
   es <- replaceStorage es0 storage
   les <- replaceStorage les0 storage
   -- GHC never labels threads as 0.
-  mvWeakTid <- newMVar' 0
+  mvWeakTid <- S.newMVar 0
   let getEsLes = myThreadId >>= \case
         tid | tid0 == tid -> pure (es0, les0)
         tid -> do
           let wkTid = weakThreadId tid
-          readMVar' mvWeakTid >>= \case
-            0 -> modifyMVar' mvWeakTid $ \case
+          S.readMVar mvWeakTid >>= \case
+            0 -> S.modifyMVar mvWeakTid $ \case
               0 -> pure (wkTid, (es, les))
               _ -> noCapacityError 1
             v | v == wkTid -> pure (es, les)
@@ -398,7 +398,7 @@ mkWeakThreadIdEnv
   :: ThreadId
   -> Int
   -> a
-  -> MVar' (ThreadEntries a)
+  -> S.MVar (ThreadEntries a)
   -> Bool
   -> IO (Weak a)
 mkWeakThreadIdEnv (ThreadId t#) wkTid es v = \case
@@ -409,7 +409,7 @@ mkWeakThreadIdEnv (ThreadId t#) wkTid es v = \case
     case mkWeakNoFinalizer# t# es s0 of
       (# s1, w #) -> (# s1, Weak w #)
   where
-    IO finalizer = modifyMVar'_ v $ \te -> do
+    IO finalizer = S.modifyMVar_ v $ \te -> do
       pure ThreadEntries
         { capacity = case te.capacity of
             -- If the template copy of the environment hasn't been consumed