{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}

module Data.Primitive.Contiguous.Shim
  ( errorThunk
  , resizeArray
  , resizeSmallArray
  , replicateSmallMutableArray
  , resizeUnliftedArray
  , replicateMutablePrimArray
  , clonePrimArrayShim
  , cloneMutablePrimArrayShim
  , freezePrimArrayShim
  ) where

import Control.Monad (when)
import Control.Monad.ST.Run (runPrimArrayST)
import Data.Primitive hiding (fromList,fromListN)
import Data.Primitive.Unlifted.Array
import Prelude hiding (map,all,any,foldr,foldMap,traverse,read,filter,replicate,null,reverse,foldl,foldr,zip,zipWith,scanl,(<$),elem,maximum,minimum,mapM,mapM_,sequence,sequence_)

import Data.Primitive.Unlifted.Class (PrimUnlifted)
import Control.Monad.Primitive (PrimState, PrimMonad(..))


errorThunk :: a
errorThunk :: forall a. a
errorThunk = forall a. HasCallStack => [Char] -> a
error [Char]
"Contiguous typeclass: unitialized element"
{-# noinline errorThunk #-}

resizeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a)
resizeArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> m (MutableArray (PrimState m) a)
resizeArray !MutableArray (PrimState m) a
src !Int
sz = do
  MutableArray (PrimState m) a
dst <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz forall a. a
errorThunk
  forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray (PrimState m) a
dst Int
0 MutableArray (PrimState m) a
src Int
0 (forall a. Ord a => a -> a -> a
min Int
sz (forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray (PrimState m) a
src))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableArray (PrimState m) a
dst
{-# inline resizeArray #-}

resizeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a)
resizeSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> m (SmallMutableArray (PrimState m) a)
resizeSmallArray !SmallMutableArray (PrimState m) a
src !Int
sz = do
  SmallMutableArray (PrimState m) a
dst <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
sz forall a. a
errorThunk
  forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray SmallMutableArray (PrimState m) a
dst Int
0 SmallMutableArray (PrimState m) a
src Int
0 (forall a. Ord a => a -> a -> a
min Int
sz (forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray SmallMutableArray (PrimState m) a
src))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallMutableArray (PrimState m) a
dst
{-# inline resizeSmallArray #-}

replicateSmallMutableArray :: (PrimMonad m)
  => Int
  -> a
  -> m (SmallMutableArray (PrimState m) a)
replicateSmallMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
replicateSmallMutableArray Int
len a
a = do
  SmallMutableArray (PrimState m) a
marr <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
len forall a. a
errorThunk
  let go :: Int -> m ()
go !Int
ix = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ix forall a. Ord a => a -> a -> Bool
< Int
len) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) a
marr Int
ix a
a
        Int -> m ()
go (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
  Int -> m ()
go Int
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallMutableArray (PrimState m) a
marr
{-# inline replicateSmallMutableArray #-}

resizeUnliftedArray :: (PrimMonad m, PrimUnlifted a) => MutableUnliftedArray (PrimState m) a -> Int -> m (MutableUnliftedArray (PrimState m) a)
resizeUnliftedArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a
-> Int -> m (MutableUnliftedArray (PrimState m) a)
resizeUnliftedArray !MutableUnliftedArray (PrimState m) a
src !Int
sz = do
  MutableUnliftedArray (PrimState m) a
dst <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray Int
sz
  forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int
-> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m ()
copyMutableUnliftedArray MutableUnliftedArray (PrimState m) a
dst Int
0 MutableUnliftedArray (PrimState m) a
src Int
0 (forall a. Ord a => a -> a -> a
min Int
sz (forall s e. MutableUnliftedArray s e -> Int
sizeofMutableUnliftedArray MutableUnliftedArray (PrimState m) a
src))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableUnliftedArray (PrimState m) a
dst
{-# inline resizeUnliftedArray #-}

replicateMutablePrimArray :: (PrimMonad m, Prim a)
  => Int -- ^ length
  -> a -- ^ element
  -> m (MutablePrimArray (PrimState m) a)
replicateMutablePrimArray :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> a -> m (MutablePrimArray (PrimState m) a)
replicateMutablePrimArray Int
len a
a = do
  MutablePrimArray (PrimState m) a
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
setPrimArray MutablePrimArray (PrimState m) a
marr Int
0 Int
len a
a
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MutablePrimArray (PrimState m) a
marr
{-# inline replicateMutablePrimArray #-}

clonePrimArrayShim :: Prim a => PrimArray a -> Int -> Int -> PrimArray a
clonePrimArrayShim :: forall a. Prim a => PrimArray a -> Int -> Int -> PrimArray a
clonePrimArrayShim !PrimArray a
arr !Int
off !Int
len = forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
runPrimArrayST forall a b. (a -> b) -> a -> b
$ do
  MutablePrimArray s a
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray s a
marr Int
0 PrimArray a
arr Int
off Int
len
  forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
marr
{-# inline clonePrimArrayShim #-}

cloneMutablePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (MutablePrimArray (PrimState m) a)
cloneMutablePrimArrayShim :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> Int -> m (MutablePrimArray (PrimState m) a)
cloneMutablePrimArrayShim !MutablePrimArray (PrimState m) a
arr !Int
off !Int
len = do
  MutablePrimArray (PrimState m) a
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray (PrimState m) a
marr Int
0 MutablePrimArray (PrimState m) a
arr Int
off Int
len
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MutablePrimArray (PrimState m) a
marr
{-# inline cloneMutablePrimArrayShim #-}

freezePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a)
freezePrimArrayShim :: forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a)
freezePrimArrayShim !MutablePrimArray (PrimState m) a
src !Int
off !Int
len = do
  MutablePrimArray (PrimState m) a
dst <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray (PrimState m) a
dst Int
0 MutablePrimArray (PrimState m) a
src Int
off Int
len
  forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray (PrimState m) a
dst
{-# inline freezePrimArrayShim #-}