@@ -1,52 +1,40 @@
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 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
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
@@ -56,7 +44,7 @@ type role Env nominal
56-- of kind 'Effect'.
44-- of kind 'Effect'.
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:
@@ -81,17 +69,17 @@ type role Env nominal
83-- The point of execution is currently at (*), i.e. the mainline. Moreover,
71-- The point of execution is currently at (*), i.e. the mainline. Moreover,
84−-- currently (brackets represent forks):
72+-- currently:
86-- - Mainline sees @[e00, e01, e05, e07]@.
74-- - Mainline sees @[e00, e01, e05, e07]@.
88−-- - @e01@ is an interpreted effect, its handler sees @[e00][e02, e03]@.
76+-- - @e01@ is an interpreted effect, its handler sees @[e00, e02, e03]@.
90−-- - @e03@ is an interpreted effect, its handler sees @[e00][e02][e04]@.
78+-- - @e03@ is an interpreted effect, its handler sees @[e00, e02, e04]@.
92−-- - @e05@ is an interpreted effect, its handler sees @[e00, e01][e06]@.
80+-- - @e05@ is an interpreted effect, its handler sees @[e00, e01, e06]@.
94−-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05][e08,
82+-- - @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
85-- If an operation from @e01@ is invoked, the environment in the middle of
@@ -114,42 +102,45 @@ type role Env nominal
114-- introduced @e12@), so its local environment was temporarily extended with
102-- introduced @e12@), so its local environment was temporarily extended with
115-- it. Moreover, currently:
103-- it. Moreover, currently:
117−-- - Handler of @e01@ sees @[e00][e02, e03, e10]@.
105+-- - Handler of @e01@ sees @[e00, e02, e03, e10]@.
119−-- - Handler of @e10@ sees @[e00][e02, e03][e11]@.
107+-- - Handler of @e10@ sees @[e00, e02, e03, e11]@.
121−-- - Handler of @e11@ sees @[e00][e02, e03][e12]@.
109+-- - Handler of @e11@ sees @[e00, e02, e03, e12]@.
123data Env (es :: [Effect]) = Env
111data Env (es :: [Effect]) = Env
124− { _forks :: !Forks
112+ { _forks :: Forks
125− , _globalRef :: !(IORef EnvRef)
113+ , _globalRef :: IORef EnvRef
126− , _forkIdGen :: !ForkIdGen
114+ , _forkIdGen :: ForkIdGen
129-- | Local forks of the environment.
117-- | Local forks of the environment.
130−data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork
118+data Forks = Forks ForkId Int (IORef EnvRef) Forks | NoFork
132−-- | Data held in the environment.
133data EnvRef = EnvRef
120data EnvRef = EnvRef
134− { _size :: !Int
121+ { _size :: Int
135− , _data :: !(SmallMutableArray RealWorld Any)
122+ , _data :: SmallMutableArray RealWorld Any
136− , _relinkers :: !(SmallMutableArray RealWorld Any)
123+ , _relinkers :: SmallMutableArray RealWorld Any
139----------------------------------------
126----------------------------------------
142−-- | Internal id of the fork.
129+newtype ForkId = ForkId Word64
143−newtype ForkId = ForkId { unForkId :: Int }
130+ deriving (Eq, Ord, Show)
132+-- | Implicit 'ForkId' of the 'EnvRef' directly available from 'Env'.
145-- | 'ForkId' generation.
136-- | 'ForkId' generation.
146newtype ForkIdGen = ForkIdGen (IORef ForkId)
137newtype ForkIdGen = ForkIdGen (IORef ForkId)
148−-- | Create a new thread local 'ForkId' generator.
139+-- | Create a new thread local unique generator.
149newForkIdGen :: IO ForkIdGen
140newForkIdGen :: IO ForkIdGen
150−newForkIdGen = ForkIdGen <$> newIORef (ForkId 0)
141+newForkIdGen = ForkIdGen <$> newIORef (ForkId 1)
152−-- | Clone the 'ForkId' generator for use in a different thread.
143+-- | Clone the unique generator for use in a different thread.
153cloneForkIdGen :: ForkIdGen -> IO ForkIdGen
144cloneForkIdGen :: ForkIdGen -> IO ForkIdGen
154cloneForkIdGen (ForkIdGen ref) = fmap ForkIdGen . newIORef =<< readIORef ref
145cloneForkIdGen (ForkIdGen ref) = fmap ForkIdGen . newIORef =<< readIORef ref
@@ -163,15 +154,12 @@ newForkId (ForkIdGen ref) = do
163----------------------------------------
154----------------------------------------
164-- Relinker
155-- Relinker
166−-- | A function for relinking 'Env' objects stored in the handlers when cloning
168−newtype Relinker :: (Effect -> Type) -> Effect -> Type where
157+newtype Relinker i (e :: Effect) where
170− :: ((forall es. Env es -> IO (Env es)) -> adapter e -> IO (adapter e))
159+ :: ((forall es. Env es -> IO (Env es)) -> i e -> IO (i e))
171− -> Relinker adapter e
160+ -> Relinker i e
173−-- | A dummy 'Relinker' that does nothing.
174−noRelinker :: Relinker adapter e
162+noRelinker :: Relinker i e
175noRelinker = Relinker $ \_ -> pure
163noRelinker = Relinker $ \_ -> pure
177----------------------------------------
165----------------------------------------
@@ -184,27 +172,23 @@ emptyEnv = Env NoFork <$> emptyEnvRef <*> newForkIdGen
184-- | Clone the environment.
172-- | Clone the environment.
185cloneEnv :: Env es -> IO (Env es)
173cloneEnv :: Env es -> IO (Env es)
186cloneEnv (Env NoFork gref0 gen0) = do
174cloneEnv (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
175 gen <- cloneForkIdGen gen0
191− gref <- newIORef $ EnvRef n es fs
192− store <- newIORef IM.empty
176+ cache <- newIORef M.empty
193− relinkData gref gen store es fs n
177+ gref <- cloneEnvRef gen cache globalFid gref0
194 pure $ Env NoFork gref gen
178 pure $ Env NoFork gref gen
195cloneEnv (Env forks@(Forks _ baseIx lref0 _) gref0 gen0) = do
179cloneEnv (Env forks@(Forks _ baseIx lref0 _) gref0 gen0) = do
196 EnvRef _ es0 fs0 <- readIORef gref0
180 EnvRef _ es0 fs0 <- readIORef gref0
197 EnvRef n _ _ <- readIORef lref0
181 EnvRef n _ _ <- readIORef lref0
198 let len = baseIx + n
182 let len = baseIx + n
199− es <- newSmallArray len undefinedData
183+ es <- newSmallArray len (error "undefined field")
200− fs <- newSmallArray len undefinedData
184+ fs <- newSmallArray len (error "undefined field")
201 baseN <- copyForks es fs len forks
185 baseN <- copyForks es fs len forks
202 copySmallMutableArray es 0 es0 0 baseN
186 copySmallMutableArray es 0 es0 0 baseN
203 copySmallMutableArray fs 0 fs0 0 baseN
187 copySmallMutableArray fs 0 fs0 0 baseN
204 gen <- cloneForkIdGen gen0
188 gen <- cloneForkIdGen gen0
205 gref <- newIORef $ EnvRef len es fs
189 gref <- newIORef $ EnvRef len es fs
206− store <- newIORef IM.empty
190+ cache <- newIORef $ M.singleton globalFid gref
207− relinkData gref gen store es fs n
191+ relinkData gen cache es fs n
208 -- The forked environment is flattened and becomes the global one.
192 -- The forked environment is flattened and becomes the global one.
209 pure $ Env NoFork gref gen
193 pure $ Env NoFork gref gen
210{-# NOINLINE cloneEnv #-}
194{-# NOINLINE cloneEnv #-}
@@ -254,18 +238,33 @@ copyForks es fs len = \case
254 copySmallMutableArray fs baseIx fs0 0 n
238 copySmallMutableArray fs baseIx fs0 0 n
255 copyForks es fs baseIx forks
239 copyForks es fs baseIx forks
257−type EnvRefStore = IORef (IM.IntMap (IORef EnvRef))
241+type EnvRefCache = IORef (M.Map ForkId (IORef EnvRef))
243+-- | Clone the 'EnvRef' and put it in a cache.
249+ -> IO (IORef EnvRef)
250+cloneEnvRef gen cache fid ref0 = do
251+ EnvRef n es0 fs0 <- readIORef ref0
252+ es <- cloneSmallMutableArray es0 0 (sizeofSmallMutableArray es0)
253+ fs <- cloneSmallMutableArray fs0 0 (sizeofSmallMutableArray fs0)
254+ ref <- newIORef $ EnvRef n es fs
255+ modifyIORef' cache $ M.insert fid ref
256+ relinkData gen cache es fs n
259−-- | Relink local environments hiding in the handlers.
259+-- | Relink local environments hiding in the interpreters.
260relinkData
260relinkData
262− -> ForkIdGen
261+ :: ForkIdGen
263− -> EnvRefStore
262+ -> EnvRefCache
264 -> SmallMutableArray RealWorld Any
263 -> SmallMutableArray RealWorld Any
265 -> SmallMutableArray RealWorld Any
264 -> SmallMutableArray RealWorld Any
268−relinkData gref gen store es fs = \case
267+relinkData gen cache es fs = \case
269 0 -> pure ()
268 0 -> pure ()
271 let i = n - 1
270 let i = n - 1
@@ -273,46 +272,29 @@ relinkData gref gen store es fs = \case
273 readSmallArray es i
272 readSmallArray es i
274 >>= f relinkEnv . fromAny
273 >>= f relinkEnv . fromAny
275 >>= writeSmallArray es i . toAny
274 >>= writeSmallArray es i . toAny
276− relinkData gref gen store es fs i
275+ relinkData gen cache es fs i
278 relinkEnv :: Env es -> IO (Env es)
277 relinkEnv :: Env es -> IO (Env es)
279− relinkEnv (Env forks _ _) = Env <$> relinkForks gref gen store forks
278+ relinkEnv (Env forks _ _) = do
280− <*> pure gref
279+ Just gref <- M.lookup globalFid <$> readIORef cache
281− <*> pure gen
280+ Env <$> relinkForks gen cache forks <*> pure gref <*> pure gen
283−relinkForks :: IORef EnvRef -> ForkIdGen -> EnvRefStore -> Forks -> IO Forks
282+relinkForks :: ForkIdGen -> EnvRefCache -> Forks -> IO Forks
284−relinkForks gref gen store = \case
283+relinkForks gen cache = \case
285 NoFork -> pure NoFork
284 NoFork -> pure NoFork
286 Forks fid baseIx lref0 forks -> do
285 Forks fid baseIx lref0 forks -> do
287 -- A specific IORef EnvRef can be held by more than one local environment
286 -- 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
287 -- and we need to replace all its occurences with the same, new value
289 -- containing its clone.
288 -- containing its clone.
290− readIORef store >>= pure . IM.lookup (unForkId fid) >>= \case
289+ readIORef cache >>= pure . M.lookup fid >>= \case
291 Just lref -> Forks fid baseIx <$> pure lref
290 Just lref -> Forks fid baseIx <$> pure lref
292− <*> relinkForks gref gen store forks
291+ <*> relinkForks gen cache forks
293− Nothing -> Forks fid baseIx <$> cloneEnvRef gref gen store fid lref0
292+ Nothing -> Forks fid baseIx <$> cloneEnvRef gen cache fid lref0
294− <*> relinkForks gref gen store forks
293+ <*> 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----------------------------------------
295----------------------------------------
315−-- | Create a local fork of the environment for handlers.
297+-- | Create a local fork of the environment for interpreters.
316forkEnv :: Env es -> IO (Env es)
298forkEnv :: Env es -> IO (Env es)
317forkEnv env@(Env NoFork gref gen) = do
299forkEnv env@(Env NoFork gref gen) = do
318 size <- sizeEnv env
300 size <- sizeEnv env
@@ -338,6 +320,12 @@ sizeEnv (Env (Forks _ baseIx lref _) _ _) = do
338 pure $ baseIx + n
320 pure $ baseIx + n
339{-# NOINLINE sizeEnv #-}
321{-# NOINLINE sizeEnv #-}
323+-- | Extract a specific data type from the environment.
324+getEnv :: forall e es i. e :> es => Env es -> IO (i e)
326+ (i, es) <- getLocation @e env
327+ fromAny <$> readSmallArray es i
341-- | Check that the size of the environment is the same as the expected value.
329-- | Check that the size of the environment is the same as the expected value.
342checkSizeEnv :: Int -> Env es -> IO ()
330checkSizeEnv :: Int -> Env es -> IO ()
343checkSizeEnv k (Env NoFork ref _) = do
331checkSizeEnv k (Env NoFork ref _) = do
@@ -355,11 +343,7 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do
355-- Extending and shrinking
343-- Extending and shrinking
357-- | Extend the environment with a new data type (in place).
345-- | 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))
346+unsafeConsEnv :: i e -> Relinker i e -> Env es -> IO (Env (e : es))
363unsafeConsEnv e f (Env fork gref gen) = case fork of
347unsafeConsEnv e f (Env fork gref gen) = case fork of
364 NoFork -> do
348 NoFork -> do
365 extendEnvRef gref
349 extendEnvRef gref
@@ -380,10 +364,10 @@ unsafeConsEnv e f (Env fork gref gen) = case fork of
380 writeIORef ref $! EnvRef (n + 1) es0 fs0
364 writeIORef ref $! EnvRef (n + 1) es0 fs0
382 let len = doubleCapacity len0
366 let len = doubleCapacity len0
383− es <- newSmallArray len undefinedData
367+ es <- newSmallArray len (error "undefined field")
384 copySmallMutableArray es 0 es0 0 len0
368 copySmallMutableArray es 0 es0 0 len0
385 e `seq` writeSmallArray es n (toAny e)
369 e `seq` writeSmallArray es n (toAny e)
386− fs <- newSmallArray len undefinedData
370+ fs <- newSmallArray len (error "undefined field")
387 copySmallMutableArray fs 0 fs0 0 len0
371 copySmallMutableArray fs 0 fs0 0 len0
388 f `seq` writeSmallArray fs n (toAny f)
372 f `seq` writeSmallArray fs n (toAny f)
389 writeIORef ref $! EnvRef (n + 1) es fs
373 writeIORef ref $! EnvRef (n + 1) es fs
@@ -394,13 +378,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
379-- | Shrink the environment by one data type (in place). Makes sure the size of
396-- the environment is as expected.
380-- 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 ()
381+unsafeTailEnv :: Int -> Env (e : es) -> IO (Env es)
401−unsafeTailEnv len (Env fork gref _) = case fork of
382+unsafeTailEnv len (Env fork gref gen) = case fork of
402− NoFork -> shrinkEnvRef len gref
384+ shrinkEnvRef len gref
385+ pure $ Env NoFork gref gen
386+ Forks _ baseIx lref _ -> do
403− Forks _ baseIx lref _ -> shrinkEnvRef (len - baseIx) lref
387+ shrinkEnvRef (len - baseIx) lref
388+ pure $ Env fork gref gen
405 shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
390 shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
406 shrinkEnvRef k ref = do
391 shrinkEnvRef k ref = do
@@ -408,109 +393,81 @@ unsafeTailEnv len (Env fork gref _) = case fork of
408 if k /= n - 1
393 if k /= n - 1
409 then error $ "k (" ++ show k ++ ") /= n - 1 (" ++ show (n - 1) ++ ")"
394 then error $ "k (" ++ show k ++ ") /= n - 1 (" ++ show (n - 1) ++ ")"
411− writeSmallArray es k undefinedData
396+ writeSmallArray es k (error "undefined field")
412− writeSmallArray fs k undefinedData
397+ writeSmallArray fs k (error "undefined field")
413 writeIORef ref $! EnvRef k es fs
398 writeIORef ref $! EnvRef k es fs
414{-# NOINLINE unsafeTailEnv #-}
399{-# NOINLINE unsafeTailEnv #-}
416----------------------------------------
401----------------------------------------
417-- Data retrieval and update
402-- 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).
404-- | Replace the data type in the environment with a new value (in place).
429−putEnv
405+unsafePutEnv :: forall e es i. e :> es => i e -> Env es -> IO ()
430− :: forall e adapter es. e :> es
406+unsafePutEnv e env = do
431− => Env es
407+ (i, es) <- getLocation @e env
432− -> adapter e
408+ e `seq` writeSmallArray es i (toAny e)
434−putEnv env e = do
410+-- | Modify the data type in the environment (in place).
411+unsafeModifyEnv :: forall e es i. e :> es => (i e -> i e) -> Env es -> IO ()
412+unsafeModifyEnv f env = do
435− Location i es <- getLocation (reifyIndex @e @es) env
413+ (i, es) <- getLocation @e env
414+ e <- f . fromAny <$> readSmallArray es i
436 e `seq` writeSmallArray es i (toAny e)
415 e `seq` writeSmallArray es i (toAny e)
438-- | Modify the data type in the environment (in place) and return a value.
417-- | Modify the data type in the environment (in place) and return a value.
439−stateEnv
418+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
419+unsafeStateEnv f env = do
442− -> (adapter e -> (a, adapter e))
445− Location i es <- getLocation (reifyIndex @e @es) env
420+ (i, es) <- getLocation @e env
446 (a, e) <- f . fromAny <$> readSmallArray es i
421 (a, e) <- f . fromAny <$> readSmallArray es i
447 e `seq` writeSmallArray es i (toAny e)
422 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----------------------------------------
425----------------------------------------
462-- Internal helpers
426-- Internal helpers
464−undefinedData :: HasCallStack => a
465−undefinedData = error "undefined data"
467emptyEnvRef :: IO (IORef EnvRef)
428emptyEnvRef :: IO (IORef EnvRef)
468emptyEnvRef = do
429emptyEnvRef = do
469− es <- newSmallArray 0 undefinedData
430+ es <- newSmallArray 0 (error "undefined field")
470− fs <- newSmallArray 0 undefinedData
431+ fs <- newSmallArray 0 (error "undefined field")
471 newIORef $ EnvRef 0 es fs
432 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.
434-- | Determine location of the data type in the environment.
478getLocation
435getLocation
479− :: Int
436+ :: forall e es. e :> es
480− -> Env es
437+ => Env es
481− -> IO Location
438+ -> IO (Int, SmallMutableArray RealWorld Any)
482−getLocation ixE (Env fork ref _) = do
439+getLocation (Env fork ref _) = do
483− EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
440+ EnvRef n es _ <- readIORef ref
484 -- Optimized for the common access pattern:
441 -- Optimized for the common access pattern:
486 -- - Most application code has no access to forks, in which case we look at
443 -- - Most application code has no access to forks, in which case we look at
487 -- the global EnvRef.
444 -- the global EnvRef.
489− -- - Effect handlers will most likely access the newest fork with handler
446+ -- - Interpreters will most likely access the newest fork for reinterpretation
490− -- specific effects for reinterpretation.
447+ -- of effects that are there.
491 case fork of
448 case fork of
492− NoFork -> pure $ Location (ix n) es
449+ NoFork -> pure (ix n, es)
493 Forks _ baseIx lref forks -> do
450 Forks _ baseIx lref forks -> do
494 EnvRef ln les _ <- readIORef lref
451 EnvRef ln les _ <- readIORef lref
495 let i = ix (baseIx + ln)
452 let i = ix (baseIx + ln)
496 if i >= baseIx
453 if i >= baseIx
497− then pure $ Location (i - baseIx) les
454+ then pure (i - baseIx, les)
498− else go es# i forks
455+ else go es i forks
500− go :: SmallMutableArray# RealWorld Any
457+ go :: SmallMutableArray RealWorld Any
503− -> IO Location
460+ -> IO (Int, SmallMutableArray RealWorld Any)
504− go es# i = \case
461+ go es i = \case
505− NoFork -> pure $ Location i (SmallMutableArray es#)
462+ NoFork -> pure (i, es)
506 Forks _ baseIx lref forks -> do
463 Forks _ baseIx lref forks -> do
507 EnvRef _ les _ <- readIORef lref
464 EnvRef _ les _ <- readIORef lref
508 if i >= baseIx
465 if i >= baseIx
509− then pure $ Location (i - baseIx) les
466+ then pure (i - baseIx, les)
510− else go es# i forks
467+ else go es i forks
512 ix :: Int -> Int
469 ix :: Int -> Int
513− ix n = n - ixE - 1
470+ ix n = n - reifyIndex @e @es - 1
515toAny :: a -> Any
472toAny :: a -> Any
516toAny = unsafeCoerce
473toAny = unsafeCoerce