packages feed

effectful-core 1.2.0.0 → 2.0.0.0

raw patch · 13 files changed

+174/−212 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Effectful.Dispatch.Static.Primitive: checkSizeEnv :: Env es -> IO ()
- Effectful.Dispatch.Static.Primitive: forkEnv :: Env es -> IO (Env es)
- Effectful.Internal.Env: References :: !Int -> !MutablePrimArray RealWorld Int -> References
- Effectful.Internal.Env: [envSize] :: Env (es :: [Effect]) -> !Int
- Effectful.Internal.Env: [refIndices] :: References -> !MutablePrimArray RealWorld Int
- Effectful.Internal.Env: [refSize] :: References -> !Int
- Effectful.Internal.Env: checkSizeEnv :: Env es -> IO ()
- Effectful.Internal.Env: data References
- Effectful.Internal.Env: forkEnv :: Env es -> IO (Env es)
- Effectful.Internal.Env: unsubsumeEnv :: e :> es => Env (e : es) -> IO ()
+ Effectful.Internal.Env: [envOffset] :: Env (es :: [Effect]) -> !Int
+ Effectful.Internal.Env: [stVersion] :: Storage -> !Int
+ Effectful.Internal.Env: [stVersions] :: Storage -> !MutablePrimArray RealWorld Int
- Effectful.Dispatch.Static.Primitive: modifyEnv :: forall e es. e :> es => Env es -> (EffectRep (DispatchOf e) e -> EffectRep (DispatchOf e) e) -> IO ()
+ Effectful.Dispatch.Static.Primitive: modifyEnv :: forall e es. e :> es => Env es -> (EffectRep (DispatchOf e) e -> IO (EffectRep (DispatchOf e) e)) -> IO ()
- Effectful.Dispatch.Static.Primitive: stateEnv :: forall e es a. e :> es => Env es -> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e)) -> IO a
+ Effectful.Dispatch.Static.Primitive: stateEnv :: forall e es a. e :> es => Env es -> (EffectRep (DispatchOf e) e -> IO (a, EffectRep (DispatchOf e) e)) -> IO a
- Effectful.Internal.Env: Env :: !Int -> !IORef References -> !IORef Storage -> Env (es :: [Effect])
+ Effectful.Internal.Env: Env :: !Int -> !PrimArray Int -> !IORef Storage -> Env (es :: [Effect])
- Effectful.Internal.Env: Storage :: !Int -> !SmallMutableArray RealWorld Any -> !SmallMutableArray RealWorld Any -> Storage
+ Effectful.Internal.Env: Storage :: !Int -> !Int -> !MutablePrimArray RealWorld Int -> !SmallMutableArray RealWorld Any -> !SmallMutableArray RealWorld Any -> Storage
- Effectful.Internal.Env: [envRefs] :: Env (es :: [Effect]) -> !IORef References
+ Effectful.Internal.Env: [envRefs] :: Env (es :: [Effect]) -> !PrimArray Int
- Effectful.Internal.Env: modifyEnv :: forall e es. e :> es => Env es -> (EffectRep (DispatchOf e) e -> EffectRep (DispatchOf e) e) -> IO ()
+ Effectful.Internal.Env: modifyEnv :: forall e es. e :> es => Env es -> (EffectRep (DispatchOf e) e -> IO (EffectRep (DispatchOf e) e)) -> IO ()
- Effectful.Internal.Env: stateEnv :: forall e es a. e :> es => Env es -> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e)) -> IO a
+ Effectful.Internal.Env: stateEnv :: forall e es a. e :> es => Env es -> (EffectRep (DispatchOf e) e -> IO (a, EffectRep (DispatchOf e) e)) -> IO a
- Effectful.Internal.Monad: modifyEnv :: forall e es. e :> es => Env es -> (EffectRep (DispatchOf e) e -> EffectRep (DispatchOf e) e) -> IO ()
+ Effectful.Internal.Monad: modifyEnv :: forall e es. e :> es => Env es -> (EffectRep (DispatchOf e) e -> IO (EffectRep (DispatchOf e) e)) -> IO ()
- Effectful.Internal.Monad: stateEnv :: forall e es a. e :> es => Env es -> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e)) -> IO a
+ Effectful.Internal.Monad: stateEnv :: forall e es a. e :> es => Env es -> (EffectRep (DispatchOf e) e -> IO (a, EffectRep (DispatchOf e) e)) -> IO a

