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