@@ -1,62 +1,50 @@
1−{-# LANGUAGE MagicHash #-}
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
3−-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.
3+-- | The environment for 'Effectful.Internal.Monad.Eff'.
5-- This module is intended for internal use only, and may change without warning
5-- This module is intended for internal use only, and may change without warning
6-- in subsequent releases.
6-- in subsequent releases.
7module Effectful.Internal.Env
7module Effectful.Internal.Env
8− ( -- * The environment
21 , Relinker(..)
9 , Relinker(..)
22 , noRelinker
10 , noRelinker
24− -- * Operations
12+ -- * Safe operations
25 , emptyEnv
13 , emptyEnv
26 , cloneEnv
14 , cloneEnv
29 , checkSizeEnv
18 , checkSizeEnv
31− -- ** Extending and shrinking
20+ -- * Extending and shrinking
32 , unsafeConsEnv
21 , unsafeConsEnv
33 , unsafeTailEnv
22 , unsafeTailEnv
35− -- ** Data retrieval and update
24+ -- * Data retrieval and update
36− , getEnv
25+ , unsafePutEnv
37− , putEnv
26+ , unsafeModifyEnv
38− , stateEnv
27+ , unsafeStateEnv
42import Control.Monad
30import Control.Monad
43import Control.Monad.Primitive
31import Control.Monad.Primitive
44import Data.IORef
32import Data.IORef
45import Data.Primitive.SmallArray
33import Data.Primitive.SmallArray
46−import GHC.Exts (Any, SmallMutableArray#)
35+import GHC.Exts (Any)
47−import GHC.Stack (HasCallStack)
48import Unsafe.Coerce
36import Unsafe.Coerce
49−import qualified Data.IntMap.Strict as IM
37+import qualified Data.Map.Strict as M
51import Effectful.Internal.Effect
39import Effectful.Internal.Effect
53type role Env nominal
41type role Env nominal
43+-- | A mutable, strict (elements are kept in weak head normal form), extensible
55−-- | A strict (WHNF), thread local, mutable, extensible record indexed by types
44+-- record indexed by effect data types.
58-- Supports forking, i.e. introduction of local branches for encapsulation of
46-- Supports forking, i.e. introduction of local branches for encapsulation of
59−-- data specific to effect handlers.
47+-- data specific to effect interpreters.
61-- Offers very good performance characteristics:
49-- Offers very good performance characteristics:
@@ -66,90 +54,41 @@ type role Env nominal
67-- - Indexing via '(:>)': /O(forks)/, usually /O(1)/ (amortized).
55-- - Indexing via '(:>)': /O(forks)/, usually /O(1)/ (amortized).
69−-- - Modification of a specific element: /O(1)/.
57+-- - Modification of a specific element: /O(forks)/, usually /O(1)/.
71−-- Here's an example of how the environment might look:
74−-- e00 - e01 - e05 - e07 (*)
83−-- The point of execution is currently at (*), i.e. the mainline. Moreover,
84−-- currently (brackets represent forks):
86−-- - Mainline sees @[e00, e01, e05, e07]@.
88−-- - @e01@ is an interpreted effect, its handler sees @[e00][e02, e03]@.
90−-- - @e03@ is an interpreted effect, its handler sees @[e00][e02][e04]@.
92−-- - @e05@ is an interpreted effect, its handler sees @[e00, e01][e06]@.
94−-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05][e08,
97−-- If an operation from @e01@ is invoked, the environment in the middle of
98−-- handling it might look like this:
101−-- e00 - e01 - e05 - e07
105−-- e02 - e03 - e10 (*)
112−-- The point of execution is at (*), i.e. inside the handler of @e01@. The
113−-- handler needed to introduce @e10@ (which introduced @e11@, which in turn
114−-- introduced @e12@), so its local environment was temporarily extended with
115−-- it. Moreover, currently:
117−-- - Handler of @e01@ sees @[e00][e02, e03, e10]@.
119−-- - Handler of @e10@ sees @[e00][e02, e03][e11]@.
121−-- - Handler of @e11@ sees @[e00][e02, e03][e12]@.
123data Env (es :: [Effect]) = Env
59data Env (es :: [Effect]) = Env
124− { _forks :: !Forks
60+ { _forks :: Forks
125− , _globalRef :: !(IORef EnvRef)
61+ , _globalRef :: IORef EnvRef
126− , _forkIdGen :: !ForkIdGen
62+ , _forkIdGen :: ForkIdGen
129-- | Local forks of the environment.
65-- | Local forks of the environment.
130−data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork
66+data Forks = Forks ForkId Int (IORef EnvRef) Forks | NoFork
132−-- | Data held in the environment.
133data EnvRef = EnvRef
68data EnvRef = EnvRef
134− { _size :: !Int
69+ { _capacity :: Int
135− , _data :: !(SmallMutableArray RealWorld Any)
70+ , _data :: SmallMutableArray RealWorld Any
136− , _relinkers :: !(SmallMutableArray RealWorld Any)
71+ , _relinkers :: SmallMutableArray RealWorld Any
139----------------------------------------
74----------------------------------------
142−-- | Internal id of the fork.
77+newtype ForkId = ForkId Word64
143−newtype ForkId = ForkId { unForkId :: Int }
78+ deriving (Eq, Ord, Show)
80+-- | Implicit 'ForkId' of the 'EnvRef' directly available from 'Env'.
145-- | 'ForkId' generation.
84-- | 'ForkId' generation.
146newtype ForkIdGen = ForkIdGen (IORef ForkId)
85newtype ForkIdGen = ForkIdGen (IORef ForkId)
148−-- | Create a new thread local 'ForkId' generator.
87+-- | Create a new thread local unique generator.
149newForkIdGen :: IO ForkIdGen
88newForkIdGen :: IO ForkIdGen
150−newForkIdGen = ForkIdGen <$> newIORef (ForkId 0)
89+newForkIdGen = ForkIdGen <$> newIORef (ForkId 1)
152−-- | Clone the 'ForkId' generator for use in a different thread.
91+-- | Clone the unique generator for use in a different thread.
153cloneForkIdGen :: ForkIdGen -> IO ForkIdGen
92cloneForkIdGen :: ForkIdGen -> IO ForkIdGen
154cloneForkIdGen (ForkIdGen ref) = fmap ForkIdGen . newIORef =<< readIORef ref
93cloneForkIdGen (ForkIdGen ref) = fmap ForkIdGen . newIORef =<< readIORef ref
@@ -163,15 +102,12 @@ newForkId (ForkIdGen ref) = do
163----------------------------------------
102----------------------------------------
164-- Relinker
103-- Relinker
166−-- | A function for relinking 'Env' objects stored in the handlers when cloning
168−newtype Relinker :: (Effect -> Type) -> Effect -> Type where
105+newtype Relinker i (e :: Effect) where
170− :: ((forall es. Env es -> IO (Env es)) -> adapter e -> IO (adapter e))
107+ :: ((forall es. Env es -> IO (Env es)) -> i e -> IO (i e))
171− -> Relinker adapter e
108+ -> Relinker i e
173−-- | A dummy 'Relinker' that does nothing.
174−noRelinker :: Relinker adapter e
110+noRelinker :: Relinker i e
175noRelinker = Relinker $ \_ -> pure
111noRelinker = Relinker $ \_ -> pure
177----------------------------------------
113----------------------------------------
@@ -184,27 +120,23 @@ emptyEnv = Env NoFork <$> emptyEnvRef <*> newForkIdGen
184-- | Clone the environment.
120-- | Clone the environment.
185cloneEnv :: Env es -> IO (Env es)
121cloneEnv :: Env es -> IO (Env es)
186cloneEnv (Env NoFork gref0 gen0) = do
122cloneEnv (Env NoFork gref0 gen0) = do
187− EnvRef n es0 fs0 <- readIORef gref0
188− es <- cloneSmallMutableArray es0 0 (sizeofSmallMutableArray es0)
189− fs <- cloneSmallMutableArray fs0 0 (sizeofSmallMutableArray fs0)
190 gen <- cloneForkIdGen gen0
123 gen <- cloneForkIdGen gen0
191− gref <- newIORef $ EnvRef n es fs
192− store <- newIORef IM.empty
124+ cache <- newIORef M.empty
193− relinkData gref gen store es fs n
125+ gref <- cloneEnvRef gen cache globalFid gref0
194 pure $ Env NoFork gref gen
126 pure $ Env NoFork gref gen
195cloneEnv (Env forks@(Forks _ baseIx lref0 _) gref0 gen0) = do
127cloneEnv (Env forks@(Forks _ baseIx lref0 _) gref0 gen0) = do
196 EnvRef _ es0 fs0 <- readIORef gref0
128 EnvRef _ es0 fs0 <- readIORef gref0
197 EnvRef n _ _ <- readIORef lref0
129 EnvRef n _ _ <- readIORef lref0
198 let len = baseIx + n
130 let len = baseIx + n
199− es <- newSmallArray len undefinedData
131+ es <- newSmallArray len (error "undefined field")
200− fs <- newSmallArray len undefinedData
132+ fs <- newSmallArray len (error "undefined field")
201 baseN <- copyForks es fs len forks
133 baseN <- copyForks es fs len forks
202 copySmallMutableArray es 0 es0 0 baseN
134 copySmallMutableArray es 0 es0 0 baseN
203 copySmallMutableArray fs 0 fs0 0 baseN
135 copySmallMutableArray fs 0 fs0 0 baseN
204 gen <- cloneForkIdGen gen0
136 gen <- cloneForkIdGen gen0
205 gref <- newIORef $ EnvRef len es fs
137 gref <- newIORef $ EnvRef len es fs
206− store <- newIORef IM.empty
138+ cache <- newIORef $ M.singleton globalFid gref
207− relinkData gref gen store es fs n
139+ relinkData gen cache es fs n
208 -- The forked environment is flattened and becomes the global one.
140 -- The forked environment is flattened and becomes the global one.
209 pure $ Env NoFork gref gen
141 pure $ Env NoFork gref gen
210{-# NOINLINE cloneEnv #-}
142{-# NOINLINE cloneEnv #-}
@@ -254,18 +186,33 @@ copyForks es fs len = \case
254 copySmallMutableArray fs baseIx fs0 0 n
186 copySmallMutableArray fs baseIx fs0 0 n
255 copyForks es fs baseIx forks
187 copyForks es fs baseIx forks
257−type EnvRefStore = IORef (IM.IntMap (IORef EnvRef))
189+type EnvRefCache = IORef (M.Map ForkId (IORef EnvRef))
191+-- | Clone the 'EnvRef' and put it in a cache.
197+ -> IO (IORef EnvRef)
198+cloneEnvRef gen cache fid ref0 = do
199+ EnvRef n es0 fs0 <- readIORef ref0
200+ es <- cloneSmallMutableArray es0 0 (sizeofSmallMutableArray es0)
201+ fs <- cloneSmallMutableArray fs0 0 (sizeofSmallMutableArray fs0)
202+ ref <- newIORef $ EnvRef n es fs
203+ modifyIORef' cache $ M.insert fid ref
204+ relinkData gen cache es fs n
259−-- | Relink local environments hiding in the handlers.
207+-- | Relink local environments hiding in the interpreters.
260relinkData
208relinkData
262− -> ForkIdGen
209+ :: ForkIdGen
263− -> EnvRefStore
210+ -> EnvRefCache
264 -> SmallMutableArray RealWorld Any
211 -> SmallMutableArray RealWorld Any
265 -> SmallMutableArray RealWorld Any
212 -> SmallMutableArray RealWorld Any
268−relinkData gref gen store es fs = \case
215+relinkData gen cache es fs = \case
269 0 -> pure ()
216 0 -> pure ()
271 let i = n - 1
218 let i = n - 1
@@ -273,46 +220,29 @@ relinkData gref gen store es fs = \case
273 readSmallArray es i
220 readSmallArray es i
274 >>= f relinkEnv . fromAny
221 >>= f relinkEnv . fromAny
275 >>= writeSmallArray es i . toAny
222 >>= writeSmallArray es i . toAny
276− relinkData gref gen store es fs i
223+ relinkData gen cache es fs i
278 relinkEnv :: Env es -> IO (Env es)
225 relinkEnv :: Env es -> IO (Env es)
279− relinkEnv (Env forks _ _) = Env <$> relinkForks gref gen store forks
226+ relinkEnv (Env forks _ _) = do
280− <*> pure gref
227+ Just gref <- M.lookup globalFid <$> readIORef cache
281− <*> pure gen
228+ Env <$> relinkForks gen cache forks <*> pure gref <*> pure gen
283−relinkForks :: IORef EnvRef -> ForkIdGen -> EnvRefStore -> Forks -> IO Forks
230+relinkForks :: ForkIdGen -> EnvRefCache -> Forks -> IO Forks
284−relinkForks gref gen store = \case
231+relinkForks gen cache = \case
285 NoFork -> pure NoFork
232 NoFork -> pure NoFork
286 Forks fid baseIx lref0 forks -> do
233 Forks fid baseIx lref0 forks -> do
287 -- A specific IORef EnvRef can be held by more than one local environment
234 -- A specific IORef EnvRef can be held by more than one local environment
288 -- and we need to replace all its occurences with the same, new value
235 -- and we need to replace all its occurences with the same, new value
289 -- containing its clone.
236 -- containing its clone.
290− readIORef store >>= pure . IM.lookup (unForkId fid) >>= \case
237+ readIORef cache >>= pure . M.lookup fid >>= \case
291 Just lref -> Forks fid baseIx <$> pure lref
238 Just lref -> Forks fid baseIx <$> pure lref
292− <*> relinkForks gref gen store forks
239+ <*> relinkForks gen cache forks
293− Nothing -> Forks fid baseIx <$> cloneEnvRef gref gen store fid lref0
240+ Nothing -> Forks fid baseIx <$> cloneEnvRef gen cache fid lref0
294− <*> relinkForks gref gen store forks
241+ <*> relinkForks gen cache forks
296−-- | Clone the local 'EnvRef' and put it in a store.
303− -> IO (IORef EnvRef)
304−cloneEnvRef gref gen store fid lref0 = do
305− EnvRef n es0 fs0 <- readIORef lref0
306− es <- cloneSmallMutableArray es0 0 (sizeofSmallMutableArray es0)
307− fs <- cloneSmallMutableArray fs0 0 (sizeofSmallMutableArray fs0)
308− ref <- newIORef $ EnvRef n es fs
309− modifyIORef' store $ IM.insert (unForkId fid) ref
310− relinkData gref gen store es fs n
313----------------------------------------
243----------------------------------------
315−-- | Create a local fork of the environment for handlers.
245+-- | Create a local fork of the environment for interpreters.
316forkEnv :: Env es -> IO (Env es)
246forkEnv :: Env es -> IO (Env es)
317forkEnv env@(Env NoFork gref gen) = do
247forkEnv env@(Env NoFork gref gen) = do
318 size <- sizeEnv env
248 size <- sizeEnv env
@@ -322,7 +252,7 @@ forkEnv env@(Env NoFork gref gen) = do
322forkEnv (Env forks@(Forks _ baseIx lref0 olderForks) gref gen) = do
252forkEnv (Env forks@(Forks _ baseIx lref0 olderForks) gref gen) = do
323 fid <- newForkId gen
253 fid <- newForkId gen
324 lref <- emptyEnvRef
254 lref <- emptyEnvRef
325− (_size <$> readIORef lref0) >>= \case
255+ (_capacity <$> readIORef lref0) >>= \case
326 -- If the fork is empty, replace it as no data is lost.
256 -- If the fork is empty, replace it as no data is lost.
327 0 -> pure $ Env (Forks fid baseIx lref olderForks) gref gen
257 0 -> pure $ Env (Forks fid baseIx lref olderForks) gref gen
328 _ -> pure $ Env (Forks fid baseIx lref forks) gref gen
258 _ -> pure $ Env (Forks fid baseIx lref forks) gref gen
@@ -338,6 +268,12 @@ sizeEnv (Env (Forks _ baseIx lref _) _ _) = do
338 pure $ baseIx + n
268 pure $ baseIx + n
339{-# NOINLINE sizeEnv #-}
269{-# NOINLINE sizeEnv #-}
271+-- | Extract a specific data type from the environment.
272+getEnv :: forall e es i. e :> es => Env es -> IO (i e)
274+ (i, es) <- getLocation @e env
275+ fromAny <$> readSmallArray es i
341-- | Check that the size of the environment is the same as the expected value.
277-- | Check that the size of the environment is the same as the expected value.
342checkSizeEnv :: Int -> Env es -> IO ()
278checkSizeEnv :: Int -> Env es -> IO ()
343checkSizeEnv k (Env NoFork ref _) = do
279checkSizeEnv k (Env NoFork ref _) = do
@@ -355,11 +291,7 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do
355-- Extending and shrinking
291-- Extending and shrinking
357-- | Extend the environment with a new data type (in place).
293-- | Extend the environment with a new data type (in place).
359−-- This function is __highly unsafe__ because it renders the input 'Env'
360−-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not
362−unsafeConsEnv :: adapter e -> Relinker adapter e -> Env es -> IO (Env (e : es))
294+unsafeConsEnv :: i e -> Relinker i e -> Env es -> IO (Env (e : es))
363unsafeConsEnv e f (Env fork gref gen) = case fork of
295unsafeConsEnv e f (Env fork gref gen) = case fork of
364 NoFork -> do
296 NoFork -> do
365 extendEnvRef gref
297 extendEnvRef gref
@@ -380,10 +312,10 @@ unsafeConsEnv e f (Env fork gref gen) = case fork of
380 writeIORef ref $! EnvRef (n + 1) es0 fs0
312 writeIORef ref $! EnvRef (n + 1) es0 fs0
382 let len = doubleCapacity len0
314 let len = doubleCapacity len0
383− es <- newSmallArray len undefinedData
315+ es <- newSmallArray len (error "undefined field")
384 copySmallMutableArray es 0 es0 0 len0
316 copySmallMutableArray es 0 es0 0 len0
385 e `seq` writeSmallArray es n (toAny e)
317 e `seq` writeSmallArray es n (toAny e)
386− fs <- newSmallArray len undefinedData
318+ fs <- newSmallArray len (error "undefined field")
387 copySmallMutableArray fs 0 fs0 0 len0
319 copySmallMutableArray fs 0 fs0 0 len0
388 f `seq` writeSmallArray fs n (toAny f)
320 f `seq` writeSmallArray fs n (toAny f)
389 writeIORef ref $! EnvRef (n + 1) es fs
321 writeIORef ref $! EnvRef (n + 1) es fs
@@ -394,13 +326,14 @@ unsafeConsEnv e f (Env fork gref gen) = case fork of
395-- | Shrink the environment by one data type (in place). Makes sure the size of
327-- | Shrink the environment by one data type (in place). Makes sure the size of
396-- the environment is as expected.
328-- the environment is as expected.
398−-- This function is __highly unsafe__ because it renders the input 'Env'
399−-- unusable, but it's not checked anywhere.
400−unsafeTailEnv :: Int -> Env (e : es) -> IO ()
329+unsafeTailEnv :: Int -> Env (e : es) -> IO (Env es)
401−unsafeTailEnv len (Env fork gref _) = case fork of
330+unsafeTailEnv len (Env fork gref gen) = case fork of
402− NoFork -> shrinkEnvRef len gref
332+ shrinkEnvRef len gref
333+ pure $ Env NoFork gref gen
334+ Forks _ baseIx lref _ -> do
403− Forks _ baseIx lref _ -> shrinkEnvRef (len - baseIx) lref
335+ shrinkEnvRef (len - baseIx) lref
336+ pure $ Env fork gref gen
405 shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
338 shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
406 shrinkEnvRef k ref = do
339 shrinkEnvRef k ref = do
@@ -408,109 +341,82 @@ unsafeTailEnv len (Env fork gref _) = case fork of
408 if k /= n - 1
341 if k /= n - 1
409 then error $ "k (" ++ show k ++ ") /= n - 1 (" ++ show (n - 1) ++ ")"
342 then error $ "k (" ++ show k ++ ") /= n - 1 (" ++ show (n - 1) ++ ")"
411− writeSmallArray es k undefinedData
344+ writeSmallArray es k (error "undefined field")
412− writeSmallArray fs k undefinedData
345+ writeSmallArray fs k (error "undefined field")
413 writeIORef ref $! EnvRef k es fs
346 writeIORef ref $! EnvRef k es fs
414{-# NOINLINE unsafeTailEnv #-}
347{-# NOINLINE unsafeTailEnv #-}
416----------------------------------------
349----------------------------------------
417-- Data retrieval and update
350-- Data retrieval and update
419−-- | Extract a specific data type from the environment.
421− :: forall e adapter es. e :> es
425− Location i es <- getLocation (reifyIndex @e @es) env
426− fromAny <$> readSmallArray es i
428-- | Replace the data type in the environment with a new value (in place).
352-- | Replace the data type in the environment with a new value (in place).
429−putEnv
353+unsafePutEnv :: forall e es i. e :> es => i e -> Env es -> IO ()
430− :: forall e adapter es. e :> es
354+unsafePutEnv e env = do
431− => Env es
355+ (i, es) <- getLocation @e env
432− -> adapter e
356+ e `seq` writeSmallArray es i (toAny e)
434−putEnv env e = do
358+-- | Modify the data type in the environment (in place).
359+unsafeModifyEnv :: forall e es i. e :> es => (i e -> i e) -> Env es -> IO ()
360+unsafeModifyEnv f env = do
435− Location i es <- getLocation (reifyIndex @e @es) env
361+ (i, es) <- getLocation @e env
362+ e <- f . fromAny <$> readSmallArray es i
436 e `seq` writeSmallArray es i (toAny e)
363 e `seq` writeSmallArray es i (toAny e)
438-- | Modify the data type in the environment (in place) and return a value.
365-- | Modify the data type in the environment (in place) and return a value.
439−stateEnv
366+unsafeStateEnv :: forall e es i a. e :> es => (i e -> (a, i e)) -> Env es -> IO a
440− :: forall e adapter es a. e :> es
367+unsafeStateEnv f env = do
442− -> (adapter e -> (a, adapter e))
445− Location i es <- getLocation (reifyIndex @e @es) env
368+ (i, es) <- getLocation @e env
446 (a, e) <- f . fromAny <$> readSmallArray es i
369 (a, e) <- f . fromAny <$> readSmallArray es i
447 e `seq` writeSmallArray es i (toAny e)
370 e `seq` writeSmallArray es i (toAny e)
450−-- | Modify the data type in the environment (in place).
452− :: forall e adapter es. e :> es
454− -> (adapter e -> adapter e)
457− Location i es <- getLocation (reifyIndex @e @es) env
458− e <- f . fromAny <$> readSmallArray es i
459− e `seq` writeSmallArray es i (toAny e)
461----------------------------------------
373----------------------------------------
462-- Internal helpers
374-- Internal helpers
464−undefinedData :: HasCallStack => a
465−undefinedData = error "undefined data"
467emptyEnvRef :: IO (IORef EnvRef)
376emptyEnvRef :: IO (IORef EnvRef)
468emptyEnvRef = do
377emptyEnvRef = do
469− es <- newSmallArray 0 undefinedData
378+ es <- newSmallArray 0 (error "undefined field")
470− fs <- newSmallArray 0 undefinedData
379+ fs <- newSmallArray 0 (error "undefined field")
471 newIORef $ EnvRef 0 es fs
380 newIORef $ EnvRef 0 es fs
473−-- | Location with unboxed fields to make GHC generate Core without unnecessary
474−-- reboxing around the local 'go' function from 'getLocation'.
475−data Location = Location !Int !(SmallMutableArray RealWorld Any)
477-- | Determine location of the data type in the environment.
382-- | Determine location of the data type in the environment.
478getLocation
383getLocation
479− :: Int
384+ :: forall e es. e :> es
480− -> Env es
385+ => Env es
481− -> IO Location
386+ -> IO (Int, SmallMutableArray RealWorld Any)
482−getLocation ixE (Env fork ref _) = do
387+getLocation (Env fork ref _) = do
483− EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
388+ EnvRef n es _ <- readIORef ref
484 -- Optimized for the common access pattern:
389 -- Optimized for the common access pattern:
486 -- - Most application code has no access to forks, in which case we look at
391 -- - Most application code has no access to forks, in which case we look at
487 -- the global EnvRef.
392 -- the global EnvRef.
489− -- - Effect handlers will most likely access the newest fork with handler
394+ -- - Interpreters will most likely access the newest fork for reinterpretation
490− -- specific effects for reinterpretation.
395+ -- of effects that are there.
491 case fork of
396 case fork of
492− NoFork -> pure $ Location (ix n) es
397+ NoFork -> pure (ix n, es)
493 Forks _ baseIx lref forks -> do
398 Forks _ baseIx lref forks -> do
494 EnvRef ln les _ <- readIORef lref
399 EnvRef ln les _ <- readIORef lref
495 let i = ix (baseIx + ln)
400 let i = ix (baseIx + ln)
496 if i >= baseIx
401 if i >= baseIx
497− then pure $ Location (i - baseIx) les
402+ then pure (i - baseIx, les)
498− else go es# i forks
403+ else go es i forks
500− go :: SmallMutableArray# RealWorld Any
405+ go :: SmallMutableArray RealWorld Any
503− -> IO Location
408+ -> IO (Int, SmallMutableArray RealWorld Any)
504− go es# i = \case
409+ go es i = \case
505− NoFork -> pure $ Location i (SmallMutableArray es#)
410+ NoFork -> pure (i, es)
506 Forks _ baseIx lref forks -> do
411 Forks _ baseIx lref forks -> do
507 EnvRef _ les _ <- readIORef lref
412 EnvRef _ les _ <- readIORef lref
508 if i >= baseIx
413 if i >= baseIx
509− then pure $ Location (i - baseIx) les
414+ then pure (i - baseIx, les)
510− else go es# i forks
415+ else go es i forks
512 ix :: Int -> Int
417 ix :: Int -> Int
513− ix n = n - ixE - 1
418+ ix n = n - reifyIndex @e @es - 1
419+{-# INLINE getLocation #-}
515toAny :: a -> Any
421toAny :: a -> Any
516toAny = unsafeCoerce
422toAny = unsafeCoerce