Files

CHANGELOG.md view
@@ -1,3 +1,10 @@+# effectful-core-2.0.0.0 (2022-08-12)+* Make storage references in the environment immutable.+* Remove `checkSizeEnv` and `forkEnv` from+  `Effectful.Dispatch.Static.Primitive`.+* Add internal versioning of effects to prevent leakage of `unsafeCoerce`.+* Make `interpose` and `impose` properly interact with other handlers.+ # effectful-core-1.2.0.0 (2022-07-28) * Change `SuffixOf` to `SharedSuffix` and make it behave as advertised. * Add `raiseWith`.
effectful-core.cabal view
@@ -1,7 +1,7 @@ cabal-version:      2.4 build-type:         Simple name:               effectful-core-version:            1.2.0.0+version:            2.0.0.0 license:            BSD-3-Clause license-file:       LICENSE category:           Control@@ -21,7 +21,7 @@   CHANGELOG.md   README.md -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 || ==9.4.1+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.1  bug-reports:   https://github.com/haskell-effectful/effectful/issues source-repository head
src/Effectful/Dispatch/Dynamic.hs view
@@ -353,8 +353,7 @@   -> Eff (e : es) a   -> Eff      es  a interpret handler m = unsafeEff $ \es -> do-  les <- forkEnv es-  (`unEff` es) $ runHandler (Handler les handler) m+  (`unEff` es) $ runHandler (Handler es handler) m  -- | Interpret an effect using other, private effects. --@@ -368,9 +367,8 @@   -> Eff (e : es) a   -> Eff      es  b reinterpret runHandlerEs handler m = unsafeEff $ \es -> do-  les0 <- forkEnv es-  (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do-    (`unEff` es) $ runHandler (Handler les handler) m+  (`unEff` es) . runHandlerEs . unsafeEff $ \handlerEs -> do+    (`unEff` es) $ runHandler (Handler handlerEs handler) m  -- | Replace the handler of an existing effect with a new one. --@@ -406,11 +404,22 @@   -- ^ The effect handler.   -> Eff es a   -> Eff es a-interpose handler m = unsafeEff $ \es0 -> do-  les <- forkEnv es0-  bracket (replaceEnv (Handler les handler) relinkHandler es0)-          (unreplaceEnv @e)-          (\es -> unEff m es)+interpose handler m = unsafeEff $ \es -> do+  bracket (do+              origHandler <- getEnv @e es+              replaceEnv origHandler relinkHandler es+          )+          (\newEs -> do+              -- Restore the original handler.+              putEnv es =<< getEnv @e newEs+              unreplaceEnv @e newEs+          )+          (\newEs -> do+              -- Replace the original handler with a new one. Note that 'newEs'+              -- will still see the original handler.+              putEnv es (Handler newEs handler)+              unEff m es+          )  -- | Replace the handler of an existing effect with a new one that uses other, -- private effects.@@ -424,12 +433,24 @@   -- ^ The effect handler.   -> Eff es a   -> Eff es b-impose runHandlerEs handler m = unsafeEff $ \es0 -> do-  les0 <- forkEnv es0-  (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do-    bracket (replaceEnv (Handler les handler) relinkHandler es0)-            (unreplaceEnv @e)-            (\es -> unEff m es)+impose runHandlerEs handler m = unsafeEff $ \es -> do+  bracket (do+              origHandler <- getEnv @e es+              replaceEnv origHandler relinkHandler es+          )+          (\newEs -> do+              -- Restore the original handler.+              putEnv es =<< getEnv @e newEs+              unreplaceEnv @e newEs+          )+          (\newEs -> do+              (`unEff` newEs) . runHandlerEs . unsafeEff $ \handlerEs -> do+                -- Replace the original handler with a new one. Note that+                -- 'newEs' (and thus 'handlerEs') wil still see the original+                -- handler.+                putEnv es (Handler handlerEs handler)+                unEff m es+          )  ---------------------------------------- -- Unlifts@@ -658,6 +679,7 @@ -- ...Running local actions in monomorphic effect stacks is not supported... -- ... --+-- @since 1.2.0.0 class SharedSuffix (es1 :: [Effect]) (es2 :: [Effect])  instance {-# INCOHERENT #-} SharedSuffix es es
src/Effectful/Dispatch/Static/Primitive.hs view
@@ -31,9 +31,7 @@     -- ** Utils   , emptyEnv   , cloneEnv-  , forkEnv   , sizeEnv-  , checkSizeEnv   , tailEnv   ) where 
src/Effectful/Error/Static.hs view
@@ -156,7 +156,6 @@ catchError m handler = unsafeEff $ \es -> do   Error eid <- getEnv @(Error e) es   catchErrorIO eid (unEff m es) $ \cs e -> do-    checkSizeEnv es     unEff (handler cs e) es  -- | The same as @'flip' 'catchError'@, which is useful in situations where the
src/Effectful/Internal/Env.hs view
@@ -3,7 +3,6 @@ module Effectful.Internal.Env   ( -- * The environment     Env(..)-  , References(..)   , Storage(..)      -- ** Relinker@@ -19,9 +18,7 @@     -- * Operations   , emptyEnv   , cloneEnv-  , forkEnv   , sizeEnv-  , checkSizeEnv   , tailEnv      -- ** Modification of the effect stack@@ -30,7 +27,6 @@   , replaceEnv   , unreplaceEnv   , subsumeEnv-  , unsubsumeEnv   , injectEnv      -- ** Data retrieval and update@@ -55,9 +51,6 @@ -- | A strict (WHNF), __thread local__, mutable, extensible record indexed by types -- of kind 'Effect'. ----- Supports forking, i.e. introduction of local branches for encapsulation of--- effects specific to effect handlers.--- -- __Warning: the environment is a mutable data structure and cannot be simultaneously used from multiple threads under any circumstances.__ -- -- In order to pass it to a different thread, you need to perform a deep copy@@ -66,7 +59,7 @@ -- Offers very good performance characteristics for most often performed -- operations: ----- - Extending: /@O(1)@/ (amortized).+-- - Extending: /@O(n)@/, where @n@ is the size of the effect stack. -- -- - Shrinking: /@O(1)@/. --@@ -74,29 +67,21 @@ -- -- - Modification of a specific element: /@O(1)@/. ----- - Forking: /@O(n)@/, where @n@ is the size of the effect stack.+-- - Getting a tail: /@O(1)@/. ----- - Cloning: /@O(N + Σ(n_i))@/, where @N@ is the size of the 'Storage', while---   @i@ ranges over handlers of dynamically dispatched effects in the 'Storage'---   and @n_i@ is the size of the effect stack of @i@-th handler.+-- - Cloning: /@O(N)@/, where @N@ is the size of the 'Storage'. -- data Env (es :: [Effect]) = Env-  { envSize    :: !Int-  , envRefs    :: !(IORef References)+  { envOffset  :: !Int+  , envRefs    :: !(PrimArray Int)   , envStorage :: !(IORef Storage)   } --- | An array of references to effects in the 'Storage'.-data References = References-  { refSize    :: !Int-  , refIndices :: !(MutablePrimArray RealWorld Int)-  }- -- | A storage of effects.------ Shared between all forks of the environment within the same thread. data Storage = Storage   { stSize      :: !Int+  , stVersion   :: !Int+  , stVersions  :: !(MutablePrimArray RealWorld Int)   , stEffects   :: !(SmallMutableArray RealWorld Any)   , stRelinkers :: !(SmallMutableArray RealWorld Any)   }@@ -140,25 +125,25 @@  -- | Create an empty environment. emptyEnv :: IO (Env '[])-emptyEnv = Env <$> pure 0-  <*> (newIORef . References 0 =<< newPrimArray 0)+emptyEnv = Env 0+  <$> (unsafeFreezePrimArray =<< newPrimArray 0)   <*> (newIORef =<< emptyStorage)  -- | Clone the environment to use it in a different thread. cloneEnv :: Env es -> IO (Env es)-cloneEnv (Env size mrefs0 storage0) = do-  References n refs0 <- readIORef mrefs0-  errorWhenDifferent size n-  mrefs <- newIORef . References n-    =<< cloneMutablePrimArray refs0 0 (sizeofMutablePrimArray refs0)-  Storage storageSize es0 fs0 <- readIORef storage0-  let esSize = sizeofSmallMutableArray es0+cloneEnv (Env offset refs storage0) = do+  Storage storageSize version vs0 es0 fs0 <- readIORef storage0+  let vsSize = sizeofMutablePrimArray  vs0+      esSize = sizeofSmallMutableArray es0       fsSize = sizeofSmallMutableArray fs0+  when (vsSize /= esSize) $ do+    error $ "vsSize (" ++ show vsSize ++ ") /= esSize (" ++ show esSize ++ ")"   when (esSize /= fsSize) $ do     error $ "esSize (" ++ show esSize ++ ") /= fsSize (" ++ show fsSize ++ ")"+  vs <- cloneMutablePrimArray  vs0 0 vsSize   es <- cloneSmallMutableArray es0 0 esSize-  fs <- cloneSmallMutableArray fs0 0 esSize-  storage <- newIORef $ Storage storageSize es fs+  fs <- cloneSmallMutableArray fs0 0 fsSize+  storage <- newIORef $ Storage storageSize version vs es fs   let relinkEffects = \case         0 -> pure ()         k -> do@@ -169,83 +154,55 @@             >>= writeSmallArray es i . toAny           relinkEffects i   relinkEffects storageSize-  pure $ Env size mrefs storage+  pure $ Env offset refs storage {-# NOINLINE cloneEnv #-} --- | Create a fork of the environment.------ Forked environment can be updated independently of the original one within--- the same thread.-forkEnv :: Env es -> IO (Env es)-forkEnv (Env size mrefs0 storage) = do-  References n refs0 <- readIORef mrefs0-  errorWhenDifferent size n-  mrefs <- newIORef . References size-    =<< cloneMutablePrimArray refs0 0 (sizeofMutablePrimArray refs0)-  pure $ Env size mrefs storage-{-# NOINLINE forkEnv #-}---- | Check that the size of the environment is internally consistent.-checkSizeEnv :: Env es -> IO ()-checkSizeEnv (Env size mrefs _) = do-  References n _ <- readIORef mrefs-  errorWhenDifferent size n-{-# NOINLINE checkSizeEnv #-}- -- | Get the current size of the environment. sizeEnv :: Env es -> IO Int-sizeEnv env = pure $ envSize env+sizeEnv (Env offset refs _) = do+  pure $ (sizeofPrimArray refs - offset) `div` 2  -- | Access the tail of the environment. tailEnv :: Env (e : es) -> IO (Env es)-tailEnv (Env size mrefs0 storage) = do-  References n refs0 <- readIORef mrefs0-  errorWhenDifferent size n-  mrefs <- newIORef . References (size - 1)-    =<< cloneMutablePrimArray refs0 0 (sizeofMutablePrimArray refs0)-  pure $ Env (size - 1) mrefs storage-{-# NOINLINE tailEnv #-}+tailEnv (Env offset refs storage) = do+  pure $ Env (offset + 2) refs storage  ---------------------------------------- -- Extending and shrinking --- | Extend the environment with a new data type (in place).+-- | Extend the environment with a new data type. consEnv   :: EffectRep (DispatchOf e) e   -- ^ The representation of the effect.   -> Relinker (EffectRep (DispatchOf e)) e   -> Env es   -> IO (Env (e : es))-consEnv e f (Env size mrefs storage) = do-  References n refs0 <- readIORef mrefs-  errorWhenDifferent size n-  len0 <- getSizeofMutablePrimArray refs0-  refs <- case size `compare` len0 of-    GT -> error $ "size (" ++ show size ++ ") > len0 (" ++ show len0 ++ ")"-    LT -> pure refs0-    EQ -> resizeMutablePrimArray refs0 (doubleCapacity len0)-  ref <- insertEffect storage e f-  writePrimArray refs size ref-  writeIORef mrefs $! References (size + 1) refs-  pure $ Env (size + 1) mrefs storage+consEnv e f (Env offset refs0 storage) = do+  let size = sizeofPrimArray refs0 - offset+  mrefs <- newPrimArray (size + 2)+  copyPrimArray mrefs 2 refs0 offset size+  (ref, version) <- insertEffect storage e f+  writePrimArray mrefs 0 ref+  writePrimArray mrefs 1 version+  refs <- unsafeFreezePrimArray mrefs+  pure $ Env 0 refs storage {-# NOINLINE consEnv #-} --- | Shrink the environment by one data type (in place).+-- | Shrink the environment by one data type. -- -- /Note:/ after calling this function the input environment is no longer -- usable. unconsEnv :: Env (e : es) -> IO ()-unconsEnv (Env size mrefs storage) = do-  References n refs <- readIORef mrefs-  errorWhenDifferent size n-  ref <- readPrimArray refs (size - 1)-  deleteEffect storage ref-  writeIORef mrefs $! References (size - 1) refs+unconsEnv (Env _ refs storage) = do+  deleteEffect storage (indexPrimArray refs 0) {-# NOINLINE unconsEnv #-}  ----------------------------------------  -- | Replace a specific effect in the stack with a new value.+--+-- /Note:/ unlike in 'putEnv' the value in not changed in place, so only the new+-- environment will see it. replaceEnv   :: forall e es. e :> es   => EffectRep (DispatchOf e) e@@ -253,17 +210,16 @@   -> Relinker (EffectRep (DispatchOf e)) e   -> Env es   -> IO (Env es)-replaceEnv e f (Env size mrefs0 storage) = do-  References n refs0 <- readIORef mrefs0-  errorWhenDifferent size n-  len0 <- getSizeofMutablePrimArray refs0-  when (size > len0) $ do-    error $ "size (" ++ show size ++ ") > len0 (" ++ show len0 ++ ")"-  refs <- cloneMutablePrimArray refs0 0 len0-  ref <- insertEffect storage e f-  writePrimArray refs (mkIndex (reifyIndex @e @es) size) ref-  mrefs <- newIORef $ References n refs-  pure $ Env size mrefs storage+replaceEnv e f (Env offset refs0 storage) = do+  let size = sizeofPrimArray refs0 - offset+  mrefs <- newPrimArray size+  copyPrimArray mrefs 0 refs0 offset size+  (ref, version) <- insertEffect storage e f+  let i = 2 * reifyIndex @e @es+  writePrimArray mrefs  i      ref+  writePrimArray mrefs (i + 1) version+  refs <- unsafeFreezePrimArray mrefs+  pure $ Env 0 refs storage {-# NOINLINE replaceEnv #-}  -- | Remove a reference to the replaced effect.@@ -271,59 +227,43 @@ -- /Note:/ after calling this function the input environment is no longer -- usable. unreplaceEnv :: forall e es. e :> es => Env es -> IO ()-unreplaceEnv (Env size mrefs storage) = do-  References n refs <- readIORef mrefs-  errorWhenDifferent size n-  ref <- readPrimArray refs $ mkIndex (reifyIndex @e @es) size-  deleteEffect storage ref+unreplaceEnv (Env offset refs storage) = do+  deleteEffect storage $ indexPrimArray refs (offset + 2 * reifyIndex @e @es) {-# NOINLINE unreplaceEnv #-}  ---------------------------------------- --- | Reference an existing effect from the top of the stack (in place).+-- | Reference an existing effect from the top of the stack. subsumeEnv :: forall e es. e :> es => Env es -> IO (Env (e : es))-subsumeEnv (Env size mrefs storage) = do-  References n refs0 <- readIORef mrefs-  errorWhenDifferent size n-  len0 <- getSizeofMutablePrimArray refs0-  refs <- case size `compare` len0 of-    GT -> error $ "size (" ++ show size ++ ") > len0 (" ++ show len0 ++ ")"-    LT -> pure refs0-    EQ -> resizeMutablePrimArray refs0 (doubleCapacity len0)-  ref <- readPrimArray refs $ mkIndex (reifyIndex @e @es) size-  writePrimArray refs size ref-  writeIORef mrefs $! References (size + 1) refs-  pure $ Env (size + 1) mrefs storage+subsumeEnv (Env offset refs0 storage) = do+  let size = sizeofPrimArray refs0 - offset+  mrefs <- newPrimArray (size + 2)+  copyPrimArray mrefs 2 refs0 offset size+  let ix = offset + 2 * reifyIndex @e @es+  writePrimArray mrefs 0 $ indexPrimArray refs0  ix+  writePrimArray mrefs 1 $ indexPrimArray refs0 (ix + 1)+  refs <- unsafeFreezePrimArray mrefs+  pure $ Env 0 refs storage {-# NOINLINE subsumeEnv #-} --- | Remove a reference to an existing effect from the top of the stack.------ /Note:/ after calling this function the input environment is no longer--- usable.-unsubsumeEnv :: e :> es => Env (e : es) -> IO ()-unsubsumeEnv (Env size mrefs _) = do-  References n refs <- readIORef mrefs-  errorWhenDifferent size n-  writeIORef mrefs $! References (size - 1) refs-{-# NOINLINE unsubsumeEnv #-}- ----------------------------------------  -- | Construct an environment containing a permutation (with possible -- duplicates) of a subset of effects from the input environment. injectEnv :: forall xs es. Subset xs es => Env es -> IO (Env xs)-injectEnv (Env size0 mrefs0 storage) = do-  References n0 refs0 <- readIORef mrefs0-  errorWhenDifferent size0 n0-  let makeRefs k acc = \case-        []       -> unsafeThawPrimArray $ primArrayFromListN k acc+injectEnv (Env offset refs0 storage) = do+  let xs = reifyIndices @xs @es+  mrefs <- newPrimArray (2 * length xs)+  let writeRefs i = \case+        []       -> pure ()         (e : es) -> do-          i <- readPrimArray refs0 $ mkIndex e size0-          makeRefs (k + 1) (i : acc) es-  refs <- makeRefs 0 [] (reifyIndices @xs @es)-  size <- getSizeofMutablePrimArray refs-  mrefs <- newIORef $ References size refs-  pure $ Env size mrefs storage+          let ix = offset + 2 * e+          writePrimArray mrefs  i      $ indexPrimArray refs0  ix+          writePrimArray mrefs (i + 1) $ indexPrimArray refs0 (ix + 1)+          writeRefs (i + 2) es+  writeRefs 0 xs+  refs <- unsafeFreezePrimArray mrefs+  pure $ Env 0 refs storage {-# NOINLINE injectEnv #-}  ----------------------------------------@@ -348,15 +288,15 @@   (i, es) <- getLocation @e env   e `seq` writeSmallArray es i (toAny e) --- | Modify the data type in the environment (in place) and return a value.+-- | Modify the data type in the environment and return a value (in place). stateEnv   :: forall e es a. e :> es   => Env es -- ^ The environment.-  -> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e))+  -> (EffectRep (DispatchOf e) e -> IO (a, EffectRep (DispatchOf e) e))   -> IO a stateEnv env f = do   (i, es) <- getLocation @e env-  (a, e) <- f . fromAny <$> readSmallArray es i+  (a, e) <- f . fromAny =<< readSmallArray es i   e `seq` writeSmallArray es i (toAny e)   pure a @@ -364,11 +304,11 @@ modifyEnv   :: forall e es. e :> es   => Env es -- ^ The environment.-  -> (EffectRep (DispatchOf e) e -> EffectRep (DispatchOf e) e)+  -> (EffectRep (DispatchOf e) e -> IO (EffectRep (DispatchOf e) e))   -> IO () modifyEnv env f = do   (i, es) <- getLocation @e env-  e <- f . fromAny <$> readSmallArray es i+  e <- f . fromAny =<< readSmallArray es i   e `seq` writeSmallArray es i (toAny e)  -- | Determine location of the effect in the environment.@@ -376,23 +316,27 @@   :: forall e es. e :> es   => Env es   -> IO (Int, SmallMutableArray RealWorld Any)-getLocation (Env size mrefs storage) = do-  refs <- refIndices <$> readIORef mrefs-  i <- readPrimArray refs $ mkIndex (reifyIndex @e @es) size-  es <- stEffects <$> readIORef storage+getLocation (Env offset refs storage) = do+  let ix = offset + 2 * reifyIndex @e @es+      i  = indexPrimArray refs ix+  Storage _ _ vs es _ <- readIORef storage+  let version = indexPrimArray refs (ix + 1)+  storageVersion <- readPrimArray vs i+  -- 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+  -- referenced.+  when (version /= storageVersion) $ do+    error $ "version (" ++ show version ++ ") /= storageVersion ("+         ++ show storageVersion ++ ")"   pure (i, es) --- | Get the index of a reference to an effect.-mkIndex :: Int -> Int -> Int-mkIndex ix size = size - ix - 1- ---------------------------------------- -- Internal helpers  -- | Create an empty storage. emptyStorage :: IO Storage-emptyStorage = Storage-  <$> pure 0+emptyStorage = Storage 0 (noVersion + 1)+  <$> newPrimArray 0   <*> newSmallArray 0 undefinedData   <*> newSmallArray 0 undefinedData @@ -402,60 +346,54 @@   -> EffectRep (DispatchOf e) e   -- ^ The representation of the effect.   -> Relinker (EffectRep (DispatchOf e)) e-  -> IO Int+  -> IO (Int, Int) insertEffect storage e f = do-  Storage size es0 fs0 <- readIORef storage+  Storage size version vs0 es0 fs0 <- readIORef storage   let len0 = sizeofSmallMutableArray es0   case size `compare` len0 of     GT -> error $ "size (" ++ show size ++ ") > len0 (" ++ show len0 ++ ")"     LT -> do+      writePrimArray          vs0 size version       e `seq` writeSmallArray es0 size (toAny e)       f `seq` writeSmallArray fs0 size (toAny f)-      writeIORef storage $! Storage (size + 1) es0 fs0-      pure size+      writeIORef storage $! Storage (size + 1) (version + 1) vs0 es0 fs0+      pure (size, version)     EQ -> do       let len = doubleCapacity len0+      vs <- newPrimArray len       es <- newSmallArray len undefinedData       fs <- newSmallArray len undefinedData+      copyMutablePrimArray  vs 0 vs0 0 size       copySmallMutableArray es 0 es0 0 size       copySmallMutableArray fs 0 fs0 0 size+      writePrimArray          vs size version       e `seq` writeSmallArray es size (toAny e)       f `seq` writeSmallArray fs size (toAny f)-      writeIORef storage $! Storage (size + 1) es fs-      pure size+      writeIORef storage $! Storage (size + 1) (version + 1) vs es fs+      pure (size, version) --- | Given a reference to an effect, delete it from the storage.------ /Note:/ the reference needs to point to the end of the storage. Normally it's--- not a problem as it turns out effects are put and taken from the storage in--- the same order across all forks, unless someone tries to do something--- unexpected.+-- | Given a reference to an effect from the top of the stack, delete it from+-- the storage. deleteEffect :: IORef Storage -> Int -> IO () deleteEffect storage ref = do-  Storage size es fs <- readIORef storage+  Storage size version vs es fs <- readIORef storage   when (ref /= size - 1) $ do     error $ "ref (" ++ show ref ++ ") /= size - 1 (" ++ show (size - 1) ++ ")"+  writePrimArray  vs ref noVersion   writeSmallArray es ref undefinedData   writeSmallArray fs ref undefinedData-  writeIORef storage $! Storage (size - 1) es fs+  writeIORef storage $! Storage (size - 1) version vs es fs  -- | Relink the environment to use the new storage. relinkEnv :: IORef Storage -> Env es -> IO (Env es)-relinkEnv storage (Env size mrefs0 _) = do-  References n refs0 <- readIORef mrefs0-  mrefs <- newIORef . References n-    =<< cloneMutablePrimArray refs0 0 (sizeofMutablePrimArray refs0)-  pure $ Env size mrefs storage---- | Throw an error if array sizes do not agree.-errorWhenDifferent :: HasCallStack => Int -> Int -> IO ()-errorWhenDifferent size n-  | size /= n = error $ "size (" ++ show size ++ ") /= n (" ++ show n ++ ")"-  | otherwise = pure ()+relinkEnv storage (Env offset refs _) = pure $ Env offset refs storage  -- | Double the capacity of an array. doubleCapacity :: Int -> Int doubleCapacity n = max 1 n * 2++noVersion :: Int+noVersion = 0  undefinedData :: HasCallStack => a undefinedData = error "undefined data"
src/Effectful/Internal/Monad.hs view
@@ -230,7 +230,6 @@ instance C.MonadCatch (Eff es) where   catch m handler = unsafeEff $ \es -> do     unEff m es `E.catch` \e -> do-      checkSizeEnv es       unEff (handler e) es  instance C.MonadMask (Eff es) where@@ -243,7 +242,6 @@   generalBracket acquire release use = unsafeEff $ \es -> E.mask $ \unmask -> do     resource <- unEff acquire es     b <- unmask (unEff (use resource) es) `E.catch` \e -> do-      checkSizeEnv es       _ <- unEff (release resource $ C.ExitCaseException e) es       E.throwIO e     c <- unEff (release resource $ C.ExitCaseSuccess b) es@@ -325,6 +323,8 @@  -- | Lift an 'Eff' computation into an effect stack with one more effect and -- create an unlifting function with the given strategy.+--+-- @since 1.2.0.0 raiseWith   :: HasCallStack   => UnliftStrategy@@ -343,10 +343,7 @@  -- | Eliminate a duplicate effect from the top of the effect stack. subsume :: e :> es => Eff (e : es) a -> Eff es a-subsume m = unsafeEff $ \es0 -> do-  E.bracket (subsumeEnv es0)-            unsubsumeEnv-            (\es -> unEff m es)+subsume m = unsafeEff $ \es -> unEff m =<< subsumeEnv es  -- | Allow for running an effect stack @xs@ within @es@ as long as @xs@ is a -- permutation (with possible duplicates) of a subset of @es@.@@ -477,7 +474,7 @@   => (StaticRep e -> (a, StaticRep e))   -- ^ The function to modify the representation.   -> Eff es a-stateStaticRep f = unsafeEff $ \es -> stateEnv es f+stateStaticRep f = unsafeEff $ \es -> stateEnv es (pure . f)  -- | Apply the monadic function to the current representation of the effect and -- return a value.@@ -487,9 +484,7 @@   -- ^ The function to modify the representation.   -> Eff es a stateStaticRepM f = unsafeEff $ \es -> E.mask $ \unmask -> do-  (a, s) <- (\s0 -> unmask $ unEff (f s0) es) =<< getEnv es-  putEnv es s-  pure a+  stateEnv es $ unmask . (`unEff` es) . f  -- | Execute a computation with a temporarily modified representation of the -- effect.@@ -500,6 +495,6 @@   -> Eff es a   -> Eff es a localStaticRep f m = unsafeEff $ \es -> do-  E.bracket (stateEnv es $ \s -> (s, f s))+  E.bracket (stateEnv es $ \s -> pure (s, f s))             (\s -> putEnv es s)             (\_ -> unEff m es)
src/Effectful/Internal/Unlift.hs view
@@ -39,9 +39,8 @@ -- 'Effectful.withEffToIO', 'Effectful.withRunInIO' or the -- 'Effectful.Dispatch.Dynamic.localUnlift' family. ----- /Warning:/ unlifting functions should not be used outside of continuations--- that brought them into scope. While this currently works just fine, there are--- no guarantees it will continue doing so in the future.+-- /Note:/ unlifting functions should not be used outside of continuations that+-- brought them into scope. data UnliftStrategy   = SeqUnlift   -- ^ The fastest strategy and a default setting for t'Effectful.IOE'. An
src/Effectful/Reader/Dynamic.hs view
@@ -38,6 +38,8 @@   Local f m -> localSeqUnlift env $ \unlift -> R.local f (unlift m)  -- | Execute a computation in a modified environment.+--+-- @since 1.1.0.0 withReader   :: (r1 -> r2)   -- ^ The function to modify the environment.
src/Effectful/Reader/Static.hs view
@@ -31,6 +31,8 @@ runReader r = evalStaticRep (Reader r)  -- | Execute a computation in a modified environment.+--+-- @since 1.1.0.0 withReader   :: (r1 -> r2)   -- ^ The function to modify the environment.
src/Effectful/Writer/Static/Local.hs view
@@ -77,13 +77,13 @@ -- "Hi there!" listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w) listen m = unsafeEff $ \es -> mask $ \unmask -> do-  w0 <- stateEnv es $ \(Writer w) -> (w, Writer mempty)+  w0 <- stateEnv es $ \(Writer w) -> pure (w, Writer mempty)   a <- unmask (unEff m es) `onException` merge es w0   (a, ) <$> merge es w0   where     merge es w0 =       -- If an exception is thrown, restore w0 and keep parts of w1.-      stateEnv es $ \(Writer w1) -> (w1, Writer (w0 <> w1))+      stateEnv es $ \(Writer w1) -> pure (w1, Writer (w0 <> w1))  -- | Execute an action and append its output to the overall output of the -- 'Writer', then return the final value along with a function of the recorded
src/Effectful/Writer/Static/Shared.hs view
@@ -87,7 +87,7 @@   uninterruptibleMask $ \unmask -> do     v1 <- newMVar mempty     -- Replace thread local MVar with a fresh one for isolated listening.-    v0 <- stateEnv es $ \(Writer v) -> (v, Writer v1)+    v0 <- stateEnv es $ \(Writer v) -> pure (v, Writer v1)     a <- unmask (unEff m es) `onException` merge es v0 v1     (a, ) <$> merge es v0 v1   where
utils/Effectful/Internal/Utils.hs view
@@ -22,7 +22,7 @@ weakThreadId (ThreadId t#) = fromIntegral $ rts_getThreadId t#  foreign import ccall unsafe "rts_getThreadId"-#if __GLASGOW_HASKELL__ >= 903+#if __GLASGOW_HASKELL__ >= 904   -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6163   rts_getThreadId :: ThreadId# -> CULLong #elif __GLASGOW_HASKELL__ >= 900