{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

module Control.Effect.Internal.SmallArray
  ( SmallArray(..)
  , SmallMutableArray(..)
  , newSmallArray
  , P.runSmallArray
  , P.unsafeFreezeSmallArray
  , P.unsafeThawSmallArray
  , sizeofSmallArray
  , sizeofSmallMutableArray
  , indexSmallArray
  , readSmallArray
  , writeSmallArray
  , copySmallArray
  , cloneSmallArray
  , copySmallMutableArray
  , cloneSmallMutableArray
  ) where

import qualified Data.Primitive.SmallArray as P

import Control.Exception (assert)
import Control.Monad.Primitive
import Data.Primitive.SmallArray (SmallArray(..), SmallMutableArray(..))
import GHC.Exts (Int(..), indexSmallArray#)

import Control.Effect.Internal.Debug

newSmallArray :: (DebugCallStack, PrimMonad m) => Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray :: Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
len a
x = Bool
-> m (SmallMutableArray (PrimState m) a)
-> m (SmallMutableArray (PrimState m) a)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m (SmallMutableArray (PrimState m) a)
 -> m (SmallMutableArray (PrimState m) a))
-> m (SmallMutableArray (PrimState m) a)
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
P.newSmallArray Int
len a
x
{-# INLINE newSmallArray #-}

sizeofSmallArray :: DebugCallStack => SmallArray a -> Int
sizeofSmallArray :: SmallArray a -> Int
sizeofSmallArray SmallArray a
arr = let len :: Int
len = SmallArray a -> Int
forall a. SmallArray a -> Int
P.sizeofSmallArray SmallArray a
arr in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Int
len
{-# INLINE sizeofSmallArray #-}

sizeofSmallMutableArray :: DebugCallStack => SmallMutableArray s a -> Int
sizeofSmallMutableArray :: SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray s a
arr = let len :: Int
len = SmallMutableArray s a -> Int
forall s a. SmallMutableArray s a -> Int
P.sizeofSmallMutableArray SmallMutableArray s a
arr in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Int
len
{-# INLINE sizeofSmallMutableArray #-}

indexSmallArray :: DebugCallStack => SmallArray a -> Int -> (# a #)
indexSmallArray :: SmallArray a -> Int -> (# a #)
indexSmallArray SmallArray a
arr Int
idx =
  -- We have to put the assertions in a pointless strict binding because `assert` can’t accept an
  -- unlifted argument.
  let !() = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> ()) -> () -> ()
forall a b. (a -> b) -> a -> b
$ Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SmallArray a -> Int
forall a. DebugCallStack => SmallArray a -> Int
sizeofSmallArray SmallArray a
arr) ()
      !(SmallArray SmallArray# a
arr#) = SmallArray a
arr
      !(I# Int#
idx#) = Int
idx
  in SmallArray# a -> Int# -> (# a #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# a
arr# Int#
idx#
{-# INLINE indexSmallArray #-}

readSmallArray :: (DebugCallStack, PrimMonad m) => SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray :: SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray SmallMutableArray (PrimState m) a
arr Int
idx =
  Bool -> m a -> m a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Bool -> m a -> m a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SmallMutableArray (PrimState m) a -> Int
forall s a. DebugCallStack => SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray (PrimState m) a
arr) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ SmallMutableArray (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
P.readSmallArray SmallMutableArray (PrimState m) a
arr Int
idx
{-# INLINE readSmallArray #-}

writeSmallArray
  :: (DebugCallStack, PrimMonad m) => SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray :: SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) a
arr Int
idx a
x = do
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SmallMutableArray (PrimState m) a -> Int
forall s a. DebugCallStack => SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray (PrimState m) a
arr
  SmallMutableArray (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
P.writeSmallArray SmallMutableArray (PrimState m) a
arr Int
idx a
x
{-# INLINE writeSmallArray #-}

copySmallArray
  :: (DebugCallStack, PrimMonad m)
  => SmallMutableArray (PrimState m) a -> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray :: SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray (PrimState m) a
dst Int
idx_dst SmallArray a
src Int
idx_src Int
len = do
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_dst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_dst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SmallMutableArray (PrimState m) a -> Int
forall s a. DebugCallStack => SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray (PrimState m) a
dst
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SmallArray a -> Int
forall a. DebugCallStack => SmallArray a -> Int
sizeofSmallArray SmallArray a
src
  SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
P.copySmallArray SmallMutableArray (PrimState m) a
dst Int
idx_dst SmallArray a
src Int
idx_src Int
len
{-# INLINE copySmallArray #-}

cloneSmallArray :: DebugCallStack => SmallArray a -> Int -> Int -> SmallArray a
cloneSmallArray :: SmallArray a -> Int -> Int -> SmallArray a
cloneSmallArray SmallArray a
src Int
idx Int
len =
  Bool -> SmallArray a -> SmallArray a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (SmallArray a -> SmallArray a) -> SmallArray a -> SmallArray a
forall a b. (a -> b) -> a -> b
$
  Bool -> SmallArray a -> SmallArray a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (SmallArray a -> SmallArray a) -> SmallArray a -> SmallArray a
forall a b. (a -> b) -> a -> b
$
  Bool -> SmallArray a -> SmallArray a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SmallArray a -> Int
forall a. DebugCallStack => SmallArray a -> Int
sizeofSmallArray SmallArray a
src) (SmallArray a -> SmallArray a) -> SmallArray a -> SmallArray a
forall a b. (a -> b) -> a -> b
$
    SmallArray a -> Int -> Int -> SmallArray a
forall a. SmallArray a -> Int -> Int -> SmallArray a
P.cloneSmallArray SmallArray a
src Int
idx Int
len
{-# INLINE cloneSmallArray #-}

copySmallMutableArray
  :: (DebugCallStack, PrimMonad m)
  => SmallMutableArray (PrimState m) a -> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray :: SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray (PrimState m) a
dst Int
idx_dst SmallMutableArray (PrimState m) a
src Int
idx_src Int
len = do
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_dst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_dst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SmallMutableArray (PrimState m) a -> Int
forall s a. DebugCallStack => SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray (PrimState m) a
dst
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx_src Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SmallMutableArray (PrimState m) a -> Int
forall s a. DebugCallStack => SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray (PrimState m) a
src
  SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
P.copySmallMutableArray SmallMutableArray (PrimState m) a
dst Int
idx_dst SmallMutableArray (PrimState m) a
src Int
idx_src Int
len
{-# INLINE copySmallMutableArray #-}

cloneSmallMutableArray
  :: (DebugCallStack, PrimMonad m)
  => SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray :: SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray SmallMutableArray (PrimState m) a
src Int
idx Int
len = do
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  Bool -> m ()
forall (m :: * -> *).
(DebugCallStack, Applicative m) =>
Bool -> m ()
assertM (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= SmallMutableArray (PrimState m) a -> Int
forall s a. DebugCallStack => SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray (PrimState m) a
src
  SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
P.cloneSmallMutableArray SmallMutableArray (PrimState m) a
src Int
idx Int
len
{-# INLINE cloneSmallMutableArray #-}