{-# OPTIONS_HADDOCK not-home #-}
-- | The enviroment for 'Effective.Internal.Monad.Eff'.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Effectful.Internal.Env
  ( Env

  -- * Safe operations
  , emptyEnv
  , cloneEnv
  , sizeEnv
  , takeLastEnv
  , getEnv
  , checkSizeEnv

  -- * Extending and shrinking
  , unsafeReplaceEnv
  , unsafeConsEnv
  , unsafeAppendEnv
  , unsafeTrimEnv

  -- * Data retrieval and update
  , unsafePutEnv
  , unsafeModifyEnv
  , unsafeStateEnv
  ) where

import Control.Monad
import Control.Monad.Primitive
import Data.IORef
import Data.Primitive.SmallArray
import GHC.Exts (Any)
import GHC.Stack
import Unsafe.Coerce

import Effectful.Internal.Has

type role Env nominal

-- | A mutable, extensible record indexed by effect data types.
newtype Env (es :: [Effect]) = Env (IORef EnvRef)

data EnvRef = EnvRef Int (SmallMutableArray RealWorld Any)

-- | Create an empty environment.
emptyEnv :: IO (Env '[])
emptyEnv :: IO (Env '[])
emptyEnv = (IORef EnvRef -> Env '[]) -> IO (IORef EnvRef) -> IO (Env '[])
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
fmap IORef EnvRef -> Env '[]
forall (es :: [Effect]). IORef EnvRef -> Env es
Env (IO (IORef EnvRef) -> IO (Env '[]))
-> (SmallMutableArray RealWorld Any -> IO (IORef EnvRef))
-> SmallMutableArray RealWorld Any
-> IO (Env '[])
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. EnvRef -> IO (IORef EnvRef)
forall (a :: Effect). a -> IO (IORef a)
newIORef (EnvRef -> IO (IORef EnvRef))
-> (SmallMutableArray RealWorld Any -> EnvRef)
-> SmallMutableArray RealWorld Any
-> IO (IORef EnvRef)
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef Int
0
  (SmallMutableArray RealWorld Any -> IO (Env '[]))
-> IO (SmallMutableArray RealWorld Any) -> IO (Env '[])
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
(a -> m b) -> m a -> m b
=<< Int -> Any -> IO (SmallMutableArray (PrimState IO) Any)
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
0 ([Char] -> Any
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined field")

-- | Clone the environment.
cloneEnv :: Env es -> IO (Env es)
cloneEnv :: Env es -> IO (Env es)
cloneEnv (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  (IORef EnvRef -> Env es) -> IO (IORef EnvRef) -> IO (Env es)
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
fmap IORef EnvRef -> Env es
forall (es :: [Effect]). IORef EnvRef -> Env es
Env (IO (IORef EnvRef) -> IO (Env es))
-> (SmallMutableArray RealWorld Any -> IO (IORef EnvRef))
-> SmallMutableArray RealWorld Any
-> IO (Env es)
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. EnvRef -> IO (IORef EnvRef)
forall (a :: Effect). a -> IO (IORef a)
newIORef (EnvRef -> IO (IORef EnvRef))
-> (SmallMutableArray RealWorld Any -> EnvRef)
-> SmallMutableArray RealWorld Any
-> IO (IORef EnvRef)
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef Int
n
    (SmallMutableArray RealWorld Any -> IO (Env es))
-> IO (SmallMutableArray RealWorld Any) -> IO (Env es)
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
(a -> m b) -> m a -> m b
=<< SmallMutableArray (PrimState IO) Any
-> Int -> Int -> IO (SmallMutableArray (PrimState IO) Any)
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
0 (SmallMutableArray RealWorld Any -> Int
forall (s :: Effect) (a :: Effect). SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray RealWorld Any
es)

-- | Get the current size of the environment.
sizeEnv :: Env es -> IO Int
sizeEnv :: Env es -> IO Int
sizeEnv (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
_ <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  Int -> IO Int
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure Int
n

-- | Take last @k@ values from the top of the environment.
takeLastEnv :: HasCallStack => Int -> Env es0 -> IO (Env es)
takeLastEnv :: Int -> Env es0 -> IO (Env es)
takeLastEnv Int
k (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  if Int
k Int -> Int -> Bool
forall (a :: Effect). Ord a => a -> a -> Bool
> Int
n
    then [Char] -> IO (Env es)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Env es)) -> [Char] -> IO (Env es)
forall (a :: Effect) b. (a -> b) -> a -> b
$ [Char]
"k (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
k [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
") > n (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
")"
    else (IORef EnvRef -> Env es) -> IO (IORef EnvRef) -> IO (Env es)
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
fmap IORef EnvRef -> Env es
forall (es :: [Effect]). IORef EnvRef -> Env es
Env (IO (IORef EnvRef) -> IO (Env es))
-> (SmallMutableArray RealWorld Any -> IO (IORef EnvRef))
-> SmallMutableArray RealWorld Any
-> IO (Env es)
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. EnvRef -> IO (IORef EnvRef)
forall (a :: Effect). a -> IO (IORef a)
newIORef (EnvRef -> IO (IORef EnvRef))
-> (SmallMutableArray RealWorld Any -> EnvRef)
-> SmallMutableArray RealWorld Any
-> IO (IORef EnvRef)
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef Int
k (SmallMutableArray RealWorld Any -> IO (Env es))
-> IO (SmallMutableArray RealWorld Any) -> IO (Env es)
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
(a -> m b) -> m a -> m b
=<< SmallMutableArray (PrimState IO) Any
-> Int -> Int -> IO (SmallMutableArray (PrimState IO) Any)
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es (Int
n Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
- Int
k) Int
k

-- | Extract a specific data type from the environment.
getEnv :: forall e es. (HasCallStack, e :> es) => Env es -> IO e
getEnv :: Env es -> IO e
getEnv (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  Any -> e
forall (a :: Effect). Any -> a
fromAny (Any -> e) -> IO Any -> IO e
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
<$> SmallMutableArray (PrimState IO) Any -> Int -> IO Any
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es (Int -> Int
forall (e :: Effect) (es :: [Effect]). (e :> es) => Int -> Int
ixEnv @e @es Int
n)

-- | Check that the size of the environment is the same as the expected value.
checkSizeEnv :: HasCallStack => Int -> Env es -> IO ()
checkSizeEnv :: Int -> Env es -> IO ()
checkSizeEnv Int
k (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
_ <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  Bool -> IO () -> IO ()
forall (f :: Effect -> Effect).
Applicative f =>
Bool -> f () -> f ()
when (Int
k Int -> Int -> Bool
forall (a :: Effect). Eq a => a -> a -> Bool
/= Int
n) (IO () -> IO ()) -> ([Char] -> IO ()) -> [Char] -> IO ()
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall (a :: Effect) b. (a -> b) -> a -> b
$ [Char]
"k (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
k [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
") /= n (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
")"

----------------------------------------
-- Extending and shrinking

-- | Replace the first argument with the second one in place.
unsafeReplaceEnv :: HasCallStack => Env es -> Env es -> IO ()
unsafeReplaceEnv :: Env es -> Env es -> IO ()
unsafeReplaceEnv (Env IORef EnvRef
ref0) (Env IORef EnvRef
ref1) = IORef EnvRef -> EnvRef -> IO ()
forall (a :: Effect). IORef a -> a -> IO ()
writeIORef IORef EnvRef
ref0 (EnvRef -> IO ()) -> IO EnvRef -> IO ()
forall (m :: Effect -> Effect) (a :: Effect) (b :: Effect).
Monad m =>
(a -> m b) -> m a -> m b
=<< IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref1

-- | Extend the environment with a new data type in place.
unsafeConsEnv :: HasCallStack => e -> Env es -> IO (Env (e : es))
unsafeConsEnv :: e -> Env es -> IO (Env (e : es))
unsafeConsEnv e
e (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es0 <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  let len0 :: Int
len0 = SmallMutableArray RealWorld Any -> Int
forall (s :: Effect) (a :: Effect). SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray RealWorld Any
es0
  case Int
n Int -> Int -> Ordering
forall (a :: Effect). Ord a => a -> a -> Ordering
`compare` Int
len0 of
    Ordering
GT -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall (a :: Effect) b. (a -> b) -> a -> b
$ [Char]
"n (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
") > len0 (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
len0 [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
")"
    Ordering
LT -> do
      e
e e -> IO () -> IO ()
`seq` SmallMutableArray (PrimState IO) Any -> Int -> Any -> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es0 Int
n (e -> Any
forall (a :: Effect). a -> Any
toAny e
e)
      IORef EnvRef -> EnvRef -> IO ()
forall (a :: Effect). IORef a -> a -> IO ()
writeIORef IORef EnvRef
ref (EnvRef -> IO ()) -> EnvRef -> IO ()
forall (a :: Effect) b. (a -> b) -> a -> b
$! Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef (Int
n Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
+ Int
1) SmallMutableArray RealWorld Any
es0
    Ordering
EQ -> do
      let len :: Int
len = Int -> Int
doubleCapacity Int
len0
      SmallMutableArray RealWorld Any
es <- Int -> Any -> IO (SmallMutableArray (PrimState IO) Any)
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
len ([Char] -> Any
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined field")
      SmallMutableArray (PrimState IO) Any
-> Int
-> SmallMutableArray (PrimState IO) Any
-> Int
-> Int
-> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
0 SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es0 Int
0 Int
len0
      e
e e -> IO () -> IO ()
`seq` SmallMutableArray (PrimState IO) Any -> Int -> Any -> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
n (e -> Any
forall (a :: Effect). a -> Any
toAny e
e)
      IORef EnvRef -> EnvRef -> IO ()
forall (a :: Effect). IORef a -> a -> IO ()
writeIORef IORef EnvRef
ref (EnvRef -> IO ()) -> EnvRef -> IO ()
forall (a :: Effect) b. (a -> b) -> a -> b
$! Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef (Int
n Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
+ Int
1) SmallMutableArray RealWorld Any
es
  Env (e : es) -> IO (Env (e : es))
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure (Env (e : es) -> IO (Env (e : es)))
-> Env (e : es) -> IO (Env (e : es))
forall (a :: Effect) b. (a -> b) -> a -> b
$ IORef EnvRef -> Env (e : es)
forall (es :: [Effect]). IORef EnvRef -> Env es
Env IORef EnvRef
ref
{-# NOINLINE unsafeConsEnv #-}

-- | Extend the first environment with the second one in place.
unsafeAppendEnv :: HasCallStack => Env es0 -> Env es1 -> IO (Env es)
unsafeAppendEnv :: Env es0 -> Env es1 -> IO (Env es)
unsafeAppendEnv (Env IORef EnvRef
ref0) (Env IORef EnvRef
ref1) = do
  EnvRef Int
n0 SmallMutableArray RealWorld Any
es0 <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref0
  EnvRef Int
n1 SmallMutableArray RealWorld Any
es1 <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref1
  let n :: Int
n = Int
n0 Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
+ Int
n1
  if Int
n Int -> Int -> Bool
forall (a :: Effect). Ord a => a -> a -> Bool
<= SmallMutableArray RealWorld Any -> Int
forall (s :: Effect) (a :: Effect). SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray RealWorld Any
es0
    then do
      SmallMutableArray (PrimState IO) Any
-> Int
-> SmallMutableArray (PrimState IO) Any
-> Int
-> Int
-> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es0 Int
n0 SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es1 Int
0 Int
n1
      IORef EnvRef -> EnvRef -> IO ()
forall (a :: Effect). IORef a -> a -> IO ()
writeIORef IORef EnvRef
ref0 (EnvRef -> IO ()) -> EnvRef -> IO ()
forall (a :: Effect) b. (a -> b) -> a -> b
$! Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef Int
n SmallMutableArray RealWorld Any
es0
      Env es -> IO (Env es)
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure (Env es -> IO (Env es)) -> Env es -> IO (Env es)
forall (a :: Effect) b. (a -> b) -> a -> b
$ IORef EnvRef -> Env es
forall (es :: [Effect]). IORef EnvRef -> Env es
Env IORef EnvRef
ref0
    else do
      SmallMutableArray RealWorld Any
es <- Int -> Any -> IO (SmallMutableArray (PrimState IO) Any)
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n ([Char] -> Any
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined field")
      SmallMutableArray (PrimState IO) Any
-> Int
-> SmallMutableArray (PrimState IO) Any
-> Int
-> Int
-> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
0  SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es0 Int
0 Int
n0
      SmallMutableArray (PrimState IO) Any
-> Int
-> SmallMutableArray (PrimState IO) Any
-> Int
-> Int
-> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
n0 SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es1 Int
0 Int
n1
      IORef EnvRef -> EnvRef -> IO ()
forall (a :: Effect). IORef a -> a -> IO ()
writeIORef IORef EnvRef
ref0 (EnvRef -> IO ()) -> EnvRef -> IO ()
forall (a :: Effect) b. (a -> b) -> a -> b
$! Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef Int
n SmallMutableArray RealWorld Any
es
      Env es -> IO (Env es)
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure (Env es -> IO (Env es)) -> Env es -> IO (Env es)
forall (a :: Effect) b. (a -> b) -> a -> b
$ IORef EnvRef -> Env es
forall (es :: [Effect]). IORef EnvRef -> Env es
Env IORef EnvRef
ref0
{-# NOINLINE unsafeAppendEnv #-}

-- | Trim the environment to the given size in place.
unsafeTrimEnv :: HasCallStack => Int -> Env es -> IO (Env es0)
unsafeTrimEnv :: Int -> Env es -> IO (Env es0)
unsafeTrimEnv Int
k (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  if Int
k Int -> Int -> Bool
forall (a :: Effect). Ord a => a -> a -> Bool
> Int
n
    then [Char] -> IO (Env es0)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Env es0)) -> [Char] -> IO (Env es0)
forall (a :: Effect) b. (a -> b) -> a -> b
$ [Char]
"k (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
k [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
") > n (" [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ Int -> [Char]
forall (a :: Effect). Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall (a :: Effect). [a] -> [a] -> [a]
++ [Char]
")"
    else do
      SmallMutableArray (PrimState IO) Any -> Int -> Int -> IO ()
forall (f :: Effect -> Effect) (a :: Effect).
PrimMonad f =>
SmallMutableArray (PrimState f) a -> Int -> Int -> f ()
overwrite SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
k (Int
n Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
- Int
k)
      IORef EnvRef -> EnvRef -> IO ()
forall (a :: Effect). IORef a -> a -> IO ()
writeIORef IORef EnvRef
ref (EnvRef -> IO ()) -> EnvRef -> IO ()
forall (a :: Effect) b. (a -> b) -> a -> b
$! Int -> SmallMutableArray RealWorld Any -> EnvRef
EnvRef Int
k SmallMutableArray RealWorld Any
es
      Env es0 -> IO (Env es0)
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure (Env es0 -> IO (Env es0)) -> Env es0 -> IO (Env es0)
forall (a :: Effect) b. (a -> b) -> a -> b
$ IORef EnvRef -> Env es0
forall (es :: [Effect]). IORef EnvRef -> Env es
Env IORef EnvRef
ref
  where
    overwrite :: SmallMutableArray (PrimState f) a -> Int -> Int -> f ()
overwrite SmallMutableArray (PrimState f) a
es Int
base = \case
      Int
0 -> () -> f ()
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure ()
      Int
i -> do
        SmallMutableArray (PrimState f) a -> Int -> a -> f ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState f) a
es (Int
base Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
- Int
1) ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"undefined field")
        SmallMutableArray (PrimState f) a -> Int -> Int -> f ()
overwrite SmallMutableArray (PrimState f) a
es Int
base (Int
i Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
- Int
1)
{-# NOINLINE unsafeTrimEnv #-}

----------------------------------------
-- Data retrieval and update

-- | Replace the data type in the environment with a new value in place.
unsafePutEnv
  :: forall e es. (HasCallStack, e :> es)
  => e
  -> Env es
  -> IO ()
unsafePutEnv :: e -> Env es -> IO ()
unsafePutEnv e
e (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  e
e e -> IO () -> IO ()
`seq` SmallMutableArray (PrimState IO) Any -> Int -> Any -> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es (Int -> Int
forall (e :: Effect) (es :: [Effect]). (e :> es) => Int -> Int
ixEnv @e @es Int
n) (e -> Any
forall (a :: Effect). a -> Any
toAny e
e)

-- | Modify the data type in the environment in place.
unsafeModifyEnv
  :: forall e es. (HasCallStack, e :> es)
  => (e -> e)
  -> Env es
  -> IO ()
unsafeModifyEnv :: (e -> e) -> Env es -> IO ()
unsafeModifyEnv e -> e
f (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  let i :: Int
i = Int -> Int
forall (e :: Effect) (es :: [Effect]). (e :> es) => Int -> Int
ixEnv @e @es Int
n
  e
e <- e -> e
f (e -> e) -> (Any -> e) -> Any -> e
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. Any -> e
forall (a :: Effect). Any -> a
fromAny (Any -> e) -> IO Any -> IO e
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
<$> SmallMutableArray (PrimState IO) Any -> Int -> IO Any
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
i
  e
e e -> IO () -> IO ()
`seq` SmallMutableArray (PrimState IO) Any -> Int -> Any -> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
i (e -> Any
forall (a :: Effect). a -> Any
toAny e
e)

-- | Modify the data type in the enviroment in place and return a value.
unsafeStateEnv
  :: forall e es a. (HasCallStack, e :> es)
  => (e -> (a, e))
  -> Env es -> IO a
unsafeStateEnv :: (e -> (a, e)) -> Env es -> IO a
unsafeStateEnv e -> (a, e)
f (Env IORef EnvRef
ref) = do
  EnvRef Int
n SmallMutableArray RealWorld Any
es <- IORef EnvRef -> IO EnvRef
forall (a :: Effect). IORef a -> IO a
readIORef IORef EnvRef
ref
  let i :: Int
i = Int -> Int
forall (e :: Effect) (es :: [Effect]). (e :> es) => Int -> Int
ixEnv @e @es Int
n
  (a
a, e
e) <- e -> (a, e)
f (e -> (a, e)) -> (Any -> e) -> Any -> (a, e)
forall (b :: Effect) (c :: Effect) (a :: Effect).
(b -> c) -> (a -> b) -> a -> c
. Any -> e
forall (a :: Effect). Any -> a
fromAny (Any -> (a, e)) -> IO Any -> IO (a, e)
forall (f :: Effect -> Effect) (a :: Effect) (b :: Effect).
Functor f =>
(a -> b) -> f a -> f b
<$> SmallMutableArray (PrimState IO) Any -> Int -> IO Any
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
i
  e
e e -> IO () -> IO ()
`seq` SmallMutableArray (PrimState IO) Any -> Int -> Any -> IO ()
forall (m :: Effect -> Effect) (a :: Effect).
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray RealWorld Any
SmallMutableArray (PrimState IO) Any
es Int
i (e -> Any
forall (a :: Effect). a -> Any
toAny e
e)
  a -> IO a
forall (f :: Effect -> Effect) (a :: Effect).
Applicative f =>
a -> f a
pure a
a

----------------------------------------
-- Internal helpers

doubleCapacity :: Int -> Int
doubleCapacity :: Int -> Int
doubleCapacity Int
n = Int -> Int -> Int
forall (a :: Effect). Ord a => a -> a -> a
max Int
1 Int
n Int -> Int -> Int
forall (a :: Effect). Num a => a -> a -> a
* Int
2

toAny :: a -> Any
toAny :: a -> Any
toAny = a -> Any
forall (a :: Effect) (b :: Effect). a -> b
unsafeCoerce

fromAny :: Any -> a
fromAny :: Any -> a
fromAny = Any -> a
forall (a :: Effect) (b :: Effect). a -> b
unsafeCoerce