{-# LANGUAGE CPP             #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_HADDOCK not-home #-}
module Database.LSMTree.Internal.Arena (
    ArenaManager,
    newArenaManager,
    Arena,
    Size,
    Offset,
    Alignment,
    withArena,
    newArena,
    closeArena,

    allocateFromArena,
    -- * Test helpers
    withUnmanagedArena,
) where

import           Control.DeepSeq (NFData (..))
import           Control.Exception (assert)
import           Control.Monad.Primitive
import           Control.Monad.ST (ST)
import           Data.Bits (complement, popCount, (.&.))
import           Data.Primitive.ByteArray
import           Data.Primitive.MutVar
import           Data.Primitive.MVar
import           Data.Primitive.PrimVar

#ifdef NO_IGNORE_ASSERTS
import           Data.Word (Word8)
#endif

data ArenaManager s = ArenaManager (MutVar s [Arena s])

newArenaManager :: PrimMonad m => m (ArenaManager (PrimState m))
newArenaManager :: forall (m :: * -> *). PrimMonad m => m (ArenaManager (PrimState m))
newArenaManager = do
    MutVar (PrimState m) [Arena (PrimState m)]
m <- [Arena (PrimState m)]
-> m (MutVar (PrimState m) [Arena (PrimState m)])
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar []
    ArenaManager (PrimState m) -> m (ArenaManager (PrimState m))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArenaManager (PrimState m) -> m (ArenaManager (PrimState m)))
-> ArenaManager (PrimState m) -> m (ArenaManager (PrimState m))
forall a b. (a -> b) -> a -> b
$ MutVar (PrimState m) [Arena (PrimState m)]
-> ArenaManager (PrimState m)
forall s. MutVar s [Arena s] -> ArenaManager s
ArenaManager MutVar (PrimState m) [Arena (PrimState m)]
m

-- | For use in bencmark environments
instance NFData (ArenaManager s) where
    rnf :: ArenaManager s -> ()
rnf (ArenaManager !MutVar s [Arena s]
_) = ()

data Arena s = Arena
    { forall s. Arena s -> MVar s (Block s)
curr :: !(MVar s (Block s))   -- current block, also acts as a lock
    , forall s. Arena s -> MutVar s [Block s]
free :: !(MutVar s [Block s])
    , forall s. Arena s -> MutVar s [Block s]
full :: !(MutVar s [Block s])
    }

data Block s = Block !(PrimVar s Int) !(MutableByteArray s)

instance NFData (Arena s) where
  rnf :: Arena s -> ()
rnf (Arena !MVar s (Block s)
_ !MutVar s [Block s]
_ !MutVar s [Block s]
_) = ()

type Size      = Int
type Offset    = Int
type Alignment = Int

blockSize :: Int
blockSize :: Int
blockSize = Int
0x100000

