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