From 0809257719d9e7f466fb3e0e26f1cab81ae2fc17 Mon Sep 17 00:00:00 2001 From: Andrzej Rybczak Date: Mon, 16 Sep 2024 21:50:17 +0200 Subject: [PATCH] Add SeqForkUnlift strategy (#224) --- effectful-core/CHANGELOG.md | 2 + .../src/Effectful/Dispatch/Dynamic.hs | 18 +++++++ effectful-core/src/Effectful/Internal/Env.hs | 5 +- .../src/Effectful/Internal/Monad.hs | 16 +++++++ .../src/Effectful/Internal/Unlift.hs | 48 +++++++++++++++++++ effectful/CHANGELOG.md | 2 + 6 files changed, 90 insertions(+), 1 deletion(-) diff --git a/effectful-core/CHANGELOG.md b/effectful-core/CHANGELOG.md index 786efc2..d62dd4d 100644 --- a/effectful-core/CHANGELOG.md +++ b/effectful-core/CHANGELOG.md @@ -15,6 +15,8 @@ experience. * Properly roll back changes made to the environment when `OnEmptyRollback` policy for the `NonDet` effect is selected. +* Add a `SeqForkUnlift` strategy to support running unlifting functions outside + of the scope of effects they capture. * **Breaking changes**: - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a list of effects instead of a single one. diff --git a/effectful-core/src/Effectful/Dispatch/Dynamic.hs b/effectful-core/src/Effectful/Dispatch/Dynamic.hs index 249546a..ae2b737 100644 --- a/effectful-core/src/Effectful/Dispatch/Dynamic.hs +++ b/effectful-core/src/Effectful/Dispatch/Dynamic.hs @@ -739,6 +739,9 @@ localUnlift (LocalEnv les) strategy k = case strategy of SeqUnlift -> unsafeEff $ \es -> do seqUnliftIO les $ \unlift -> do (`unEff` es) $ k $ unsafeEff_ . unlift + SeqForkUnlift -> unsafeEff $ \es -> do + seqForkUnliftIO les $ \unlift -> do + (`unEff` es) $ k $ unsafeEff_ . unlift ConcUnlift p l -> unsafeEff $ \es -> do concUnliftIO les p l $ \unlift -> do (`unEff` es) $ k $ unsafeEff_ . unlift @@ -755,6 +758,7 @@ localUnliftIO -> Eff es a localUnliftIO (LocalEnv les) strategy k = case strategy of SeqUnlift -> liftIO $ seqUnliftIO les k + SeqForkUnlift -> liftIO $ seqForkUnliftIO les k ConcUnlift p l -> liftIO $ concUnliftIO les p l k {-# INLINE localUnliftIO #-} @@ -795,6 +799,9 @@ localLift !_ strategy k = case strategy of SeqUnlift -> unsafeEff $ \es -> do seqUnliftIO es $ \unlift -> do (`unEff` es) $ k $ unsafeEff_ . unlift + SeqForkUnlift -> unsafeEff $ \es -> do + seqForkUnliftIO es $ \unlift -> do + (`unEff` es) $ k $ unsafeEff_ . unlift ConcUnlift p l -> unsafeEff $ \es -> do concUnliftIO es p l $ \unlift -> do (`unEff` es) $ k $ unsafeEff_ . unlift @@ -885,6 +892,10 @@ localLiftUnlift (LocalEnv les) strategy k = case strategy of seqUnliftIO es $ \unliftEs -> do seqUnliftIO les $ \unliftLocalEs -> do (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs) + SeqForkUnlift -> unsafeEff $ \es -> do + seqForkUnliftIO es $ \unliftEs -> do + seqForkUnliftIO les $ \unliftLocalEs -> do + (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs) ConcUnlift p l -> unsafeEff $ \es -> do concUnliftIO es p l $ \unliftEs -> do concUnliftIO les p l $ \unliftLocalEs -> do @@ -909,6 +920,7 @@ localLiftUnliftIO -> Eff es a localLiftUnliftIO (LocalEnv les) strategy k = case strategy of SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_ + SeqForkUnlift -> liftIO $ seqForkUnliftIO les $ k unsafeEff_ ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_ {-# INLINE localLiftUnliftIO #-} @@ -987,6 +999,9 @@ localLend (LocalEnv les) strategy k = case strategy of SeqUnlift -> unsafeEff $ \es -> do eles <- copyRefs @lentEs es les seqUnliftIO eles $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift + SeqForkUnlift -> unsafeEff $ \es -> do + eles <- copyRefs @lentEs es les + seqForkUnliftIO eles $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift ConcUnlift p l -> unsafeEff $ \es -> do eles <- copyRefs @lentEs es les concUnliftIO eles p l $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift @@ -1025,6 +1040,9 @@ localBorrow (LocalEnv les) strategy k = case strategy of SeqUnlift -> unsafeEff $ \es -> do ees <- copyRefs @borrowedEs les es seqUnliftIO ees $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift + SeqForkUnlift -> unsafeEff $ \es -> do + ees <- copyRefs @borrowedEs les es + seqForkUnliftIO ees $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift ConcUnlift p l -> unsafeEff $ \es -> do ees <- copyRefs @borrowedEs les es concUnliftIO ees p l $ \unlift -> (`unEff` es) $ k $ unsafeEff_ . unlift diff --git a/effectful-core/src/Effectful/Internal/Env.hs b/effectful-core/src/Effectful/Internal/Env.hs index 8bc824d..7cee10b 100644 --- a/effectful-core/src/Effectful/Internal/Env.hs +++ b/effectful-core/src/Effectful/Internal/Env.hs @@ -383,7 +383,10 @@ getLocation (Env offset refs storage) = do -- referenced. when (version /= storageVersion) $ do error $ "version (" ++ show version ++ ") /= storageVersion (" - ++ show storageVersion ++ ")" + ++ show storageVersion ++ ")\n" + ++ "If you're attempting to run an unlifting function outside " + ++ "of the scope of effects it captures, have a look at " + ++ "UnliftingStrategy (SeqForkUnlift)." pure (ref, es) ---------------------------------------- diff --git a/effectful-core/src/Effectful/Internal/Monad.hs b/effectful-core/src/Effectful/Internal/Monad.hs index 2036fdb..86c640f 100644 --- a/effectful-core/src/Effectful/Internal/Monad.hs +++ b/effectful-core/src/Effectful/Internal/Monad.hs @@ -50,6 +50,7 @@ module Effectful.Internal.Monad -- ** Low-level unlifts , seqUnliftIO + , seqForkUnliftIO , concUnliftIO -- * Dispatch @@ -203,6 +204,7 @@ withEffToIO -> Eff es a withEffToIO strategy k = case strategy of SeqUnlift -> unsafeEff $ \es -> seqUnliftIO es k + SeqForkUnlift -> unsafeEff $ \es -> seqForkUnliftIO es k ConcUnlift p b -> unsafeEff $ \es -> concUnliftIO es p b k {-# INLINE withEffToIO #-} @@ -238,6 +240,16 @@ seqUnliftIO es k = do $ "If you want to use the unlifting function to run Eff computations " ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)." +-- | Create an unlifting function with the 'SeqForkUnlift' strategy. +seqForkUnliftIO + :: HasCallStack + => Env es + -- ^ The environment. + -> ((forall r. Eff es r -> IO r) -> IO a) + -- ^ Continuation with the unlifting function in scope. + -> IO a +seqForkUnliftIO es0 k = cloneEnv es0 >>= \es -> seqUnliftIO es k + -- | Create an unlifting function with the 'ConcUnlift' strategy. concUnliftIO :: HasCallStack @@ -428,6 +440,10 @@ raiseWith strategy k = case strategy of es <- tailEnv ees seqUnliftIO ees $ \unlift -> do (`unEff` es) $ k $ unsafeEff_ . unlift + SeqForkUnlift -> unsafeEff $ \ees -> do + es <- tailEnv ees + seqForkUnliftIO ees $ \unlift -> do + (`unEff` es) $ k $ unsafeEff_ . unlift ConcUnlift p l -> unsafeEff $ \ees -> do es <- tailEnv ees concUnliftIO ees p l $ \unlift -> do diff --git a/effectful-core/src/Effectful/Internal/Unlift.hs b/effectful-core/src/Effectful/Internal/Unlift.hs index c1348ce..72c3ea6 100644 --- a/effectful-core/src/Effectful/Internal/Unlift.hs +++ b/effectful-core/src/Effectful/Internal/Unlift.hs @@ -44,6 +44,54 @@ data UnliftStrategy -- ^ The sequential strategy is the fastest and a default setting for -- t'Effectful.IOE'. Any attempt of calling the unlifting function in threads -- distinct from its creator will result in a runtime error. + | SeqForkUnlift + -- ^ Like 'SeqUnlift', but all unlifted actions will be executed in a cloned + -- environment. + -- + -- The main consequence is that thread local state is forked at the point of + -- creation of the unlifting function and its modifications in unlifted + -- actions will not affect the main thread of execution (and vice versa): + -- + -- >>> import Effectful + -- >>> import Effectful.State.Dynamic + -- >>> :{ + -- action :: (IOE :> es, State Int :> es) => Eff es () + -- action = do + -- modify @Int (+1) + -- withEffToIO SeqForkUnlift $ \unlift -> unlift $ modify @Int (+2) + -- modify @Int (+4) + -- :} + -- + -- >>> runEff . execStateLocal @Int 0 $ action + -- 5 + -- + -- >>> runEff . execStateShared @Int 0 $ action + -- 7 + -- + -- Because of this it's possible to safely use the unlifting function outside + -- of the scope of effects it captures, e.g. by creating an @IO@ action that + -- executes effectful operations and running it later: + -- + -- >>> :{ + -- delayed :: UnliftStrategy -> IO (IO String) + -- delayed strategy = runEff . evalStateLocal "Hey" $ do + -- r <- withEffToIO strategy $ \unlift -> pure $ unlift get + -- modify (++ "!!!") + -- pure r + -- :} + -- + -- This doesn't work with the 'SeqUnlift' strategy because when the returned + -- action runs, @State@ is no longer in scope: + -- + -- >>> join $ delayed SeqUnlift + -- *** Exception: version (...) /= storageVersion (0) + -- ... + -- + -- However, it does with the 'SeqForkUnlift' strategy: + -- + -- >>> join $ delayed SeqForkUnlift + -- "Hey" + -- | ConcUnlift !Persistence !Limit -- ^ The concurrent strategy makes it possible for the unlifting function to -- be called in threads distinct from its creator. See 'Persistence' and diff --git a/effectful/CHANGELOG.md b/effectful/CHANGELOG.md index 9be8956..cf43ae8 100644 --- a/effectful/CHANGELOG.md +++ b/effectful/CHANGELOG.md @@ -17,6 +17,8 @@ experience. * Properly roll back changes made to the environment when `OnEmptyRollback` policy for the `NonDet` effect is selected. +* Add a `SeqForkUnlift` strategy to support running unlifting functions outside + of the scope of effects they capture. * **Breaking changes**: - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a list of effects instead of a single one.