{-# SPECIALIZE
    newBlock :: ST s (Block s)
  #-}
{-# SPECIALIZE
    newBlock :: IO (Block RealWorld)
  #-}
newBlock :: PrimMonad m => m (Block (PrimState m))
newBlock :: forall (m :: * -> *). PrimMonad m => m (Block (PrimState m))
newBlock = do
    PrimVar (PrimState m) Int
off <- Int -> m (PrimVar (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0
    MutableByteArray (PrimState m)
mba <- Int -> Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> Int -> m (MutableByteArray (PrimState m))
newAlignedPinnedByteArray Int
blockSize Int
4096
    Block (PrimState m) -> m (Block (PrimState m))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimVar (PrimState m) Int
-> MutableByteArray (PrimState m) -> Block (PrimState m)
forall s. PrimVar s Int -> MutableByteArray s -> Block s
Block PrimVar (PrimState m) Int
off MutableByteArray (PrimState m)
mba)

{-# INLINE withArena #-}
withArena :: PrimMonad m => ArenaManager (PrimState m) -> (Arena (PrimState m) -> m a) -> m a
withArena :: forall (m :: * -> *) a.
PrimMonad m =>
ArenaManager (PrimState m) -> (Arena (PrimState m) -> m a) -> m a
withArena ArenaManager (PrimState m)
am Arena (PrimState m) -> m a
f = do
    Arena (PrimState m)
a <- ArenaManager (PrimState m) -> m (Arena (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
ArenaManager (PrimState m) -> m (Arena (PrimState m))
newArena ArenaManager (PrimState m)
am
    a
x <- Arena (PrimState m) -> m a
f Arena (PrimState m)
a
    ArenaManager (PrimState m) -> Arena (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
ArenaManager (PrimState m) -> Arena (PrimState m) -> m ()
closeArena ArenaManager (PrimState m)
am Arena (PrimState m)
a
    a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

{-# SPECIALIZE
    newArena :: ArenaManager s -> ST s (Arena s)
  #-}
{-# SPECIALIZE
    newArena :: ArenaManager RealWorld -> IO (Arena RealWorld)
  #-}
newArena :: PrimMonad m => ArenaManager (PrimState m) -> m (Arena (PrimState m))
newArena :: forall (m :: * -> *).
PrimMonad m =>
ArenaManager (PrimState m) -> m (Arena (PrimState m))
newArena (ArenaManager MutVar (PrimState m) [Arena (PrimState m)]
arenas) = do
    Maybe (Arena (PrimState m))
marena <- MutVar (PrimState m) [Arena (PrimState m)]
-> ([Arena (PrimState m)]
    -> ([Arena (PrimState m)], Maybe (Arena (PrimState m))))
-> m (Maybe (Arena (PrimState m)))
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' MutVar (PrimState m) [Arena (PrimState m)]
arenas (([Arena (PrimState m)]
  -> ([Arena (PrimState m)], Maybe (Arena (PrimState m))))
 -> m (Maybe (Arena (PrimState m))))
-> ([Arena (PrimState m)]
    -> ([Arena (PrimState m)], Maybe (Arena (PrimState m))))
-> m (Maybe (Arena (PrimState m)))
forall a b. (a -> b) -> a -> b
$ \case
        []     -> ([], Maybe (Arena (PrimState m))
forall a. Maybe a
Nothing)
        (Arena (PrimState m)
x:[Arena (PrimState m)]
xs) -> ([Arena (PrimState m)]
xs, Arena (PrimState m) -> Maybe (Arena (PrimState m))
forall a. a -> Maybe a
Just Arena (PrimState m)
x)

    case Maybe (Arena (PrimState m))
marena of
        Just Arena (PrimState m)
arena -> Arena (PrimState m) -> m (Arena (PrimState m))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Arena (PrimState m)
arena
        Maybe (Arena (PrimState m))
Nothing -> do
            MVar (PrimState m) (Block (PrimState m))
curr <- m (Block (PrimState m))
forall (m :: * -> *). PrimMonad m => m (Block (PrimState m))
newBlock m (Block (PrimState m))
-> (Block (PrimState m)
    -> m (MVar (PrimState m) (Block (PrimState m))))
-> m (MVar (PrimState m) (Block (PrimState m)))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Block (PrimState m) -> m (MVar (PrimState m) (Block (PrimState m)))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MVar (PrimState m) a)
newMVar
            MutVar (PrimState m) [Block (PrimState m)]
free <- [Block (PrimState m)]
-> m (MutVar (PrimState m) [Block (PrimState m)])
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar []
            MutVar (PrimState m) [Block (PrimState m)]
full <- [Block (PrimState m)]
-> m (MutVar (PrimState m) [Block (PrimState m)])
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar []
            Arena (PrimState m) -> m (Arena (PrimState m))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Arena {MVar (PrimState m) (Block (PrimState m))
MutVar (PrimState m) [Block (PrimState m)]
curr :: MVar (PrimState m) (Block (PrimState m))
free :: MutVar (PrimState m) [Block (PrimState m)]
full :: MutVar (PrimState m) [Block (PrimState m)]
curr :: MVar (PrimState m) (Block (PrimState m))
free :: MutVar (PrimState m) [Block (PrimState m)]
full :: MutVar (PrimState m) [Block (PrimState m)]
..}

{-# SPECIALIZE
    closeArena :: ArenaManager s -> Arena s -> ST s ()
  #-}
{-# SPECIALIZE
    closeArena :: ArenaManager RealWorld -> Arena RealWorld -> IO ()
  #-}
closeArena :: PrimMonad m => ArenaManager (PrimState m) -> Arena (PrimState m) -> m ()
closeArena :: forall (m :: * -> *).
PrimMonad m =>
ArenaManager (PrimState m) -> Arena (PrimState m) -> m ()
closeArena (ArenaManager MutVar (PrimState m) [Arena (PrimState m)]
arenas) Arena (PrimState m)
arena = do
    Arena (PrimState m) -> m ()
forall (m :: * -> *). PrimMonad m => Arena (PrimState m) -> m ()
scrambleArena Arena (PrimState m)
arena

    -- reset the arena to clear state
    Arena (PrimState m) -> m ()
forall (m :: * -> *). PrimMonad m => Arena (PrimState m) -> m ()
resetArena Arena (PrimState m)
arena

    MutVar (PrimState m) [Arena (PrimState m)]
-> ([Arena (PrimState m)] -> ([Arena (PrimState m)], ())) -> m ()
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' MutVar (PrimState m) [Arena (PrimState m)]
arenas (([Arena (PrimState m)] -> ([Arena (PrimState m)], ())) -> m ())
-> ([Arena (PrimState m)] -> ([Arena (PrimState m)], ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \[Arena (PrimState m)]
xs -> (Arena (PrimState m)
arena Arena (PrimState m)
-> [Arena (PrimState m)] -> [Arena (PrimState m)]
forall a. a -> [a] -> [a]
: [Arena (PrimState m)]
xs, ())



scrambleArena :: PrimMonad m => Arena (PrimState m) -> m ()
#ifndef NO_IGNORE_ASSERTS
scrambleArena :: forall (m :: * -> *). PrimMonad m => Arena (PrimState m) -> m ()
scrambleArena Arena (PrimState m)
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
scrambleArena Arena {..} = do
    readMVar curr >>= scrambleBlock
    readMutVar full >>= mapM_ scrambleBlock
    readMutVar free >>= mapM_ scrambleBlock

scrambleBlock :: PrimMonad m => Block (PrimState m) -> m ()
scrambleBlock (Block _ mba) = do
    size <- getSizeofMutableByteArray mba
    setByteArray mba 0 size (0x77 :: Word8)
#endif

{-# SPECIALIZE
    resetArena :: Arena s -> ST s ()
  #-}
{-# SPECIALIZE
    resetArena :: Arena RealWorld -> IO ()
  #-}
-- | Reset arena, i.e. return used blocks to free list.
resetArena :: PrimMonad m => Arena (PrimState m) -> m ()
resetArena :: forall (m :: * -> *). PrimMonad m => Arena (PrimState m) -> m ()
resetArena Arena {MVar (PrimState m) (Block (PrimState m))
MutVar (PrimState m) [Block (PrimState m)]
curr :: forall s. Arena s -> MVar s (Block s)
free :: forall s. Arena s -> MutVar s [Block s]
full :: forall s. Arena s -> MutVar s [Block s]
curr :: MVar (PrimState m) (Block (PrimState m))
free :: MutVar (PrimState m) [Block (PrimState m)]
full :: MutVar (PrimState m) [Block (PrimState m)]
..} = do
    Block PrimVar (PrimState m) Int
off MutableByteArray (PrimState m)
mba <- MVar (PrimState m) (Block (PrimState m)) -> m (Block (PrimState m))
forall (m :: * -> *) a. PrimMonad m => MVar (PrimState m) a -> m a
takeMVar MVar (PrimState m) (Block (PrimState m))
curr

    -- reset current block
    PrimVar (PrimState m) Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar (PrimState m) Int
off Int
0

    -- move full block to free blocks.
    -- block's offset will be reset in 'newBlockWithFree'
    [Block (PrimState m)]
full' <- MutVar (PrimState m) [Block (PrimState m)]
-> ([Block (PrimState m)]
    -> ([Block (PrimState m)], [Block (PrimState m)]))
-> m [Block (PrimState m)]
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' MutVar (PrimState m) [Block (PrimState m)]
full (([Block (PrimState m)]
  -> ([Block (PrimState m)], [Block (PrimState m)]))
 -> m [Block (PrimState m)])
-> ([Block (PrimState m)]
    -> ([Block (PrimState m)], [Block (PrimState m)]))
-> m [Block (PrimState m)]
forall a b. (a -> b) -> a -> b
$ \[Block (PrimState m)]
xs -> ([], [Block (PrimState m)]
xs)
    MutVar (PrimState m) [Block (PrimState m)]
-> ([Block (PrimState m)] -> ([Block (PrimState m)], ())) -> m ()
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' MutVar (PrimState m) [Block (PrimState m)]
free (([Block (PrimState m)] -> ([Block (PrimState m)], ())) -> m ())
-> ([Block (PrimState m)] -> ([Block (PrimState m)], ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \[Block (PrimState m)]
xs -> ([Block (PrimState m)]
full' [Block (PrimState m)]
-> [Block (PrimState m)] -> [Block (PrimState m)]
forall a. Semigroup a => a -> a -> a
<> [Block (PrimState m)]
xs, ())

    MVar (PrimState m) (Block (PrimState m))
-> Block (PrimState m) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVar (PrimState m) a -> a -> m ()
putMVar MVar (PrimState m) (Block (PrimState m))
curr (Block (PrimState m) -> m ()) -> Block (PrimState m) -> m ()
forall a b. (a -> b) -> a -> b
$! PrimVar (PrimState m) Int
-> MutableByteArray (PrimState m) -> Block (PrimState m)
forall s. PrimVar s Int -> MutableByteArray s -> Block s
Block PrimVar (PrimState m) Int
off MutableByteArray (PrimState m)
mba

-- | Create unmanaged arena.
--
-- Never use this in non-tests code.
withUnmanagedArena :: PrimMonad m => (Arena (PrimState m) -> m a) -> m a
withUnmanagedArena :: forall (m :: * -> *) a.
PrimMonad m =>
(Arena (PrimState m) -> m a) -> m a
withUnmanagedArena Arena (PrimState m) -> m a
k = do
    ArenaManager (PrimState m)
mgr <- m (ArenaManager (PrimState m))
forall (m :: * -> *). PrimMonad m => m (ArenaManager (PrimState m))
newArenaManager
    ArenaManager (PrimState m) -> (Arena (PrimState m) -> m a) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
ArenaManager (PrimState m) -> (Arena (PrimState m) -> m a) -> m a
withArena ArenaManager (PrimState m)
mgr Arena (PrimState m) -> m a
k

{-# SPECIALIZE
    allocateFromArena :: Arena s -> Size -> Alignment -> ST s (Offset, MutableByteArray s)
  #-}
-- | Allocate a slice of mutable byte array from the arena.
allocateFromArena :: PrimMonad m => Arena (PrimState m)-> Size -> Alignment -> m (Offset, MutableByteArray (PrimState m))
allocateFromArena :: forall (m :: * -> *).
PrimMonad m =>
Arena (PrimState m)
-> Int -> Int -> m (Int, MutableByteArray (PrimState m))
allocateFromArena !Arena (PrimState m)
arena !Int
size !Int
alignment =
    Bool
-> m (Int, MutableByteArray (PrimState m))
-> m (Int, MutableByteArray (PrimState m))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int -> Int
forall a. Bits a => a -> Int
popCount Int
alignment Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (m (Int, MutableByteArray (PrimState m))
 -> m (Int, MutableByteArray (PrimState m)))
-> m (Int, MutableByteArray (PrimState m))
-> m (Int, MutableByteArray (PrimState m))
forall a b. (a -> b) -> a -> b
$ -- powers of 2
    Bool
-> m (Int, MutableByteArray (PrimState m))
-> m (Int, MutableByteArray (PrimState m))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
blockSize) (m (Int, MutableByteArray (PrimState m))
 -> m (Int, MutableByteArray (PrimState m)))
-> m (Int, MutableByteArray (PrimState m))
-> m (Int, MutableByteArray (PrimState m))
forall a b. (a -> b) -> a -> b
$ -- not too large allocations
    Arena (PrimState m)
-> Int -> Int -> m (Int, MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Arena (PrimState m)
-> Int -> Int -> m (Int, MutableByteArray (PrimState m))
allocateFromArena' Arena (PrimState m)
arena Int
size Int
alignment

{-# SPECIALIZE
    allocateFromArena' :: Arena s -> Size -> Alignment -> ST s (Offset, MutableByteArray s)
  #-}
-- TODO!? this is not async exception safe
allocateFromArena' :: PrimMonad m => Arena (PrimState m)-> Size -> Alignment -> m (Offset, MutableByteArray (PrimState m))
allocateFromArena' :: forall (m :: * -> *).
PrimMonad m =>
Arena (PrimState m)
-> Int -> Int -> m (Int, MutableByteArray (PrimState m))
allocateFromArena' arena :: Arena (PrimState m)
arena@Arena { MVar (PrimState m) (Block (PrimState m))
MutVar (PrimState m) [Block (PrimState m)]
curr :: forall s. Arena s -> MVar s (Block s)
free :: forall s. Arena s -> MutVar s [Block s]
full :: forall s. Arena s -> MutVar s [Block s]
curr :: MVar (PrimState m) (Block (PrimState m))
free :: MutVar (PrimState m) [Block (PrimState m)]
full :: MutVar (PrimState m) [Block (PrimState m)]
.. } !Int
size !Int
alignment = do
    -- take current block, lock the arena
    curr' :: Block (PrimState m)
curr'@(Block PrimVar (PrimState m) Int
off MutableByteArray (PrimState m)
mba) <- MVar (PrimState m) (Block (PrimState m)) -> m (Block (PrimState m))
forall (m :: * -> *) a. PrimMonad m => MVar (PrimState m) a -> m a
takeMVar MVar (PrimState m) (Block (PrimState m))
curr

    Int
off' <- PrimVar (PrimState m) Int -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar (PrimState m) Int
off
    let !ali :: Int
ali = Int
alignment Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    let !off'' :: Int
off'' = (Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ali) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement Int
ali -- ceil towards next alignment
    let !end :: Int
end  = Int
off'' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size
    if Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
blockSize
    then do
        -- fits into current block:
        -- * update offset
        PrimVar (PrimState m) Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar (PrimState m) Int
off Int
end
        -- * release lock
        MVar (PrimState m) (Block (PrimState m))
-> Block (PrimState m) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVar (PrimState m) a -> a -> m ()
putMVar MVar (PrimState m) (Block (PrimState m))
curr Block (PrimState m)
curr'
        -- * return data
        (Int, MutableByteArray (PrimState m))
-> m (Int, MutableByteArray (PrimState m))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off'', MutableByteArray (PrimState m)
mba)

    else do
        -- doesn't fit into current block:
        -- * move current block into full
        MutVar (PrimState m) [Block (PrimState m)]
-> ([Block (PrimState m)] -> ([Block (PrimState m)], ())) -> m ()
forall (m :: * -> *) a b.
PrimMonad m =>
MutVar (PrimState m) a -> (a -> (a, b)) -> m b
atomicModifyMutVar' MutVar (PrimState m) [Block (PrimState m)]
full (\[Block (PrimState m)]
xs -> (Block (PrimState m)
curr' Block (PrimState m)
-> [Block (PrimState m)] -> [Block (PrimState m)]
forall a. a -> [a] -> [a]
: [Block (PrimState m)]
xs, ()))
        -- * allocate new block
        Block (PrimState m)
new <- MutVar (PrimState m) [Block (PrimState m)]
-> m (Block (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
MutVar (PrimState m) [Block (PrimState m)]
-> m (Block (PrimState m))
newBlockWithFree MutVar (PrimState m) [Block (PrimState m)]
free
        -- * set new block as current, release the lock
        MVar (PrimState m) (Block (PrimState m))
-> Block (PrimState m) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVar (PrimState m) a -> a -> m ()
putMVar MVar (PrimState m) (Block (PrimState m))
curr Block (PrimState m)
new
        -- * go again
        Arena (PrimState m)
-> Int -> Int -> m (Int, MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Arena (PrimState m)
-> Int -> Int -> m (Int, MutableByteArray (PrimState m))
allocateFromArena' Arena (PrimState m)
arena Int
size Int
alignment

{-# SPECIALIZE newBlockWithFree :: MutVar s [Block s] -> ST s (Block s) #-}
-- | Allocate new block, possibly taking it from a free list
newBlockWithFree :: PrimMonad m => MutVar (PrimState m) [Block (PrimState m)] -> m (Block (PrimState m))
newBlockWithFree :: forall (m :: * -> *).
PrimMonad m =>
MutVar (PrimState m) [Block (PrimState m)]
-> m (Block (PrimState m))
newBlockWithFree MutVar (PrimState m) [Block (PrimState m)]
free = do
    [Block (PrimState m)]
free' <- MutVar (PrimState m) [Block (PrimState m)]
-> m [Block (PrimState m)]
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) [Block (PrimState m)]
free
    case [Block (PrimState m)]
free' of
        []   -> m (Block (PrimState m))
forall (m :: * -> *). PrimMonad m => m (Block (PrimState m))
newBlock
        x :: Block (PrimState m)
x@(Block PrimVar (PrimState m) Int
off MutableByteArray (PrimState m)
_):[Block (PrimState m)]
xs -> do
            PrimVar (PrimState m) Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar (PrimState m) Int
off Int
0
            MutVar (PrimState m) [Block (PrimState m)]
-> [Block (PrimState m)] -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) [Block (PrimState m)]
free [Block (PrimState m)]
xs
            Block (PrimState m) -> m (Block (PrimState m))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Block (PrimState m)
x