{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- |
-- Module      : Data.Prim.Array
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Prim.Array
  ( -- $arrays
      Size(..)
    -- * Boxed Array
    -- $boxedArray

    -- ** Immutable
    , BArray(..)
    , isSameBArray
    , sizeOfBArray
    , indexBArray
    , copyBArray
    , cloneBArray
    , thawBArray
    , thawCopyBArray
    , toListBArray
    , fromListBArray
    , fromListBArrayN
    , fromBaseBArray
    , toBaseBArray
    -- ** Mutable
    , BMArray(..)
    , getSizeOfBMArray
    , readBMArray
    , writeBMArray
    , writeLazyBMArray
    , writeDeepBMArray
    , isSameBMArray
    , newBMArray
    , newLazyBMArray
    , newRawBMArray
    , makeBMArray
    , moveBMArray
    , cloneBMArray
    , shrinkBMArray
    , resizeBMArray
    , resizeRawBMArray
    , freezeBMArray
    , freezeCopyBMArray

    -- * Small Boxed Array
    -- ** Immutable
    , SBArray(..)
    , isSameSBArray
    , sizeOfSBArray
    , indexSBArray
    , copySBArray
    , cloneSBArray
    , thawSBArray
    , thawCopySBArray
    , toListSBArray
    , fromListSBArray
    , fromListSBArrayN
    -- ** Mutable
    , SBMArray(..)
    , isSameSBMArray
    , getSizeOfSBMArray
    , readSBMArray
    , writeSBMArray
    , writeLazySBMArray
    , writeDeepSBMArray
    , newSBMArray
    , newLazySBMArray
    , newRawSBMArray
    , makeSBMArray
    , moveSBMArray
    , cloneSBMArray
    , shrinkSBMArray
    , resizeSBMArray
    , resizeRawSBMArray
    , freezeSBMArray
    , freezeCopySBMArray
    -- * Unboxed Array
    -- ** Immutable
    , UArray(..)
    , isSameUArray
    , isPinnedUArray
    , sizeOfUArray
    , indexUArray
    , copyUArray
    , thawUArray
    , toListUArray
    , fromListUArray
    , fromListUArrayN
    , fromBaseUArray
    , toBaseUArray
    -- ** Mutable
    , UMArray(..)
    , isSameUMArray
    , isPinnedUMArray
    , getSizeOfUMArray
    , readUMArray
    , writeUMArray
    , newUMArray
    , newRawUMArray
    , makeUMArray

    , newPinnedUMArray
    , newRawPinnedUMArray
    , makePinnedUMArray
    , newAlignedPinnedUMArray
    , newRawAlignedPinnedUMArray
    , makeAlignedPinnedUMArray
    , moveUMArray
    , setUMArray
    , shrinkUMArray
    , resizeUMArray
    , freezeUMArray
    -- * Helper functions
    , uninitialized
    , makeMutWith
    , fromListMutWith
    , foldrWithFB
    , eqWith
    , compareWith
    , appendWith
    , concatWith
  ) where

import Control.DeepSeq
import Control.Prim.Exception
import qualified Data.Foldable as F
import Data.Functor.Classes
import qualified Data.List.NonEmpty as NE (toList)
import Data.Prim
import Data.Prim.Class
import Foreign.Prim
import qualified Data.Array.Base as A
import qualified GHC.Arr as A

-- $arrays
--
-- Minimal interface, wrappers around primops
--
-- Indexing and Size type
--
-- As in the rest of the library majority of the functions are unsafe.
--
-- no fusion
--
-- Boxed vs unboxed concept
--
-- Mutable vs Immutable
--
-- Note more features in primal-memory and primal-mutable


newtype Size = Size { Size -> Int
unSize :: Int }
  deriving (Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: Int -> Size -> ShowS
$cshowsPrec :: Int -> Size -> ShowS
Show, Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, Eq Size
Eq Size
-> (Size -> Size -> Ordering)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Bool)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> Ord Size
Size -> Size -> Bool
Size -> Size -> Ordering
Size -> Size -> Size
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Size -> Size -> Size
$cmin :: Size -> Size -> Size
max :: Size -> Size -> Size
$cmax :: Size -> Size -> Size
>= :: Size -> Size -> Bool
$c>= :: Size -> Size -> Bool
> :: Size -> Size -> Bool
$c> :: Size -> Size -> Bool
<= :: Size -> Size -> Bool
$c<= :: Size -> Size -> Bool
< :: Size -> Size -> Bool
$c< :: Size -> Size -> Bool
compare :: Size -> Size -> Ordering
$ccompare :: Size -> Size -> Ordering
$cp1Ord :: Eq Size
Ord, Integer -> Size
Size -> Size
Size -> Size -> Size
(Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Size -> Size)
-> (Integer -> Size)
-> Num Size
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Size
$cfromInteger :: Integer -> Size
signum :: Size -> Size
$csignum :: Size -> Size
abs :: Size -> Size
$cabs :: Size -> Size
negate :: Size -> Size
$cnegate :: Size -> Size
* :: Size -> Size -> Size
$c* :: Size -> Size -> Size
- :: Size -> Size -> Size
$c- :: Size -> Size -> Size
+ :: Size -> Size -> Size
$c+ :: Size -> Size -> Size
Num, Num Size
Ord Size
Num Size -> Ord Size -> (Size -> Rational) -> Real Size
Size -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Size -> Rational
$ctoRational :: Size -> Rational
$cp2Real :: Ord Size
$cp1Real :: Num Size
Real, Enum Size
Real Size
Real Size
-> Enum Size
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> Size)
-> (Size -> Size -> (Size, Size))
-> (Size -> Size -> (Size, Size))
-> (Size -> Integer)
-> Integral Size
Size -> Integer
Size -> Size -> (Size, Size)
Size -> Size -> Size
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Size -> Integer
$ctoInteger :: Size -> Integer
divMod :: Size -> Size -> (Size, Size)
$cdivMod :: Size -> Size -> (Size, Size)
quotRem :: Size -> Size -> (Size, Size)
$cquotRem :: Size -> Size -> (Size, Size)
mod :: Size -> Size -> Size
$cmod :: Size -> Size -> Size
div :: Size -> Size -> Size
$cdiv :: Size -> Size -> Size
rem :: Size -> Size -> Size
$crem :: Size -> Size -> Size
quot :: Size -> Size -> Size
$cquot :: Size -> Size -> Size
$cp2Integral :: Enum Size
$cp1Integral :: Real Size
Integral, Size
Size -> Size -> Bounded Size
forall a. a -> a -> Bounded a
maxBound :: Size
$cmaxBound :: Size
minBound :: Size
$cminBound :: Size
Bounded, Int -> Size
Size -> Int
Size -> [Size]
Size -> Size
Size -> Size -> [Size]
Size -> Size -> Size -> [Size]
(Size -> Size)
-> (Size -> Size)
-> (Int -> Size)
-> (Size -> Int)
-> (Size -> [Size])
-> (Size -> Size -> [Size])
-> (Size -> Size -> [Size])
-> (Size -> Size -> Size -> [Size])
-> Enum Size
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Size -> Size -> Size -> [Size]
$cenumFromThenTo :: Size -> Size -> Size -> [Size]
enumFromTo :: Size -> Size -> [Size]
$cenumFromTo :: Size -> Size -> [Size]
enumFromThen :: Size -> Size -> [Size]
$cenumFromThen :: Size -> Size -> [Size]
enumFrom :: Size -> [Size]
$cenumFrom :: Size -> [Size]
fromEnum :: Size -> Int
$cfromEnum :: Size -> Int
toEnum :: Int -> Size
$ctoEnum :: Int -> Size
pred :: Size -> Size
$cpred :: Size -> Size
succ :: Size -> Size
$csucc :: Size -> Size
Enum)

instance Prim Size where
  type PrimBase Size = Int


-----------------
-- Boxed Array --
-- =========== --


-- Immutable Boxed Array --
---------------------------

-- $boxedArray A boxed array is essentially a contiguous chunk of memory that holds
-- pointers to actual elements that are being stored somewhere else on the heap. Therefore
-- it is more efficient to use `UArray` if the element being stored has a `Prim` instance
-- or can have created for it, because this avoids an extra level of indirection. However
-- this is not always possible and for this reason we have boxed arrays.


-- | Immutable array with boxed elements.
--
-- @since 0.3.0
data BArray e = BArray (Array# e)

-- | @since 0.3.0
instance Functor BArray where
  fmap :: (a -> b) -> BArray a -> BArray b
fmap a -> b
f BArray a
a =
    (forall s. ST s (BArray b)) -> BArray b
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (BArray b)) -> BArray b)
-> (forall s. ST s (BArray b)) -> BArray b
forall a b. (a -> b) -> a -> b
$
    Size -> (Int -> ST s b) -> ST s (BMArray b s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> (Int -> m e) -> m (BMArray e s)
makeBMArray
      (BArray a -> Size
forall e. BArray e -> Size
sizeOfBArray BArray a
a)
      (b -> ST s b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> ST s b) -> (Int -> b) -> Int -> ST s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Int -> a) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BArray a -> Int -> a
forall e. BArray e -> Int -> e
indexBArray BArray a
a) ST s (BMArray b s)
-> (BMArray b s -> ST s (BArray b)) -> ST s (BArray b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BMArray b s -> ST s (BArray b)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray
  {-# INLINE fmap #-}
  <$ :: a -> BArray b -> BArray a
(<$) a
x BArray b
a = (forall s. ST s (BArray a)) -> BArray a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (BArray a)) -> BArray a)
-> (forall s. ST s (BArray a)) -> BArray a
forall a b. (a -> b) -> a -> b
$ Size -> a -> ST s (BMArray a s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> e -> m (BMArray e s)
newLazyBMArray (BArray b -> Size
forall e. BArray e -> Size
sizeOfBArray BArray b
a) a
x ST s (BMArray a s)
-> (BMArray a s -> ST s (BArray a)) -> ST s (BArray a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BMArray a s -> ST s (BArray a)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray
  {-# INLINE (<$) #-}

-- | @since 0.3.0
instance Foldable BArray where
  null :: BArray a -> Bool
null = (Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
0) (Size -> Bool) -> (BArray a -> Size) -> BArray a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BArray a -> Size
forall e. BArray e -> Size
sizeOfBArray
  {-# INLINE null #-}
  length :: BArray a -> Int
length = Size -> Int
coerce (Size -> Int) -> (BArray a -> Size) -> BArray a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BArray a -> Size
forall e. BArray e -> Size
sizeOfBArray
  {-# INLINE length #-}
  foldr :: (a -> b -> b) -> b -> BArray a -> b
foldr = (BArray a -> Size)
-> (BArray a -> Int -> a) -> (a -> b -> b) -> b -> BArray a -> b
forall (a :: * -> *) e b.
(a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB BArray a -> Size
forall e. BArray e -> Size
sizeOfBArray BArray a -> Int -> a
forall e. BArray e -> Int -> e
indexBArray
  {-# INLINE foldr #-}

instance Show1 BArray where
#if MIN_VERSION_transformers(0,5,0)
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> BArray a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ = String -> ([a] -> ShowS) -> Int -> BArray a -> ShowS
forall (f :: * -> *) e.
Foldable f =>
String -> ([e] -> ShowS) -> Int -> f e -> ShowS
liftShowsPrecArray String
"BArray"
#else
  showsPrec1 = liftShowsPrecArray "BArray" showList
#endif

instance Show e => Show (BArray e) where
  showsPrec :: Int -> BArray e -> ShowS
showsPrec = Int -> BArray e -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance IsList (BArray e) where
  type Item (BArray e) = e
  fromList :: [Item (BArray e)] -> BArray e
fromList = [Item (BArray e)] -> BArray e
forall e. [e] -> BArray e
fromListBArray
  {-# INLINE fromList #-}
  fromListN :: Int -> [Item (BArray e)] -> BArray e
fromListN Int
n = Size -> [e] -> BArray e
forall e. HasCallStack => Size -> [e] -> BArray e
fromListBArrayN (Int -> Size
coerce Int
n)
  {-# INLINE fromListN #-}
  toList :: BArray e -> [Item (BArray e)]
toList = BArray e -> [Item (BArray e)]
forall a. BArray a -> [a]
toListBArray
  {-# INLINE toList #-}

instance e ~ Char => IsString (BArray e) where
  fromString :: String -> BArray e
fromString = String -> BArray e
forall e. [e] -> BArray e
fromListBArray
  {-# INLINE fromString #-}

instance NFData e => NFData (BArray e) where
  rnf :: BArray e -> ()
rnf = (BArray e -> Size)
-> (BArray e -> Int -> e)
-> (e -> () -> ())
-> ()
-> BArray e
-> ()
forall (a :: * -> *) e b.
(a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray BArray e -> Int -> e
forall e. BArray e -> Int -> e
indexBArray e -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq ()
  {-# INLINE rnf #-}

instance Eq e => Eq (BArray e) where
  == :: BArray e -> BArray e -> Bool
(==) = (BArray e -> BArray e -> Bool)
-> (BArray e -> Size)
-> (BArray e -> Int -> e)
-> BArray e
-> BArray e
-> Bool
forall e (a :: * -> *).
Eq e =>
(a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Bool
eqWith BArray e -> BArray e -> Bool
forall a. BArray a -> BArray a -> Bool
isSameBArray BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray BArray e -> Int -> e
forall e. BArray e -> Int -> e
indexBArray
  {-# INLINE (==) #-}

instance Ord e => Ord (BArray e) where
  compare :: BArray e -> BArray e -> Ordering
compare = (BArray e -> BArray e -> Bool)
-> (BArray e -> Size)
-> (BArray e -> Int -> e)
-> BArray e
-> BArray e
-> Ordering
forall e (a :: * -> *).
Ord e =>
(a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Ordering
compareWith BArray e -> BArray e -> Bool
forall a. BArray a -> BArray a -> Bool
isSameBArray BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray BArray e -> Int -> e
forall e. BArray e -> Int -> e
indexBArray
  {-# INLINE compare #-}

instance Eq1 BArray where
#if MIN_VERSION_transformers(0,5,0)
  liftEq :: (a -> b -> Bool) -> BArray a -> BArray b -> Bool
liftEq = (forall e. BArray e -> Size)
-> (forall e. BArray e -> Int -> e)
-> (a -> b -> Bool)
-> BArray a
-> BArray b
-> Bool
forall (a :: * -> *) b c.
(forall e. a e -> Size)
-> (forall e. a e -> Int -> e)
-> (b -> c -> Bool)
-> a b
-> a c
-> Bool
liftEqWith forall e. BArray e -> Size
sizeOfBArray forall e. BArray e -> Int -> e
indexBArray
  {-# INLINE liftEq #-}
#else
  eq1 = liftEqWith sizeOfBArray indexBArray (==)
  {-# INLINE eq1 #-}
#endif


instance Ord1 BArray where
#if MIN_VERSION_transformers(0,5,0)
  liftCompare :: (a -> b -> Ordering) -> BArray a -> BArray b -> Ordering
liftCompare = (forall e. BArray e -> Size)
-> (forall e. BArray e -> Int -> e)
-> (a -> b -> Ordering)
-> BArray a
-> BArray b
-> Ordering
forall (a :: * -> *) b c.
(forall e. a e -> Size)
-> (forall e. a e -> Int -> e)
-> (b -> c -> Ordering)
-> a b
-> a c
-> Ordering
liftCompareWith forall e. BArray e -> Size
sizeOfBArray forall e. BArray e -> Int -> e
indexBArray
  {-# INLINE liftCompare #-}
#else
  compare1 = liftCompareWith sizeOfBArray indexBArray compare
  {-# INLINE compare1 #-}
#endif


instance Semigroup (BArray e) where
  <> :: BArray e -> BArray e -> BArray e
(<>) = (forall s. Size -> ST s (BMArray e s))
-> (forall s.
    BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ())
-> (forall s. BMArray e s -> ST s (BArray e))
-> (BArray e -> Size)
-> BArray e
-> BArray e
-> BArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> a e
-> a e
-> a e
appendWith forall s. Size -> ST s (BMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (BMArray e s)
newRawBMArray forall s. BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BArray e -> Int -> BMArray e s -> Int -> Size -> m ()
copyBArray forall s. BMArray e s -> ST s (BArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray
  {-# INLINE (<>) #-}
  sconcat :: NonEmpty (BArray e) -> BArray e
sconcat NonEmpty (BArray e)
xs = (forall s. Size -> ST s (BMArray e s))
-> (forall s.
    BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ())
-> (forall s. BMArray e s -> ST s (BArray e))
-> (BArray e -> Size)
-> [BArray e]
-> BArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> [a e]
-> a e
concatWith forall s. Size -> ST s (BMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (BMArray e s)
newRawBMArray forall s. BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BArray e -> Int -> BMArray e s -> Int -> Size -> m ()
copyBArray forall s. BMArray e s -> ST s (BArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray (NonEmpty (BArray e) -> [BArray e]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (BArray e)
xs)
  {-# INLINE sconcat #-}
  stimes :: b -> BArray e -> BArray e
stimes b
n = (forall s. Size -> ST s (BMArray e s))
-> (forall s.
    BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ())
-> (forall s. BMArray e s -> ST s (BArray e))
-> (BArray e -> Size)
-> Int
-> BArray e
-> BArray e
forall (a :: * -> *) e (ma :: * -> * -> *).
Monoid (a e) =>
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> Int
-> a e
-> a e
cycleWith forall s. Size -> ST s (BMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (BMArray e s)
newRawBMArray forall s. BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BArray e -> Int -> BMArray e s -> Int -> Size -> m ()
copyBArray forall s. BMArray e s -> ST s (BArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n)
  {-# INLINE stimes #-}

instance Monoid (BArray e) where
  mempty :: BArray e
mempty = (forall s. ST s (BArray e)) -> BArray e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (BArray e)) -> BArray e)
-> (forall s. ST s (BArray e)) -> BArray e
forall a b. (a -> b) -> a -> b
$ Size -> ST s (BMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (BMArray e s)
newRawBMArray Size
0 ST s (BMArray e s)
-> (BMArray e s -> ST s (BArray e)) -> ST s (BArray e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BMArray e s -> ST s (BArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray
  {-# NOINLINE mempty #-}
  mappend :: BArray e -> BArray e -> BArray e
mappend = BArray e -> BArray e -> BArray e
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}
  mconcat :: [BArray e] -> BArray e
mconcat = (forall s. Size -> ST s (BMArray e s))
-> (forall s.
    BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ())
-> (forall s. BMArray e s -> ST s (BArray e))
-> (BArray e -> Size)
-> [BArray e]
-> BArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> [a e]
-> a e
concatWith forall s. Size -> ST s (BMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (BMArray e s)
newRawBMArray forall s. BArray e -> Int -> BMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BArray e -> Int -> BMArray e s -> Int -> Size -> m ()
copyBArray forall s. BMArray e s -> ST s (BArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray
  {-# INLINE mconcat #-}

-- | Compare pointers for two immutable arrays and see if they refer to the exact same one.
--
-- @since 0.3.0
isSameBArray :: BArray a -> BArray a -> Bool
isSameBArray :: BArray a -> BArray a -> Bool
isSameBArray BArray a
a1 BArray a
a2 = (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (BMArray a s -> BMArray a s -> Bool
forall a s. BMArray a s -> BMArray a s -> Bool
isSameBMArray (BMArray a s -> BMArray a s -> Bool)
-> ST s (BMArray a s) -> ST s (BMArray a s -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BArray a -> ST s (BMArray a s)
forall e (m :: * -> *) s.
MonadPrim s m =>
BArray e -> m (BMArray e s)
thawBArray BArray a
a1 ST s (BMArray a s -> Bool) -> ST s (BMArray a s) -> ST s Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BArray a -> ST s (BMArray a s)
forall e (m :: * -> *) s.
MonadPrim s m =>
BArray e -> m (BMArray e s)
thawBArray BArray a
a2)
{-# INLINE isSameBArray #-}

-- | /O(1)/ - Get the number of elements in an immutable array
--
-- Documentation for utilized primop: `sizeofArray#`.
--
-- @since 0.3.0
sizeOfBArray :: forall e. BArray e -> Size
sizeOfBArray :: BArray e -> Size
sizeOfBArray (BArray Array# e
a#) = Int -> Size
Size (Int# -> Int
I# (Array# e -> Int#
forall a. Array# a -> Int#
sizeofArray# Array# e
a#))
{-# INLINE sizeOfBArray #-}

-- | /O(1)/ - Index an element in the immutable boxed array.
--
-- Documentation for utilized primop: `indexArray#`.
--
-- [Unsafe] Bounds are not checked. When a precondition for @ix@ argument is violated the
-- result is either unpredictable output or failure with a segfault.
--
-- ==== __Examples__
--
-- >>> import Data.Prim.Array
-- >>> let a = fromListBArray [[0 .. i] | i <- [0 .. 10 :: Int]]
-- >>> indexBArray a 1
-- [0,1]
-- >>> indexBArray a 5
-- [0,1,2,3,4,5]
--
-- @since 0.3.0
indexBArray ::
     forall e.
     BArray e
  -- ^ /array/ - Array where to lookup an element from
  -> Int
  -- ^ /ix/ - Position of the element within the @array@
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > ix < unSize (sizeOfBArray array)
  -> e
indexBArray :: BArray e -> Int -> e
indexBArray (BArray Array# e
a#) (I# Int#
i#) =
  case Array# e -> Int# -> (# e #)
forall a. Array# a -> Int# -> (# a #)
indexArray# Array# e
a# Int#
i# of
    (# e
x #) -> e
x
{-# INLINE indexBArray #-}


-- | /O(sz)/ - Make an exact copy of a subsection of a pure immutable array.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault. Failure with out of memory is also possibility when the @sz is
-- too large.
--
-- Documentation for utilized primop: `cloneArray#`.
--
-- ====__Examples__
--
-- >>> let a = fromListBArray ['a'..'z']
-- >>> a
-- BArray "abcdefghijklmnopqrstuvwxyz"
-- >>> cloneBArray a 23 3
-- BArray "xyz"
--
-- @since 0.3.0
cloneBArray ::
     forall e.
     BArray e
  -- ^ /srcArray/ - Immutable source array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned immutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfBArray srcArray)
  --
  -- Should be less then the actual available memory
  -> BArray e
cloneBArray :: BArray e -> Int -> Size -> BArray e
cloneBArray (BArray Array# e
a#) (I# Int#
i#) (Size (I# Int#
n#)) = Array# e -> BArray e
forall e. Array# e -> BArray e
BArray (Array# e -> Int# -> Int# -> Array# e
forall a. Array# a -> Int# -> Int# -> Array# a
cloneArray# Array# e
a# Int#
i# Int#
n#)
{-# INLINE cloneBArray #-}



-- | /O(sz)/ - Copy a subsection of an immutable array into a subsection of a mutable
-- array. Source and destination arrays must not be the same array in different states.
--
-- Documentation for utilized primop: `copyArray#`.
--
-- [Unsafe] When any of the preconditions for @srcStartIx@, @dstStartIx@ or @sz@ is violated
-- this function can result in a copy of some data that doesn't belong to @srcArray@ or more
-- likely a failure with a segfault.
--
-- @since 0.3.0
copyBArray ::
     forall e m s. MonadPrim s m
  => BArray e
  -- ^ /srcArray/ - Source immutable array
  --
  -- /__Precondition:__/
  --
  -- > srcMutArray <- thawBArray srcArray
  -- > srcMutArray /= dstMutArray
  -> Int
  -- ^ /srcStartIx/ - Offset into the source immutable array where copy should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= srcStartIx
  --
  -- > srcStartIx < unSize (sizeOfBArray srcArray)
  -> BMArray e s -- ^ /dstMutArray/ - Destination mutable array
  -> Int
  -- ^ /dstStartIx/ - Offset into the destination mutable array where the copy should start
  -- at
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= dstStartIx
  --
  -- > dstSize <- getSizeOfBMArray dstMutArray
  -- > dstStartIx < unSize dstSize
  -> Size
  -- ^ /sz/ - Number of elements to copy over
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > srcStartIx + unSize sz < unSize (sizeOfBArray srcArray)
  --
  -- > dstSize <- getSizeOfBMArray dstMutArray
  -- > dstStartIx + unSize sz < unSize dstSize
  -> m ()
copyBArray :: BArray e -> Int -> BMArray e s -> Int -> Size -> m ()
copyBArray (BArray Array# e
src#) (I# Int#
srcOff#) (BMArray MutableArray# s e
dst#) (I# Int#
dstOff#) (Size (I# Int#
n#)) =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (Array# e
-> Int#
-> MutableArray# s e
-> Int#
-> Int#
-> State# s
-> State# s
forall a d.
Array# a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyArray# Array# e
src# Int#
srcOff# MutableArray# s e
dst# Int#
dstOff# Int#
n#)
{-# INLINE copyBArray #-}


-- | /O(1)/ - Convert a pure immutable boxed array into a mutable boxed array. Use
-- `freezeBMArray` in order to go in the opposite direction.
--
-- Documentation for utilized primop: `unsafeThawArray#`.
--
-- [Unsafe] This function makes it possible to break referential transparency, because any
-- subsequent destructive operation to the mutable boxed array will also be reflected in
-- the source immutable array as well. See `thawCopyBArray` that avoids this problem with
-- a fresh allocation and data copy.
--
-- ====__Examples__
--
-- >>> ma <- thawBArray $ fromListBArray [1 .. 5 :: Integer]
-- >>> writeBMArray ma 1 10
-- >>> freezeBMArray ma
-- BArray [1,10,3,4,5]
--
-- Be careful not to retain a reference to the pure immutable source array after the
-- thawed version gets mutated.
--
-- >>> let a = fromListBArray [1 .. 5 :: Integer]
-- >>> ma' <- thawBArray a
-- >>> writeBMArray ma' 0 100000
-- >>> a
-- BArray [100000,2,3,4,5]
--
-- @since 0.3.0
thawBArray ::
     forall e m s. MonadPrim s m
  => BArray e
  -- ^ /array/ - Source immutable array that will be thawed
  -> m (BMArray e s)
thawBArray :: BArray e -> m (BMArray e s)
thawBArray (BArray Array# e
a#) = (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s))
-> (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case Array# e -> State# s -> (# State# s, MutableArray# s e #)
forall a d.
Array# a -> State# d -> (# State# d, MutableArray# d a #)
unsafeThawArray# Array# e
a# State# s
s of
    (# State# s
s', MutableArray# s e
ma# #) -> (# State# s
s', MutableArray# s e -> BMArray e s
forall e s. MutableArray# s e -> BMArray e s
BMArray MutableArray# s e
ma# #)
{-# INLINE thawBArray #-}

-- TODO: add a test case for the properties
-- > ma' <- thawCopyBArray a i n
--
-- Is equivalent to:
--
-- > ma' <- newRawBMArray n >>= \ma -> ma <$ copyBArray a i ma 0 n
--
-- > thawCopyBArray a i n === thawBArray $ cloneBArray a i n
--
-- | /O(sz)/ - Create a new mutable array with size @sz@ and copy that number of elements
-- from source immutable @srcArray@ starting at an offset @startIx@ into the newly created
-- @dstMutArray@. This function can help avoid an issue with referential transparency that
-- is inherent to `thawBArray`.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault. Failure with out of memory is also a possibility when the @sz is
-- too large.
--
-- Documentation for utilized primop: `thawArray#`.
--
-- ====__Examples__
--
-- >>> let a = fromListBArray [1 .. 5 :: Int]
-- >>> ma <- thawCopyBArray a 1 3
-- >>> writeBMArray ma 1 10
-- >>> freezeBMArray ma
-- BArray [2,10,4]
-- >>> a
-- BArray [1,2,3,4,5]
--
-- @since 0.3.0
thawCopyBArray ::
     forall e m s. MonadPrim s m
  => BArray e
  -- ^ /srcArray/ - Immutable source array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned mutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfBArray srcArray)
  --
  -- Should be less then the actual available memory
  -> m (BMArray e s)
  -- ^ /dstMutArray/ - Newly created destination mutable boxed array
thawCopyBArray :: BArray e -> Int -> Size -> m (BMArray e s)
thawCopyBArray (BArray Array# e
a#) (I# Int#
i#) (Size (I# Int#
n#)) = (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s))
-> (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case Array# e
-> Int# -> Int# -> State# s -> (# State# s, MutableArray# s e #)
forall a d.
Array# a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
thawArray# Array# e
a# Int#
i# Int#
n# State# s
s of
    (# State# s
s', MutableArray# s e
ma# #) -> (# State# s
s', MutableArray# s e -> BMArray e s
forall e s. MutableArray# s e -> BMArray e s
BMArray MutableArray# s e
ma# #)
{-# INLINE thawCopyBArray #-}



-- | Convert a pure boxed array into a list. It should work fine with GHC built-in list
-- fusion.
--
-- @since 0.1.0
toListBArray :: forall e. BArray e -> [e]
toListBArray :: BArray e -> [e]
toListBArray BArray e
ba = (forall b. (e -> b -> b) -> b -> b) -> [e]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ e -> b -> b
c b
n -> (BArray e -> Size)
-> (BArray e -> Int -> e) -> (e -> b -> b) -> b -> BArray e -> b
forall (a :: * -> *) e b.
(a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray BArray e -> Int -> e
forall e. BArray e -> Int -> e
indexBArray e -> b -> b
c b
n BArray e
ba)
{-# INLINE toListBArray #-}



-- | /O(min(length list, sz))/ - Same as `fromListBArray`, except that it will allocate an
-- array exactly of @n@ size, as such it will not convert any portion of the list that
-- doesn't fit into the newly created array.
--
-- [Partial] When length of supplied list is in fact smaller then the expected size @sz@,
-- thunks with `UndefinedElement` exception throwing function will be placed in the tail
-- portion of the array.
--
-- [Unsafe] When a precondition @sz@ is violated this function can result in critical
-- failure with out of memory or `HeapOverflow` async exception.
--
-- ====__Examples__
--
-- >>> fromListBArrayN 3 [1 :: Int, 2, 3]
-- BArray [1,2,3]
-- >>> fromListBArrayN 3 [1 :: Int ..]
-- BArray [1,2,3]
--
-- @since 0.1.0
fromListBArrayN ::
     forall e. HasCallStack
  => Size -- ^ /sz/ - Expected number of elements in the @list@
  -> [e] -- ^ /list/ - A list to bew loaded into the array
  -> BArray e
fromListBArrayN :: Size -> [e] -> BArray e
fromListBArrayN Size
sz [e]
xs =
  (forall s. ST s (BArray e)) -> BArray e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (BArray e)) -> BArray e)
-> (forall s. ST s (BArray e)) -> BArray e
forall a b. (a -> b) -> a -> b
$ (Size -> ST s (BMArray e s))
-> (BMArray e s -> Int -> e -> ST s ())
-> Size
-> [e]
-> ST s (BMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b) -> (b -> Int -> a -> m ()) -> Size -> [a] -> m b
fromListMutWith Size -> ST s (BMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (BMArray e s)
newRawBMArray BMArray e s -> Int -> e -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> Int -> e -> m ()
writeBMArray Size
sz [e]
xs ST s (BMArray e s)
-> (BMArray e s -> ST s (BArray e)) -> ST s (BArray e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BMArray e s -> ST s (BArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> m (BArray e)
freezeBMArray
{-# INLINE fromListBArrayN #-}


-- | /O(length list)/ - Convert a list into an immutable boxed array. It is more efficient to use
-- `fromListBArrayN` when the number of elements is known ahead of time. The reason for this
-- is that it is necessary to iterate the whole list twice: once to count how many elements
-- there is in order to create large enough array that can fit them; and the second time to
-- load the actual elements. Naturally, infinite lists will grind the program to a halt.
--
-- ====__Example__
--
-- >>> fromListBArray "Hello Haskell"
-- BArray "Hello Haskell"
--
-- @since 0.3.0
fromListBArray :: forall e. [e] -> BArray e
fromListBArray :: [e] -> BArray e
fromListBArray [e]
xs = Size -> [e] -> BArray e
forall e. HasCallStack => Size -> [e] -> BArray e
fromListBArrayN (Int -> Size
coerce ([e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
xs)) [e]
xs
{-# INLINE fromListBArray #-}



-- | /O(1)/ - cast a boxed immutable `A.Array` that is wired with GHC to `BArray` from primal.
--
-- >>> import Data.Array.IArray as IA
-- >>> let arr = IA.listArray (10, 15) [30 .. 35] :: IA.Array Int Integer
-- >>> arr
-- array (10,15) [(10,30),(11,31),(12,32),(13,33),(14,34),(15,35)]
-- >>> fromBaseBArray arr
-- BArray [30,31,32,33,34,35]
--
-- @since 0.3.0
fromBaseBArray :: A.Array ix e -> BArray e
fromBaseBArray :: Array ix e -> BArray e
fromBaseBArray (A.Array ix
_ ix
_ Int
_ Array# e
a#) = Array# e -> BArray e
forall e. Array# e -> BArray e
BArray Array# e
a#

-- | /O(1)/ - cast a boxed `BArray` from primal into `A.Array`, which is wired with
-- GHC. Resulting array range starts at 0, like any sane array would.
--
-- >>> let arr = fromListBArray [1, 2, 3 :: Integer]
-- >>> arr
-- BArray [1,2,3]
-- >>> toBaseBArray arr
-- array (0,2) [(0,1),(1,2),(2,3)]
--
-- @since 0.3.0
toBaseBArray :: BArray e -> A.Array Int e
toBaseBArray :: BArray e -> Array Int e
toBaseBArray a :: BArray e
a@(BArray Array# e
a#) =
  let Size Int
n = BArray e -> Size
forall e. BArray e -> Size
sizeOfBArray BArray e
a
  in Int -> Int -> Int -> Array# e -> Array Int e
forall i e. i -> i -> Int -> Array# e -> Array i e
A.Array Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int
n Array# e
a#


-- Mutable Boxed Array --
-------------------------


-- | Mutable array with boxed elements.
--
-- @since 0.3.0
data BMArray e s = BMArray (MutableArray# s e)

-- | Check if both of the arrays refer to the exact same one. None of the elements are
-- evaluated.
instance Eq (BMArray e s) where
  == :: BMArray e s -> BMArray e s -> Bool
(==) = BMArray e s -> BMArray e s -> Bool
forall a s. BMArray a s -> BMArray a s -> Bool
isSameBMArray
  {-# INLINE (==) #-}


-- | Compare pointers for two mutable arrays and see if they refer to the exact same one.
--
-- Documentation for utilized primop: `sameMutableArray#`.
--
-- @since 0.3.0
isSameBMArray :: forall a s. BMArray a s -> BMArray a s -> Bool
isSameBMArray :: BMArray a s -> BMArray a s -> Bool
isSameBMArray (BMArray MutableArray# s a
ma1#) (BMArray MutableArray# s a
ma2#) =
  Int# -> Bool
isTrue# (MutableArray# s a -> MutableArray# s a -> Int#
forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# MutableArray# s a
ma1# MutableArray# s a
ma2#)
{-# INLINE isSameBMArray #-}

-- | /O(1)/ - Get the size of a mutable boxed array
--
-- Documentation for utilized primop: `sizeofMutableArray#`.
--
-- ====__Example__
--
-- >>> ma <- newBMArray 1024 "Element of each cell"
-- >>> getSizeOfBMArray ma
-- Size {unSize = 1024}
--
-- @since 0.3.0
getSizeOfBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s
  -> m Size
getSizeOfBMArray :: BMArray e s -> m Size
getSizeOfBMArray (BMArray MutableArray# s e
ma#) = --pure $! Size (I# (sizeofMutableArray# ma#))
  (State# s -> (# State# s, Size #)) -> m Size
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Size #)) -> m Size)
-> (State# s -> (# State# s, Size #)) -> m Size
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableArray# s e -> State# s -> (# State# s, Int# #)
forall s a. MutableArray# s a -> State# s -> (# State# s, Int# #)
getSizeofMutableArray# MutableArray# s e
ma# State# s
s of
      (# State# s
s', Int#
n# #) -> (# State# s
s', Int -> Size
coerce (Int# -> Int
I# Int#
n#) #)
{-# INLINE getSizeOfBMArray #-}

-- | /O(1)/ - Read an element from a mutable boxed array at the supplied index.
--
-- Documentation for utilized primop: `readArray#`.
--
-- [Unsafe] Violation of @ix@ preconditions can result in undefined behavior or a failure
-- with a segfault
--
-- ==== __Example__
--
-- >>> ma <- makeBMArray 10 (pure . ("Element ix: " ++) . show)
-- >>> readBMArray ma 5
-- "Element ix: 5"
--
-- @since 0.1.0
readBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s -- ^ /srcMutArray/ - Array to read an element from
  -> Int
  -- ^ /ix/ - Index that refers to an element we need within the the @srcMutArray@
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > ix < unSize (sizeOfMBArray srcMutArray)
  -> m e
readBMArray :: BMArray e s -> Int -> m e
readBMArray (BMArray MutableArray# s e
ma#) (I# Int#
i#) = (State# s -> (# State# s, e #)) -> m e
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (MutableArray# s e -> Int# -> State# s -> (# State# s, e #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# MutableArray# s e
ma# Int#
i#)
{-# INLINE readBMArray #-}



-- | /O(1)/ - Write an element @elt@ into the mutable boxed array @dstMutArray@ at the
-- supplied index @ix@. The actual element will be evaluated to WHNF prior to mutation.
--
-- [Unsafe] Violation of @ix@ preconditions can result in heap corruption or a failure
-- with a segfault
--
-- ==== __Examples__
--
-- >>> ma <- newBMArray 4 (Nothing :: Maybe Integer)
-- >>> writeBMArray ma 2 (Just 2)
-- >>> freezeBMArray ma
-- BArray [Nothing,Nothing,Just 2,Nothing]
--
-- It is important to note that an element is evaluated prior to being written into a
-- cell, so it will not overwrite the value of an array's cell if it evaluates to an
-- exception:
--
-- >>> import Control.Prim.Exception
-- >>> writeBMArray ma 2 (impureThrow DivideByZero)
-- *** Exception: divide by zero
-- >>> freezeBMArray ma
-- BArray [Nothing,Nothing,Just 2,Nothing]
--
-- However, it is evaluated only to Weak Head Normal Form (WHNF), so it is still possible
-- to write something that eventually evaluates to bottom.
--
-- >>> writeBMArray ma 3 (Just (7 `div` 0 ))
-- >>> freezeBMArray ma
-- BArray [Nothing,Nothing,Just 2,Just *** Exception: divide by zero
-- >>> readBMArray ma 3
-- Just *** Exception: divide by zero
--
-- Either `deepseq` or `writeDeepBMArray` can be used to alleviate that.
--
-- @since 0.3.0
writeBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s -- ^ /dstMutArray/ - An array to have the element written to
  -> Int
  -- ^ /ix/ - Index within the the @dstMutArray@ that a refernce to the supplied element
  -- @elt@ will be written to.
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > ix < unSize (sizeOfMBArray srcArray)
  -> e
  -- ^ /elt/ - Element to be written into @dstMutArray@
  -> m ()
writeBMArray :: BMArray e s -> Int -> e -> m ()
writeBMArray BMArray e s
ma Int
i !e
x = BMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> Int -> e -> m ()
writeLazyBMArray BMArray e s
ma Int
i e
x -- TODO: figure out why doctests fail sporadically
--writeBMArray ma i = eval >=> writeLazyBMArray ma i
{-# INLINE writeBMArray #-}

{-
src/Data/Prim/Array.hs:697: failure in expression `freezeBMArray ma'
expected: BArray [Nothing,Nothing,Just 2,Just *** Exception: divide by zero
 but got: BArray [Nothing,Nothing,Just 2,Just 5282521669542503534]
                                              ^
Examples: 180  Tried: 63  Errors: 0  Failures: 1doctests: user error (Language.Haskell.GhciWrapper.close: Interpreter exited with an error (ExitFailure (-6)))
primal> Test suite doctests failed
Test suite failure for package primal-0.3.0.0
    doctests:  exited with: ExitFailure 1
Logs printed to console


Examples: 180  Tried: 26  Errors: 0  Failures: 0doctests: user error (Language.Haskell.GhciWrapper.close: Interpreter exited with an error (ExitFailure (-11)))
primal> Test suite doctests failed
Test suite failure for package primal-0.3.0.0
    doctests:  exited with: ExitFailure 1

https://travis-ci.com/github/lehins/primal/jobs/407895714
[34/180] src/Data/Prim/Array.hs:699: failure in expression `readBMArray ma 3'
expected: Just *** Exception: divide by zero
 but got: Just 140663761379224
               ^
-}

-- | /O(1)/ - Same as `writeBMArray` but allows to write a thunk into an array instead of an
-- evaluated element. Careful with memory leaks and thunks that evaluate to exceptions.
--
-- Documentation for utilized primop: `writeArray#`.
--
-- [Unsafe] Same reasons as `writeBMArray`
--
-- @since 0.3.0
writeLazyBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s
  -> Int
  -> e
  -> m ()
writeLazyBMArray :: BMArray e s -> Int -> e -> m ()
writeLazyBMArray (BMArray MutableArray# s e
ma#) (I# Int#
i#) e
a = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableArray# s e -> Int# -> e -> State# s -> State# s
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# MutableArray# s e
ma# Int#
i# e
a)
{-# INLINE writeLazyBMArray #-}


-- | /O(1)/ - Same as `writeBMArray`, except it ensures that the value being written is
-- fully evaluated, i.e. to Normal Form (NF).
--
-- [Unsafe] Same reasons as `writeBMArray`
--
-- @since 0.3.0
writeDeepBMArray ::
     forall e m s. (MonadPrim s m, NFData e)
  => BMArray e s
  -> Int
  -> e
  -> m ()
writeDeepBMArray :: BMArray e s -> Int -> e -> m ()
writeDeepBMArray BMArray e s
ma Int
i !e
x =
  case e -> ()
forall a. NFData a => a -> ()
rnf e
x of
    () -> BMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> Int -> e -> m ()
writeLazyBMArray BMArray e s
ma Int
i e
x
{-# INLINE writeDeepBMArray #-}



-- | Create a mutable boxed array where each element is set to the supplied initial value
-- @elt@, which is evaluated before array allocation happens. See `newLazyBMArray` for
-- an ability to initialize with a thunk.
--
-- [Unsafe size] Violation of precondition for the @sz@ argument can result in the current
-- thread being killed with `HeapOverflow` asynchronous exception or death of the whole
-- process with some unchecked exception from RTS.
--
-- ====__Examples__
--
-- >>> newBMArray 10 'A' >>= freezeBMArray
-- BArray "AAAAAAAAAA"
--
-- @since 0.3.0
newBMArray ::
     forall e m s. MonadPrim s m
  => Size
  -- ^ /sz/ - Size of the array
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> e -- ^ /elt/ - Value to use for all array cells
  -> m (BMArray e s)
newBMArray :: Size -> e -> m (BMArray e s)
newBMArray Size
sz e
x = e
x e -> m (BMArray e s) -> m (BMArray e s)
`seq` Size -> e -> m (BMArray e s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> e -> m (BMArray e s)
newLazyBMArray Size
sz e
x
{-# INLINE newBMArray #-}

-- | Same as `newBMArray`, except initial element is allowed to be a thunk.
--
-- Documentation for utilized primop: `newArray#`.
--
-- [Unsafe] Same reasons as `newBMArray`
--
-- @since 0.3.0
newLazyBMArray ::
     forall e m s. MonadPrim s m
  => Size
  -> e
  -> m (BMArray e s)
newLazyBMArray :: Size -> e -> m (BMArray e s)
newLazyBMArray (Size (I# Int#
n#)) e
a =
  (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s))
-> (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case Int# -> e -> State# s -> (# State# s, MutableArray# s e #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
n# e
a State# s
s of
      (# State# s
s', MutableArray# s e
ma# #) -> (# State# s
s', MutableArray# s e -> BMArray e s
forall e s. MutableArray# s e -> BMArray e s
BMArray MutableArray# s e
ma# #)
{-# INLINE newLazyBMArray #-}




-- | Create new mutable array, where each element is initilized to a thunk that throws an
-- error when evaluated. This is useful when there is a plan to later iterate over the whole
-- array and write values into each cell in some index aware fashion. Consider `makeBMArray`
-- as an alternative.
--
-- [Partial] All array cells are initialized with thunks that throw `UndefinedElement`
-- exception when evaluated
--
-- [Unsafe] Same reasons as `newBMArray`
--
-- ==== __Examples__
--
-- >>> import Data.Prim
-- >>> let xs = "Hello Haskell"
-- >>> ma <- newRawBMArray (Size (length xs)) :: IO (BMArray Char RW)
-- >>> mapM_ (\(i, x) -> writeBMArray ma i x) (zip [0..] xs)
-- >>> freezeBMArray ma
-- BArray "Hello Haskell"
--
-- @since 0.3.0
newRawBMArray ::
     forall e m s. (HasCallStack, MonadPrim s m)
  => Size
  -> m (BMArray e s)
newRawBMArray :: Size -> m (BMArray e s)
newRawBMArray Size
sz = Size -> e -> m (BMArray e s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> e -> m (BMArray e s)
newLazyBMArray Size
sz (String -> String -> e
forall a. HasCallStack => String -> String -> a
uninitialized String
"Data.Prim.Aray" String
"newRawBMArray")
{-# INLINE newRawBMArray #-}



-- | Create new mutable boxed array of the supplied size and fill it with a monadic action
-- that is applied to indices of each array cell.
--
-- [Unsafe] Same reasons as `newBMArray`
--
-- ====__Examples__
--
-- >>> ma <- makeBMArray 5 $ \i -> (toEnum (i + 97) :: Char) <$ putStrLn ("Handling index: " ++ show i)
-- Handling index: 0
-- Handling index: 1
-- Handling index: 2
-- Handling index: 3
-- Handling index: 4
-- >>> freezeBMArray ma
-- BArray "abcde"
--
-- @since 0.3.0
makeBMArray ::
     forall e m s. MonadPrim s m
  => Size
  -> (Int -> m e)
  -> m (BMArray e s)
makeBMArray :: Size -> (Int -> m e) -> m (BMArray e s)
makeBMArray = (Size -> m (BMArray e s))
-> (BMArray e s -> Int -> e -> m ())
-> Size
-> (Int -> m e)
-> m (BMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b)
-> (b -> Int -> a -> m ()) -> Size -> (Int -> m a) -> m b
makeMutWith Size -> m (BMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (BMArray e s)
newRawBMArray BMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> Int -> e -> m ()
writeBMArray
{-# INLINE makeBMArray #-}


-- | /O(1)/ - Convert a mutable boxed array into an immutable one. Use `thawBArray` in order
-- to go in the opposite direction.
--
-- Documentation for utilized primop: `unsafeFreezeArray#`.
--
-- [Unsafe] This function makes it possible to break referential transparency, because any
-- subsequent destructive operation to the source mutable boxed array will also be reflected
-- in the resulting immutable array. See `freezeCopyBMArray` that avoids this problem with
-- fresh allocation.
--
-- @since 0.3.0
freezeBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s
  -> m (BArray e)
freezeBMArray :: BMArray e s -> m (BArray e)
freezeBMArray (BMArray MutableArray# s e
ma#) = (State# s -> (# State# s, BArray e #)) -> m (BArray e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, BArray e #)) -> m (BArray e))
-> (State# s -> (# State# s, BArray e #)) -> m (BArray e)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case MutableArray# s e -> State# s -> (# State# s, Array# e #)
forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
unsafeFreezeArray# MutableArray# s e
ma# State# s
s of
    (# State# s
s', Array# e
a# #) -> (# State# s
s', Array# e -> BArray e
forall e. Array# e -> BArray e
BArray Array# e
a# #)
{-# INLINE freezeBMArray #-}



-- | /O(sz)/ - Similar to `freezeBMArray`, except it creates a new array with the copy of a
-- subsection of a mutable array before converting it into an immutable.
--
-- Documentation for utilized primop: `freezeArray#`.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault or out of memory exception.
--
-- @since 0.3.0
freezeCopyBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s
  -- ^ /srcArray/ - Source mutable array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned immutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfBArray srcArray)
  --
  -- Should be less then actual available memory
  -> m (BArray e)
freezeCopyBMArray :: BMArray e s -> Int -> Size -> m (BArray e)
freezeCopyBMArray (BMArray MutableArray# s e
ma#) (I# Int#
i#) (Size (I# Int#
n#)) = (State# s -> (# State# s, BArray e #)) -> m (BArray e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, BArray e #)) -> m (BArray e))
-> (State# s -> (# State# s, BArray e #)) -> m (BArray e)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case MutableArray# s e
-> Int# -> Int# -> State# s -> (# State# s, Array# e #)
forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, Array# a #)
freezeArray# MutableArray# s e
ma# Int#
i# Int#
n# State# s
s of
    (# State# s
s', Array# e
a# #) -> (# State# s
s', Array# e -> BArray e
forall e. Array# e -> BArray e
BArray Array# e
a# #)
{-# INLINE freezeCopyBMArray #-}

-- TODO:
-- prop> cloneBMArray ma i n === freezeCopyBMArray ma i n >>= thawBArray
-- prop> cloneBMArray ma i n === newBMArray n undefined >>= \mb -> mb <$ moveBMArray ma i mb 0 n
-- | /O(sz)/ - Allocate a new mutable array of size @sz@ and copy that number of the
-- elements over from the @srcArray@ starting at index @ix@. Similar to `cloneBArray`,
-- except it works on mutable arrays.
--
-- Documentation for utilized primop: `cloneMutableArray#`.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault. Failure with out of memory is also a possibility when the @sz is
-- too large.
--
-- @since 0.3.0
cloneBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s
  -- ^ /srcArray/ - Source mutable array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned mutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfBArray srcArray)
  --
  -- Should be less then actual available memory
  -> m (BMArray e s)
cloneBMArray :: BMArray e s -> Int -> Size -> m (BMArray e s)
cloneBMArray (BMArray MutableArray# s e
ma#) (I# Int#
i#) (Size (I# Int#
n#)) =
  (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s))
-> (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableArray# s e
-> Int# -> Int# -> State# s -> (# State# s, MutableArray# s e #)
forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
cloneMutableArray# MutableArray# s e
ma# Int#
i# Int#
n# State# s
s of
      (# State# s
s', MutableArray# s e
ma'# #) -> (# State# s
s', MutableArray# s e -> BMArray e s
forall e s. MutableArray# s e -> BMArray e s
BMArray MutableArray# s e
ma'# #)
{-# INLINE cloneBMArray #-}



-- | /O(1)/ - Reduce the size of a mutable boxed array.
--
-- Documentation for utilized primop: `shrinkMutableArray#`.
--
-- [Unsafe] - Violation of preconditions for @sz@ leads to undefined behavior
--
-- 0.3.0
shrinkBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s -- ^ /mutArray/ - Mutable unboxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > curSize <- getSizeOfBMArray mutArray
  -- > sz <= curSize
  -> m ()
shrinkBMArray :: BMArray e s -> Size -> m ()
shrinkBMArray (BMArray MutableArray# s e
ma#) (Size (I# Int#
sz#)) =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableArray# s e -> Int# -> State# s -> State# s
forall s a. MutableArray# s a -> Int# -> State# s -> State# s
shrinkMutableArray# MutableArray# s e
ma# Int#
sz#)
{-# INLINE shrinkBMArray #-}


-- | /O(1)/ - Either grow or shrink the size of a mutable unboxed array. Shrinking happens
-- in-place without new array creation and data copy, while growing the array is
-- implemented with creating new array and copy of the data over from the source array
-- @srcMutArray@. This has a consequence that produced array @dstMutArray@ might refer to
-- the same @srcMutArray@ or to a totally new array, which can be checked with
-- `isSameBMArray`.
--
-- Documentation on the utilized primop: `resizeMutableArray#`.
--
-- [Unsafe] - Same reasons as in `newRawBMArray`.
--
-- 0.3.0
resizeBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s -- ^ /srcMutArray/ - Mutable boxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> e
  -- ^ /elt/ - Element to write into extra space at the end when growing the array.
  -> m (BMArray e s) -- ^ /dstMutArray/ - produces a resized version of /srcMutArray/.
resizeBMArray :: BMArray e s -> Size -> e -> m (BMArray e s)
resizeBMArray (BMArray MutableArray# s e
ma#) (Size (I# Int#
sz#)) e
e =
  (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s))
-> (State# s -> (# State# s, BMArray e s #)) -> m (BMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableArray# s e
-> Int# -> e -> State# s -> (# State# s, MutableArray# s e #)
forall s a.
MutableArray# s a
-> Int# -> a -> State# s -> (# State# s, MutableArray# s a #)
resizeMutableArray# MutableArray# s e
ma# Int#
sz# e
e State# s
s of
      (# State# s
s', MutableArray# s e
ma'# #) -> (# State# s
s', MutableArray# s e -> BMArray e s
forall e s. MutableArray# s e -> BMArray e s
BMArray MutableArray# s e
ma'# #)
{-# INLINE resizeBMArray #-}

-- | /O(1)/ - Same as `resizeBMArray`, except when growing the array empty space at the
-- end is filled with bottom.
--
-- [Partial] - When size @sz@ is larger then the size of @srcMutArray@ then @dstMutArray@
-- will have cells at the end initialized with thunks that throw `UndefinedElement`
-- exception.
--
-- [Unsafe] - Same reasons as in `newBMArray`.
--
-- 0.3.0
resizeRawBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s -- ^ /srcMutArray/ - Mutable boxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> m (BMArray e s) -- ^ /dstMutArray/ - produces a resized version of /srcMutArray/.
resizeRawBMArray :: BMArray e s -> Size -> m (BMArray e s)
resizeRawBMArray BMArray e s
ma Size
sz = BMArray e s -> Size -> e -> m (BMArray e s)
forall e (m :: * -> *) s.
MonadPrim s m =>
BMArray e s -> Size -> e -> m (BMArray e s)
resizeBMArray BMArray e s
ma Size
sz (String -> String -> e
forall a. HasCallStack => String -> String -> a
uninitialized String
"Data.Prim.Aray" String
"resizeRawBMArray")
{-# INLINE resizeRawBMArray #-}


-- | /O(sz)/ - Copy a subsection of a mutable array into a subsection of another or the same
-- mutable array. Therefore, unlike `copyBArray`, memory ia allowed to overlap between source
-- and destination.
--
-- Documentation for utilized primop: `copyMutableArray#`.
--
-- [Unsafe] When any of the preconditions for @srcStartIx@, @dstStartIx@ or @sz@ is violated
-- this function can result in a copy of some data that doesn't belong to @srcArray@ or more
-- likely a failure with a segfault.
--
-- @since 0.3.0
moveBMArray ::
     forall e m s. MonadPrim s m
  => BMArray e s -- ^ /srcMutArray/ - Source mutable array
  -> Int
  -- ^ /srcStartIx/ - Offset into the source mutable array where copy should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= srcStartIx
  --
  -- > srcSize <- getSizeOfBMArray srcMutArray
  -- > srcStartIx < unSize srcSize
  -> BMArray e s -- ^ /dstMutArray/ - Destination mutable array
  -> Int
  -- ^ /dstStartIx/ - Offset into the destination mutable array where copy should start to
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= dstStartIx
  --
  -- > dstSize <- getSizeOfBMArray dstMutArray
  -- > dstStartIx < unSize dstSize
  -> Size
  -- ^ /sz/ - Number of elements to copy over
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > srcSize <- getSizeOfBMArray srcMutArray
  -- > srcStartIx + unSize sz < unSize srcSize
  --
  -- > dstSize <- getSizeOfBMArray dstMutArray
  -- > dstStartIx + unSize sz < unSize dstSize
  --
  -> m ()
moveBMArray :: BMArray e s -> Int -> BMArray e s -> Int -> Size -> m ()
moveBMArray (BMArray MutableArray# s e
src#) (I# Int#
srcOff#) (BMArray MutableArray# s e
dst#) (I# Int#
dstOff#) (Size (I# Int#
n#)) =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableArray# s e
-> Int#
-> MutableArray# s e
-> Int#
-> Int#
-> State# s
-> State# s
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray# MutableArray# s e
src# Int#
srcOff# MutableArray# s e
dst# Int#
dstOff# Int#
n#)
{-# INLINE moveBMArray #-}


-----------------------
-- Small Boxed Array --
-- ================= --


-- Immutable Small Boxed Array --
---------------------------------

-- | Small boxed immutable array
data SBArray e = SBArray (SmallArray# e)


-- | @since 0.3.0
instance Functor SBArray where
  fmap :: (a -> b) -> SBArray a -> SBArray b
fmap a -> b
f SBArray a
a =
    (forall s. ST s (SBArray b)) -> SBArray b
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SBArray b)) -> SBArray b)
-> (forall s. ST s (SBArray b)) -> SBArray b
forall a b. (a -> b) -> a -> b
$
    Size -> (Int -> ST s b) -> ST s (SBMArray b s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> (Int -> m e) -> m (SBMArray e s)
makeSBMArray
      (SBArray a -> Size
forall e. SBArray e -> Size
sizeOfSBArray SBArray a
a)
      (b -> ST s b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> ST s b) -> (Int -> b) -> Int -> ST s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Int -> a) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBArray a -> Int -> a
forall e. SBArray e -> Int -> e
indexSBArray SBArray a
a) ST s (SBMArray b s)
-> (SBMArray b s -> ST s (SBArray b)) -> ST s (SBArray b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SBMArray b s -> ST s (SBArray b)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray
  {-# INLINE fmap #-}
  <$ :: a -> SBArray b -> SBArray a
(<$) a
x SBArray b
a = (forall s. ST s (SBArray a)) -> SBArray a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SBArray a)) -> SBArray a)
-> (forall s. ST s (SBArray a)) -> SBArray a
forall a b. (a -> b) -> a -> b
$ Size -> a -> ST s (SBMArray a s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> e -> m (SBMArray e s)
newLazySBMArray (SBArray b -> Size
forall e. SBArray e -> Size
sizeOfSBArray SBArray b
a) a
x ST s (SBMArray a s)
-> (SBMArray a s -> ST s (SBArray a)) -> ST s (SBArray a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SBMArray a s -> ST s (SBArray a)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray
  {-# INLINE (<$) #-}

-- | @since 0.3.0
instance Foldable SBArray where
  null :: SBArray a -> Bool
null = (Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
0) (Size -> Bool) -> (SBArray a -> Size) -> SBArray a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBArray a -> Size
forall e. SBArray e -> Size
sizeOfSBArray
  {-# INLINE null #-}
  length :: SBArray a -> Int
length = Size -> Int
coerce (Size -> Int) -> (SBArray a -> Size) -> SBArray a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBArray a -> Size
forall e. SBArray e -> Size
sizeOfSBArray
  {-# INLINE length #-}
  foldr :: (a -> b -> b) -> b -> SBArray a -> b
foldr = (SBArray a -> Size)
-> (SBArray a -> Int -> a) -> (a -> b -> b) -> b -> SBArray a -> b
forall (a :: * -> *) e b.
(a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB SBArray a -> Size
forall e. SBArray e -> Size
sizeOfSBArray SBArray a -> Int -> a
forall e. SBArray e -> Int -> e
indexSBArray
  {-# INLINE foldr #-}

instance Show1 SBArray where
#if MIN_VERSION_transformers(0,5,0)
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SBArray a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ = String -> ([a] -> ShowS) -> Int -> SBArray a -> ShowS
forall (f :: * -> *) e.
Foldable f =>
String -> ([e] -> ShowS) -> Int -> f e -> ShowS
liftShowsPrecArray String
"SBArray"
#else
  showsPrec1 = liftShowsPrecArray "SBArray" showList
#endif

instance Show e => Show (SBArray e) where
  showsPrec :: Int -> SBArray e -> ShowS
showsPrec = Int -> SBArray e -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance IsList (SBArray e) where
  type Item (SBArray e) = e
  fromList :: [Item (SBArray e)] -> SBArray e
fromList = [Item (SBArray e)] -> SBArray e
forall e. [e] -> SBArray e
fromListSBArray
  {-# INLINE fromList #-}
  fromListN :: Int -> [Item (SBArray e)] -> SBArray e
fromListN Int
n = Size -> [e] -> SBArray e
forall e. HasCallStack => Size -> [e] -> SBArray e
fromListSBArrayN (Int -> Size
coerce Int
n)
  {-# INLINE fromListN #-}
  toList :: SBArray e -> [Item (SBArray e)]
toList = SBArray e -> [Item (SBArray e)]
forall a. SBArray a -> [a]
toListSBArray
  {-# INLINE toList #-}

instance e ~ Char => IsString (SBArray e) where
  fromString :: String -> SBArray e
fromString = String -> SBArray e
forall e. [e] -> SBArray e
fromListSBArray
  {-# INLINE fromString #-}

instance NFData e => NFData (SBArray e) where
  rnf :: SBArray e -> ()
rnf = (SBArray e -> Size)
-> (SBArray e -> Int -> e)
-> (e -> () -> ())
-> ()
-> SBArray e
-> ()
forall (a :: * -> *) e b.
(a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray SBArray e -> Int -> e
forall e. SBArray e -> Int -> e
indexSBArray e -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq ()
  {-# INLINE rnf #-}


instance Eq e => Eq (SBArray e) where
  == :: SBArray e -> SBArray e -> Bool
(==) = (SBArray e -> SBArray e -> Bool)
-> (SBArray e -> Size)
-> (SBArray e -> Int -> e)
-> SBArray e
-> SBArray e
-> Bool
forall e (a :: * -> *).
Eq e =>
(a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Bool
eqWith SBArray e -> SBArray e -> Bool
forall a. SBArray a -> SBArray a -> Bool
isSameSBArray SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray SBArray e -> Int -> e
forall e. SBArray e -> Int -> e
indexSBArray
  {-# INLINE (==) #-}

instance Ord e => Ord (SBArray e) where
  compare :: SBArray e -> SBArray e -> Ordering
compare = (SBArray e -> SBArray e -> Bool)
-> (SBArray e -> Size)
-> (SBArray e -> Int -> e)
-> SBArray e
-> SBArray e
-> Ordering
forall e (a :: * -> *).
Ord e =>
(a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Ordering
compareWith SBArray e -> SBArray e -> Bool
forall a. SBArray a -> SBArray a -> Bool
isSameSBArray SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray SBArray e -> Int -> e
forall e. SBArray e -> Int -> e
indexSBArray
  {-# INLINE compare #-}

instance Eq1 SBArray where
#if MIN_VERSION_transformers(0,5,0)
  liftEq :: (a -> b -> Bool) -> SBArray a -> SBArray b -> Bool
liftEq = (forall e. SBArray e -> Size)
-> (forall e. SBArray e -> Int -> e)
-> (a -> b -> Bool)
-> SBArray a
-> SBArray b
-> Bool
forall (a :: * -> *) b c.
(forall e. a e -> Size)
-> (forall e. a e -> Int -> e)
-> (b -> c -> Bool)
-> a b
-> a c
-> Bool
liftEqWith forall e. SBArray e -> Size
sizeOfSBArray forall e. SBArray e -> Int -> e
indexSBArray
  {-# INLINE liftEq #-}
#else
  eq1 = liftEqWith sizeOfSBArray indexSBArray (==)
  {-# INLINE eq1 #-}
#endif

instance Ord1 SBArray where
#if MIN_VERSION_transformers(0,5,0)
  liftCompare :: (a -> b -> Ordering) -> SBArray a -> SBArray b -> Ordering
liftCompare = (forall e. SBArray e -> Size)
-> (forall e. SBArray e -> Int -> e)
-> (a -> b -> Ordering)
-> SBArray a
-> SBArray b
-> Ordering
forall (a :: * -> *) b c.
(forall e. a e -> Size)
-> (forall e. a e -> Int -> e)
-> (b -> c -> Ordering)
-> a b
-> a c
-> Ordering
liftCompareWith forall e. SBArray e -> Size
sizeOfSBArray forall e. SBArray e -> Int -> e
indexSBArray
  {-# INLINE liftCompare #-}
#else
  compare1 = liftCompareWith sizeOfSBArray indexSBArray compare
  {-# INLINE compare1 #-}
#endif


instance Semigroup (SBArray e) where
  <> :: SBArray e -> SBArray e -> SBArray e
(<>) = (forall s. Size -> ST s (SBMArray e s))
-> (forall s.
    SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ())
-> (forall s. SBMArray e s -> ST s (SBArray e))
-> (SBArray e -> Size)
-> SBArray e
-> SBArray e
-> SBArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> a e
-> a e
-> a e
appendWith forall s. Size -> ST s (SBMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (SBMArray e s)
newRawSBMArray forall s.
SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBArray e -> Int -> SBMArray e s -> Int -> Size -> m ()
copySBArray forall s. SBMArray e s -> ST s (SBArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray
  {-# INLINE (<>) #-}
  sconcat :: NonEmpty (SBArray e) -> SBArray e
sconcat NonEmpty (SBArray e)
xs = (forall s. Size -> ST s (SBMArray e s))
-> (forall s.
    SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ())
-> (forall s. SBMArray e s -> ST s (SBArray e))
-> (SBArray e -> Size)
-> [SBArray e]
-> SBArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> [a e]
-> a e
concatWith forall s. Size -> ST s (SBMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (SBMArray e s)
newRawSBMArray forall s.
SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBArray e -> Int -> SBMArray e s -> Int -> Size -> m ()
copySBArray forall s. SBMArray e s -> ST s (SBArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray (NonEmpty (SBArray e) -> [SBArray e]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (SBArray e)
xs)
  {-# INLINE sconcat #-}
  stimes :: b -> SBArray e -> SBArray e
stimes b
n = (forall s. Size -> ST s (SBMArray e s))
-> (forall s.
    SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ())
-> (forall s. SBMArray e s -> ST s (SBArray e))
-> (SBArray e -> Size)
-> Int
-> SBArray e
-> SBArray e
forall (a :: * -> *) e (ma :: * -> * -> *).
Monoid (a e) =>
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> Int
-> a e
-> a e
cycleWith forall s. Size -> ST s (SBMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (SBMArray e s)
newRawSBMArray forall s.
SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBArray e -> Int -> SBMArray e s -> Int -> Size -> m ()
copySBArray forall s. SBMArray e s -> ST s (SBArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n)
  {-# INLINE stimes #-}

instance Monoid (SBArray e) where
  mempty :: SBArray e
mempty = (forall s. ST s (SBArray e)) -> SBArray e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SBArray e)) -> SBArray e)
-> (forall s. ST s (SBArray e)) -> SBArray e
forall a b. (a -> b) -> a -> b
$ Size -> ST s (SBMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (SBMArray e s)
newRawSBMArray Size
0 ST s (SBMArray e s)
-> (SBMArray e s -> ST s (SBArray e)) -> ST s (SBArray e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SBMArray e s -> ST s (SBArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray
  {-# NOINLINE mempty #-}
  mappend :: SBArray e -> SBArray e -> SBArray e
mappend = SBArray e -> SBArray e -> SBArray e
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}
  mconcat :: [SBArray e] -> SBArray e
mconcat = (forall s. Size -> ST s (SBMArray e s))
-> (forall s.
    SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ())
-> (forall s. SBMArray e s -> ST s (SBArray e))
-> (SBArray e -> Size)
-> [SBArray e]
-> SBArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> [a e]
-> a e
concatWith forall s. Size -> ST s (SBMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (SBMArray e s)
newRawSBMArray forall s.
SBArray e -> Int -> SBMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBArray e -> Int -> SBMArray e s -> Int -> Size -> m ()
copySBArray forall s. SBMArray e s -> ST s (SBArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray
  {-# INLINE mconcat #-}


-- | Compare pointers for two immutable arrays and see if they refer to the exact same one.
--
-- @since 0.3.0
isSameSBArray :: SBArray a -> SBArray a -> Bool
isSameSBArray :: SBArray a -> SBArray a -> Bool
isSameSBArray SBArray a
a1 SBArray a
a2 = (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (SBMArray a s -> SBMArray a s -> Bool
forall a s. SBMArray a s -> SBMArray a s -> Bool
isSameSBMArray (SBMArray a s -> SBMArray a s -> Bool)
-> ST s (SBMArray a s) -> ST s (SBMArray a s -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SBArray a -> ST s (SBMArray a s)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBArray e -> m (SBMArray e s)
thawSBArray SBArray a
a1 ST s (SBMArray a s -> Bool) -> ST s (SBMArray a s) -> ST s Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SBArray a -> ST s (SBMArray a s)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBArray e -> m (SBMArray e s)
thawSBArray SBArray a
a2)
{-# INLINE isSameSBArray #-}

-- | /O(1)/ - Get the number of elements in an immutable array
--
-- Documentation for utilized primop: `sizeofSmallArray#`.
--
-- @since 0.3.0
sizeOfSBArray :: forall e. SBArray e -> Size
sizeOfSBArray :: SBArray e -> Size
sizeOfSBArray (SBArray SmallArray# e
a#) = Int -> Size
Size (Int# -> Int
I# (SmallArray# e -> Int#
forall a. SmallArray# a -> Int#
sizeofSmallArray# SmallArray# e
a#))
{-# INLINE sizeOfSBArray #-}


-- | /O(1)/ - Index an element in the immutable small boxed array.
--
-- Documentation for utilized primop: `indexSmallArray#`.
--
-- [Unsafe] Bounds are not checked. When a precondition for @ix@ argument is violated the
-- result is either unpredictable output or failure with a segfault.
--
-- ==== __Examples__
--
-- >>> import Data.Prim.Array
-- >>> let a = fromListSBArray [[0 .. i] | i <- [0 .. 10 :: Int]]
-- >>> indexSBArray a 1
-- [0,1]
-- >>> indexSBArray a 5
-- [0,1,2,3,4,5]
--
-- @since 0.3.0
indexSBArray ::
     forall e.
     SBArray e
  -- ^ /array/ - Array where to lookup an element from
  -> Int
  -- ^ /ix/ - Position of the element within the @array@
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > ix < unSize (sizeOfSBArray array)
  -> e
indexSBArray :: SBArray e -> Int -> e
indexSBArray (SBArray SmallArray# e
a#) (I# Int#
i#) =
  case SmallArray# e -> Int# -> (# e #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# e
a# Int#
i# of
    (# e
x #) -> e
x
{-# INLINE indexSBArray #-}



-- | /O(sz)/ - Make an exact copy of a subsection of a pure immutable array.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault. Failure with out of memory is also a possibility when the @sz is
-- too large.
--
-- Documentation for utilized primop: `cloneSmallArray#`.
--
-- ====__Examples__
--
-- >>> let a = fromListSBArray ['a'..'z']
-- >>> a
-- SBArray "abcdefghijklmnopqrstuvwxyz"
-- >>> cloneSBArray a 23 3
-- SBArray "xyz"
--
-- @since 0.3.0
cloneSBArray ::
     forall e.
     SBArray e
  -- ^ /srcArray/ - Immutable source array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfSBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned immutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfSBArray srcArray)
  --
  -- Should be less then the actual available memory
  -> SBArray e
cloneSBArray :: SBArray e -> Int -> Size -> SBArray e
cloneSBArray (SBArray SmallArray# e
a#) (I# Int#
i#) (Size (I# Int#
n#)) = SmallArray# e -> SBArray e
forall e. SmallArray# e -> SBArray e
SBArray (SmallArray# e -> Int# -> Int# -> SmallArray# e
forall a. SmallArray# a -> Int# -> Int# -> SmallArray# a
cloneSmallArray# SmallArray# e
a# Int#
i# Int#
n#)
{-# INLINE cloneSBArray #-}



-- | /O(1)/ - Reduce the size of a mutable small boxed array.
--
-- Documentation for utilized primop: `shrinkSmallMutableArray#`.
--
-- [Unsafe] - Violation of preconditions for @sz@ leads to undefined behavior
--
-- 0.3.0
shrinkSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s -- ^ /mutArray/ - Mutable unboxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > curSize <- getSizeOfSBMArray mutArray
  -- > sz <= curSize
  -> m ()
shrinkSBMArray :: SBMArray e s -> Size -> m ()
shrinkSBMArray (SBMArray SmallMutableArray# s e
ma#) (Size (I# Int#
sz#)) =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (SmallMutableArray# s e -> Int# -> State# s -> State# s
forall d a. SmallMutableArray# d a -> Int# -> State# d -> State# d
shrinkSmallMutableArray# SmallMutableArray# s e
ma# Int#
sz#)
{-# INLINE shrinkSBMArray #-}


-- | /O(1)/ - Either grow or shrink the size of a mutable unboxed array. Shrinking happens
-- in-place without new array creation and data copy, while growing the array is
-- implemented with creating new array and copy of the data over from the source array
-- @srcMutArray@. This has a consequence that produced array @dstMutArray@ might refer to
-- the same @srcMutArray@ or to a totally new array, which can be checked with
-- `isSameSBMArray`.
--
-- Documentation on the utilized primop: `resizeSmallMutableArray#`.
--
-- [Unsafe] - Same reasons as in `newRawSBMArray`.
--
-- 0.3.0
resizeSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s -- ^ /srcMutArray/ - Mutable boxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> e
  -- ^ /elt/ - Element to write into extra space at the end when growing the array.
  -> m (SBMArray e s) -- ^ /dstMutArray/ - produces a resized version of /srcMutArray/.
resizeSBMArray :: SBMArray e s -> Size -> e -> m (SBMArray e s)
resizeSBMArray (SBMArray SmallMutableArray# s e
ma#) (Size (I# Int#
sz#)) e
e =
  (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s))
-> (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case SmallMutableArray# s e
-> Int# -> e -> State# s -> (# State# s, SmallMutableArray# s e #)
forall s a.
SmallMutableArray# s a
-> Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
resizeSmallMutableArray# SmallMutableArray# s e
ma# Int#
sz# e
e State# s
s of
      (# State# s
s', SmallMutableArray# s e
ma'# #) -> (# State# s
s', SmallMutableArray# s e -> SBMArray e s
forall e s. SmallMutableArray# s e -> SBMArray e s
SBMArray SmallMutableArray# s e
ma'# #)
{-# INLINE resizeSBMArray #-}

-- | /O(1)/ - Same as `resizeSBMArray`, except when growing the array empty space at the
-- end is filled with bottom.
--
-- [Partial] - When size @sz@ is larger then the size of @srcMutArray@ then @dstMutArray@
-- will have cells at the end initialized with thunks that throw `UndefinedElement`
-- exception.
--
-- [Unsafe] - Same reasons as in `newSBMArray`.
--
-- 0.3.0
resizeRawSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s -- ^ /srcMutArray/ - Mutable boxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> m (SBMArray e s) -- ^ /dstMutArray/ - produces a resized version of /srcMutArray/.
resizeRawSBMArray :: SBMArray e s -> Size -> m (SBMArray e s)
resizeRawSBMArray SBMArray e s
ma Size
sz = SBMArray e s -> Size -> e -> m (SBMArray e s)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> Size -> e -> m (SBMArray e s)
resizeSBMArray SBMArray e s
ma Size
sz (String -> String -> e
forall a. HasCallStack => String -> String -> a
uninitialized String
"Data.Prim.Aray" String
"resizeRawSBMArray")
{-# INLINE resizeRawSBMArray #-}


-- | /O(sz)/ - Copy a subsection of an immutable array into a subsection of a mutable
-- array. Source and destination arrays must not be the same array in different states.
--
-- Documentation for utilized primop: `copySmallArray#`.
--
-- [Unsafe] When any of the preconditions for @srcStartIx@, @dstStartIx@ or @sz@ is violated
-- this function can result in a copy of some data that doesn't belong to @srcArray@ or more
-- likely a failure with a segfault.
--
-- @since 0.3.0
copySBArray ::
     forall e m s. MonadPrim s m
  => SBArray e
  -- ^ /srcArray/ - Source immutable array
  --
  -- /__Precondition:__/
  --
  -- > srcMutArray <- thawSBArray srcArray
  -- > srcMutArray /= dstMutArray
  -> Int
  -- ^ /srcStartIx/ - Offset into the source immutable array where copy should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= srcStartIx
  --
  -- > srcStartIx < unSize (sizeOfSBArray srcArray)
  -> SBMArray e s -- ^ /dstMutArray/ - Destination mutable array
  -> Int
  -- ^ /dstStartIx/ - Offset into the destination mutable array where the copy should start
  -- at
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= dstStartIx
  --
  -- > dstSize <- getSizeOfSBMArray dstMutArray
  -- > dstStartIx < unSize dstSize
  -> Size
  -- ^ /sz/ - Number of elements to copy over
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > srcStartIx + unSize sz < unSize (sizeOfSBArray srcArray)
  --
  -- > dstSize <- getSizeOfSBMArray dstMutArray
  -- > dstStartIx + unSize sz < unSize dstSize
  -> m ()
copySBArray :: SBArray e -> Int -> SBMArray e s -> Int -> Size -> m ()
copySBArray (SBArray SmallArray# e
src#) (I# Int#
srcOff#) (SBMArray SmallMutableArray# s e
dst#) (I# Int#
dstOff#) (Size (I# Int#
n#)) =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (SmallArray# e
-> Int#
-> SmallMutableArray# s e
-> Int#
-> Int#
-> State# s
-> State# s
forall a d.
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# e
src# Int#
srcOff# SmallMutableArray# s e
dst# Int#
dstOff# Int#
n#)
{-# INLINE copySBArray #-}


-- | /O(1)/ - Convert a pure immutable boxed array into a mutable boxed array. Use
-- `freezeSBMArray` in order to go in the opposite direction.
--
-- Documentation for utilized primop: `unsafeThawSmallArray#`.
--
-- [Unsafe] This function makes it possible to break referential transparency, because any
-- subsequent destructive operation to the mutable boxed array will also be reflected in
-- the source immutable array as well. See `thawCopySBArray` that avoids this problem with
-- a fresh allocation and data copy.
--
-- ====__Examples__
--
-- >>> ma <- thawSBArray $ fromListSBArray [1 .. 5 :: Integer]
-- >>> writeSBMArray ma 1 10
-- >>> freezeSBMArray ma
-- SBArray [1,10,3,4,5]
--
-- Be careful not to retain a reference to the pure immutable source array after the
-- thawed version gets mutated.
--
-- >>> let a = fromListSBArray [1 .. 5 :: Integer]
-- >>> ma' <- thawSBArray a
-- >>> writeSBMArray ma' 0 100000
-- >>> a
-- SBArray [100000,2,3,4,5]
--
-- @since 0.3.0
thawSBArray ::
     forall e m s. MonadPrim s m
  => SBArray e
  -- ^ /array/ - Source immutable array that will be thawed
  -> m (SBMArray e s)
thawSBArray :: SBArray e -> m (SBMArray e s)
thawSBArray (SBArray SmallArray# e
a#) = (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s))
-> (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case SmallArray# e -> State# s -> (# State# s, SmallMutableArray# s e #)
forall a d.
SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
unsafeThawSmallArray# SmallArray# e
a# State# s
s of
    (# State# s
s', SmallMutableArray# s e
ma# #) -> (# State# s
s', SmallMutableArray# s e -> SBMArray e s
forall e s. SmallMutableArray# s e -> SBMArray e s
SBMArray SmallMutableArray# s e
ma# #)
{-# INLINE thawSBArray #-}


-- | /O(sz)/ - Create a new mutable array with size @sz@ and copy that number of elements
-- from source immutable @srcArray@ starting at an offset @startIx@ into the newly created
-- @dstMutArray@. This function can help avoid an issue with referential transparency that
-- is inherent to `thawSBArray`.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault. Failure with out of memory is also a possibility when the @sz is
-- too large.
--
-- Documentation for utilized primop: `thawSmallArray#`.
--
-- ====__Examples__
--
-- >>> let a = fromListSBArray [1 .. 5 :: Int]
-- >>> ma <- thawCopySBArray a 1 3
-- >>> writeSBMArray ma 1 10
-- >>> freezeSBMArray ma
-- SBArray [2,10,4]
-- >>> a
-- SBArray [1,2,3,4,5]
--
-- @since 0.3.0
thawCopySBArray ::
     forall e m s. MonadPrim s m
  => SBArray e
  -- ^ /srcArray/ - Immutable source array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfSBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned mutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfSBArray srcArray)
  --
  -- Should be less then the actual available memory
  -> m (SBMArray e s)
  -- ^ /dstMutArray/ - Newly created destination mutable boxed array
thawCopySBArray :: SBArray e -> Int -> Size -> m (SBMArray e s)
thawCopySBArray (SBArray SmallArray# e
a#) (I# Int#
i#) (Size (I# Int#
n#)) = (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s))
-> (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case SmallArray# e
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallMutableArray# s e #)
forall a d.
SmallArray# a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
thawSmallArray# SmallArray# e
a# Int#
i# Int#
n# State# s
s of
    (# State# s
s', SmallMutableArray# s e
ma# #) -> (# State# s
s', SmallMutableArray# s e -> SBMArray e s
forall e s. SmallMutableArray# s e -> SBMArray e s
SBMArray SmallMutableArray# s e
ma# #)
{-# INLINE thawCopySBArray #-}



-- | Convert a pure boxed array into a list. It should work fine with GHC built-in list
-- fusion.
--
-- @since 0.1.0
toListSBArray :: forall e. SBArray e -> [e]
toListSBArray :: SBArray e -> [e]
toListSBArray SBArray e
ba = (forall b. (e -> b -> b) -> b -> b) -> [e]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ e -> b -> b
c b
n -> (SBArray e -> Size)
-> (SBArray e -> Int -> e) -> (e -> b -> b) -> b -> SBArray e -> b
forall (a :: * -> *) e b.
(a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB SBArray e -> Size
forall e. SBArray e -> Size
sizeOfSBArray SBArray e -> Int -> e
forall e. SBArray e -> Int -> e
indexSBArray e -> b -> b
c b
n SBArray e
ba)
{-# INLINE toListSBArray #-}



-- | /O(min(length list, sz))/ - Same as `fromListSBArray`, except that it will allocate
-- an array exactly of @n@ size, as such it will not convert any portion of the list that
-- doesn't fit into the newly created array.
--
-- [Partial] When length of supplied list is in fact smaller then the expected size @sz@,
-- thunks with `UndefinedElement` exception throwing function will be placed in the tail
-- portion of the array.
--
-- [Unsafe] When a precondition @sz@ is violated this function can result in critical
-- failure with out of memory or `HeapOverflow` async exception.
--
-- ====__Examples__
--
-- >>> fromListSBArrayN 3 [1 :: Int, 2, 3]
-- SBArray [1,2,3]
-- >>> fromListSBArrayN 3 [1 :: Int ..]
-- SBArray [1,2,3]
--
-- @since 0.1.0
fromListSBArrayN ::
     forall e. HasCallStack
  => Size -- ^ /sz/ - Expected number of elements in the @list@
  -> [e] -- ^ /list/ - A list to bew loaded into the array
  -> SBArray e
fromListSBArrayN :: Size -> [e] -> SBArray e
fromListSBArrayN Size
sz [e]
xs =
  (forall s. ST s (SBArray e)) -> SBArray e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SBArray e)) -> SBArray e)
-> (forall s. ST s (SBArray e)) -> SBArray e
forall a b. (a -> b) -> a -> b
$ (Size -> ST s (SBMArray e s))
-> (SBMArray e s -> Int -> e -> ST s ())
-> Size
-> [e]
-> ST s (SBMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b) -> (b -> Int -> a -> m ()) -> Size -> [a] -> m b
fromListMutWith Size -> ST s (SBMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (SBMArray e s)
newRawSBMArray SBMArray e s -> Int -> e -> ST s ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> Int -> e -> m ()
writeSBMArray Size
sz [e]
xs ST s (SBMArray e s)
-> (SBMArray e s -> ST s (SBArray e)) -> ST s (SBArray e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SBMArray e s -> ST s (SBArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> m (SBArray e)
freezeSBMArray
{-# INLINE fromListSBArrayN #-}


-- | /O(length list)/ - Convert a list into an immutable boxed array. It is more efficient to use
-- `fromListSBArrayN` when the number of elements is known ahead of time. The reason for this
-- is that it is necessary to iterate the whole list twice: once to count how many elements
-- there is in order to create large enough array that can fit them; and the second time to
-- load the actual elements. Naturally, infinite lists will grind the program to a halt.
--
-- ====__Example__
--
-- >>> fromListSBArray "Hello Haskell"
-- SBArray "Hello Haskell"
--
-- @since 0.3.0
fromListSBArray :: forall e. [e] -> SBArray e
fromListSBArray :: [e] -> SBArray e
fromListSBArray [e]
xs = Size -> [e] -> SBArray e
forall e. HasCallStack => Size -> [e] -> SBArray e
fromListSBArrayN (Int -> Size
coerce ([e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
xs)) [e]
xs
{-# INLINE fromListSBArray #-}


-- Mutable Small Boxed Array --
-------------------------------

-- | Small boxed mutable array
data SBMArray e s = SBMArray (SmallMutableArray# s e)

-- | Check if both of the arrays refer to the exact same one. None of the elements are
-- evaluated.
instance Eq (SBMArray e s) where
  == :: SBMArray e s -> SBMArray e s -> Bool
(==) = SBMArray e s -> SBMArray e s -> Bool
forall a s. SBMArray a s -> SBMArray a s -> Bool
isSameSBMArray
  {-# INLINE (==) #-}


-- | Compare pointers for two mutable arrays and see if they refer to the exact same one.
--
-- Documentation for utilized primop: `sameSmallMutableArray#`.
--
-- @since 0.3.0
isSameSBMArray :: forall a s. SBMArray a s -> SBMArray a s -> Bool
isSameSBMArray :: SBMArray a s -> SBMArray a s -> Bool
isSameSBMArray (SBMArray SmallMutableArray# s a
ma1#) (SBMArray SmallMutableArray# s a
ma2#) =
  Int# -> Bool
isTrue# (SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
forall d a.
SmallMutableArray# d a -> SmallMutableArray# d a -> Int#
sameSmallMutableArray# SmallMutableArray# s a
ma1# SmallMutableArray# s a
ma2#)
{-# INLINE isSameSBMArray #-}


-- | /O(1)/ - Get the size of a mutable boxed array
--
-- Documentation for utilized primop: `getSizeofSmallMutableArray#` for ghc-8.10 and newer
-- and fallback to `sizeofMutableArray#` for older versions.
--
-- ====__Example__
--
-- >>> ma <- newSBMArray 1024 "Element of each cell"
-- >>> getSizeOfSBMArray ma
-- Size {unSize = 1024}
--
-- @since 0.3.0
getSizeOfSBMArray :: forall e m s. MonadPrim s m => SBMArray e s -> m Size
getSizeOfSBMArray :: SBMArray e s -> m Size
getSizeOfSBMArray (SBMArray SmallMutableArray# s e
ma#) =
  (State# s -> (# State# s, Size #)) -> m Size
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Size #)) -> m Size)
-> (State# s -> (# State# s, Size #)) -> m Size
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case SmallMutableArray# s e -> State# s -> (# State# s, Int# #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, Int# #)
getSizeofSmallMutableArray# SmallMutableArray# s e
ma# State# s
s of
      (# State# s
s', Int#
i# #) -> (# State# s
s', Int -> Size
coerce (Int# -> Int
I# Int#
i#) #)
{-# INLINE getSizeOfSBMArray #-}

-- | /O(1)/ - Read an element from a mutable small boxed array at the supplied index.
--
-- Documentation for utilized primop: `readSmallArray#`.
--
-- [Unsafe] Violation of @ix@ preconditions can result in undefined behavior or a failure
-- with a segfault
--
-- ==== __Example__
--
-- >>> ma <- makeSBMArray 10 (pure . ("Element ix: " ++) . show)
-- >>> readSBMArray ma 5
-- "Element ix: 5"
--
-- @since 0.1.0
readSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s -- ^ /srcMutArray/ - Array to read an element from
  -> Int
  -- ^ /ix/ - Index that refers to an element we need within the the @srcMutArray@
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > ix < unSize (sizeOfMSBArray srcMutArray)
  -> m e
readSBMArray :: SBMArray e s -> Int -> m e
readSBMArray (SBMArray SmallMutableArray# s e
ma#) (I# Int#
i#) = (State# s -> (# State# s, e #)) -> m e
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (SmallMutableArray# s e -> Int# -> State# s -> (# State# s, e #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# s e
ma# Int#
i#)
{-# INLINE readSBMArray #-}



-- | /O(1)/ - Write an element @elt@ into the mutable small boxed array @dstMutArray@ at
-- the supplied index @ix@. The actual element will be evaluated to WHNF prior to
-- mutation.
--
-- [Unsafe] Violation of @ix@ preconditions can result in heap corruption or a failure
-- with a segfault
--
-- ==== __Examples__
--
-- >>> ma <- newSBMArray 4 (Nothing :: Maybe Integer)
-- >>> writeSBMArray ma 2 (Just 2)
-- >>> freezeSBMArray ma
-- SBArray [Nothing,Nothing,Just 2,Nothing]
--
-- It is important to note that an element is evaluated prior to being written into a
-- cell, so it will not overwrite the value of an array's cell if it evaluates to an
-- exception:
--
-- >>> import Control.Prim.Exception
-- >>> writeSBMArray ma 2 (impureThrow DivideByZero)
-- *** Exception: divide by zero
-- >>> freezeSBMArray ma
-- SBArray [Nothing,Nothing,Just 2,Nothing]
--
-- However, it is evaluated only to Weak Head Normal Form (WHNF), so it is still possible
-- to write something that eventually evaluates to bottom.
--
-- >>> writeSBMArray ma 3 (Just (7 `div` 0 ))
-- >>> freezeSBMArray ma
-- SBArray [Nothing,Nothing,Just 2,Just *** Exception: divide by zero
--
-- Either `deepseq` or `writeDeepSBMArray` can be used to alleviate that.
--
-- @since 0.3.0
writeSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s -- ^ /dstMutArray/ - An array to have the element written to
  -> Int
  -- ^ /ix/ - Index within the the @dstMutArray@ that a refernce to the supplied element
  -- @elt@ will be written to.
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > ix < unSize (sizeOfMSBArray srcArray)
  -> e
  -- ^ /elt/ - Element to be written into @dstMutArray@
  -> m ()
writeSBMArray :: SBMArray e s -> Int -> e -> m ()
writeSBMArray SBMArray e s
ma Int
i !e
x = SBMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> Int -> e -> m ()
writeLazySBMArray SBMArray e s
ma Int
i e
x
{-# INLINE writeSBMArray #-}


-- | /O(1)/ - Same as `writeSBMArray` but allows to write a thunk into an array instead of an
-- evaluated element. Careful with memory leaks and thunks that evaluate to exceptions.
--
-- Documentation for utilized primop: `writeSmallArray#`.
--
-- [Unsafe] Same reasons as `writeSBMArray`
--
-- @since 0.3.0
writeLazySBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s
  -> Int
  -> e
  -> m ()
writeLazySBMArray :: SBMArray e s -> Int -> e -> m ()
writeLazySBMArray (SBMArray SmallMutableArray# s e
ma#) (I# Int#
i#) e
a = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (SmallMutableArray# s e -> Int# -> e -> State# s -> State# s
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# s e
ma# Int#
i# e
a)
{-# INLINE writeLazySBMArray #-}


-- | /O(1)/ - Same as `writeSBMArray`, except it ensures that the value being written is
-- fully evaluated, i.e. to Normal Form (NF).
--
-- [Unsafe] Same reasons as `writeSBMArray`
--
-- @since 0.3.0
writeDeepSBMArray ::
     forall e m s. (MonadPrim s m, NFData e)
  => SBMArray e s
  -> Int
  -> e
  -> m ()
writeDeepSBMArray :: SBMArray e s -> Int -> e -> m ()
writeDeepSBMArray SBMArray e s
ma Int
i !e
x =
  case e -> ()
forall a. NFData a => a -> ()
rnf e
x of
    () -> SBMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> Int -> e -> m ()
writeLazySBMArray SBMArray e s
ma Int
i e
x
{-# INLINE writeDeepSBMArray #-}



-- | Create a mutable boxed array where each element is set to the supplied initial value
-- @elt@, which is evaluated before array allocation happens. See `newLazySBMArray` for
-- an ability to initialize with a thunk.
--
-- [Unsafe size] Violation of precondition for the @sz@ argument can result in the current
-- thread being killed with `HeapOverflow` asynchronous exception or death of the whole
-- process with some unchecked exception from RTS.
--
-- ====__Examples__
--
-- >>> newSBMArray 10 'A' >>= freezeSBMArray
-- SBArray "AAAAAAAAAA"
--
-- @since 0.3.0
newSBMArray ::
     forall e m s. MonadPrim s m
  => Size
  -- ^ /sz/ - Size of the array
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> e -- ^ /elt/ - Value to use for all array cells
  -> m (SBMArray e s)
newSBMArray :: Size -> e -> m (SBMArray e s)
newSBMArray Size
sz e
x = e
x e -> m (SBMArray e s) -> m (SBMArray e s)
`seq` Size -> e -> m (SBMArray e s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> e -> m (SBMArray e s)
newLazySBMArray Size
sz e
x
{-# INLINE newSBMArray #-}

-- | Same as `newSBMArray`, except initial element is allowed to be a thunk.
--
-- Documentation for utilized primop: `newSmallArray#`.
--
-- [Unsafe] Same reasons as `newSBMArray`
--
-- @since 0.3.0
newLazySBMArray ::
     forall e m s. MonadPrim s m
  => Size
  -> e
  -> m (SBMArray e s)
newLazySBMArray :: Size -> e -> m (SBMArray e s)
newLazySBMArray (Size (I# Int#
n#)) e
a =
  (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s))
-> (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case Int# -> e -> State# s -> (# State# s, SmallMutableArray# s e #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
n# e
a State# s
s of
      (# State# s
s', SmallMutableArray# s e
ma# #) -> (# State# s
s', SmallMutableArray# s e -> SBMArray e s
forall e s. SmallMutableArray# s e -> SBMArray e s
SBMArray SmallMutableArray# s e
ma# #)
{-# INLINE newLazySBMArray #-}




-- | Create new mutable array, where each element is initilized to a thunk that throws an
-- error when evaluated. This is useful when there is a plan to later iterate over the whole
-- array and write values into each cell in some index aware fashion. Consider `makeSBMArray`
-- as an alternative.
--
-- [Partial] All array cells are initialized with thunks that throw `UndefinedElement`
-- exception.
--
-- [Unsafe] Same reasons as `newSBMArray`
--
-- ==== __Examples__
--
-- >>> import Data.Prim
-- >>> let xs = "Hello Haskell"
-- >>> ma <- newRawSBMArray (Size (length xs)) :: IO (SBMArray Char RW)
-- >>> mapM_ (\(i, x) -> writeSBMArray ma i x) (zip [0..] xs)
-- >>> freezeSBMArray ma
-- SBArray "Hello Haskell"
--
-- @since 0.3.0
newRawSBMArray ::
     forall e m s. (HasCallStack, MonadPrim s m)
  => Size
  -> m (SBMArray e s)
newRawSBMArray :: Size -> m (SBMArray e s)
newRawSBMArray Size
sz = Size -> e -> m (SBMArray e s)
forall e (m :: * -> *) s.
MonadPrim s m =>
Size -> e -> m (SBMArray e s)
newLazySBMArray Size
sz (String -> String -> e
forall a. HasCallStack => String -> String -> a
uninitialized String
"Data.Prim.Aray" String
"newRawSBMArray")
{-# INLINE newRawSBMArray #-}



-- | Create new mutable boxed array of the supplied size and fill it with a monadic action
-- that is applied to indices of each array cell.
--
-- [Unsafe] Same reasons as `newSBMArray`
--
-- ====__Examples__
--
-- >>> ma <- makeSBMArray 5 $ \i -> (toEnum (i + 97) :: Char) <$ putStrLn ("Handling index: " ++ show i)
-- Handling index: 0
-- Handling index: 1
-- Handling index: 2
-- Handling index: 3
-- Handling index: 4
-- >>> freezeSBMArray ma
-- SBArray "abcde"
--
-- @since 0.3.0
makeSBMArray ::
     forall e m s. MonadPrim s m
  => Size
  -> (Int -> m e)
  -> m (SBMArray e s)
makeSBMArray :: Size -> (Int -> m e) -> m (SBMArray e s)
makeSBMArray = (Size -> m (SBMArray e s))
-> (SBMArray e s -> Int -> e -> m ())
-> Size
-> (Int -> m e)
-> m (SBMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b)
-> (b -> Int -> a -> m ()) -> Size -> (Int -> m a) -> m b
makeMutWith Size -> m (SBMArray e s)
forall e (m :: * -> *) s.
(HasCallStack, MonadPrim s m) =>
Size -> m (SBMArray e s)
newRawSBMArray SBMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
MonadPrim s m =>
SBMArray e s -> Int -> e -> m ()
writeSBMArray
{-# INLINE makeSBMArray #-}


-- | /O(1)/ - Convert a mutable boxed array into an immutable one. Use `thawSBArray` in order
-- to go in the opposite direction.
--
-- Documentation for utilized primop: `unsafeFreezeSmallArray#`.
--
-- [Unsafe] This function makes it possible to break referential transparency, because any
-- subsequent destructive operation to the source mutable boxed array will also be reflected
-- in the resulting immutable array. See `freezeCopySBMArray` that avoids this problem with
-- fresh allocation.
--
-- @since 0.3.0
freezeSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s
  -> m (SBArray e)
freezeSBMArray :: SBMArray e s -> m (SBArray e)
freezeSBMArray (SBMArray SmallMutableArray# s e
ma#) = (State# s -> (# State# s, SBArray e #)) -> m (SBArray e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, SBArray e #)) -> m (SBArray e))
-> (State# s -> (# State# s, SBArray e #)) -> m (SBArray e)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case SmallMutableArray# s e -> State# s -> (# State# s, SmallArray# e #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# SmallMutableArray# s e
ma# State# s
s of
    (# State# s
s', SmallArray# e
a# #) -> (# State# s
s', SmallArray# e -> SBArray e
forall e. SmallArray# e -> SBArray e
SBArray SmallArray# e
a# #)
{-# INLINE freezeSBMArray #-}



-- | /O(sz)/ - Similar to `freezeSBMArray`, except it creates a new array with the copy of a
-- subsection of a mutable array before converting it into an immutable.
--
-- Documentation for utilized primop: `freezeSmallArray#`.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault or out of memory exception.
--
-- @since 0.3.0
freezeCopySBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s
  -- ^ /srcArray/ - Source mutable array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfSBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned immutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfSBArray srcArray)
  --
  -- Should be less then actual available memory
  -> m (SBArray e)
freezeCopySBMArray :: SBMArray e s -> Int -> Size -> m (SBArray e)
freezeCopySBMArray (SBMArray SmallMutableArray# s e
ma#) (I# Int#
i#) (Size (I# Int#
n#)) = (State# s -> (# State# s, SBArray e #)) -> m (SBArray e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, SBArray e #)) -> m (SBArray e))
-> (State# s -> (# State# s, SBArray e #)) -> m (SBArray e)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case SmallMutableArray# s e
-> Int# -> Int# -> State# s -> (# State# s, SmallArray# e #)
forall d a.
SmallMutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, SmallArray# a #)
freezeSmallArray# SmallMutableArray# s e
ma# Int#
i# Int#
n# State# s
s of
    (# State# s
s', SmallArray# e
a# #) -> (# State# s
s', SmallArray# e -> SBArray e
forall e. SmallArray# e -> SBArray e
SBArray SmallArray# e
a# #)
{-# INLINE freezeCopySBMArray #-}

-- | /O(sz)/ - Allocate a new small boxed mutable array of size @sz@ and copy that number
-- of the elements over from the @srcArray@ starting at index @ix@. Similar to
-- `cloneSBArray`, except that it works on mutable arrays.
--
-- Documentation for utilized primop: `cloneSmallMutableArray#`.
--
-- [Unsafe] When any of the preconditions for @startIx@ or @sz@ is violated this function
-- can result in a copy of some data that doesn't belong to @srcArray@ or more likely a
-- failure with a segfault. Failure with out of memory is also a possibility when the @sz is
-- too large.
--
-- @since 0.3.0
cloneSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s
  -- ^ /srcArray/ - Source mutable array
  -> Int
  -- ^ /startIx/ - Location within @srcArray@ where the copy of elements should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= startIx
  --
  -- > startIx < unSize (sizeOfSBArray srcArray)
  -> Size
  -- ^ /sz/ - Size of the returned mutable array. Also this is the number of elements that
  -- will be copied over into the destionation array starting at the beginning.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > startIx + unSize sz < unSize (sizeOfSBArray srcArray)
  --
  -- Should be less then actual available memory
  -> m (SBMArray e s)
cloneSBMArray :: SBMArray e s -> Int -> Size -> m (SBMArray e s)
cloneSBMArray (SBMArray SmallMutableArray# s e
ma#) (I# Int#
i#) (Size (I# Int#
n#)) =
  (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s))
-> (State# s -> (# State# s, SBMArray e s #)) -> m (SBMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case SmallMutableArray# s e
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallMutableArray# s e #)
forall d a.
SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
cloneSmallMutableArray# SmallMutableArray# s e
ma# Int#
i# Int#
n# State# s
s of
      (# State# s
s', SmallMutableArray# s e
ma'# #) -> (# State# s
s', SmallMutableArray# s e -> SBMArray e s
forall e s. SmallMutableArray# s e -> SBMArray e s
SBMArray SmallMutableArray# s e
ma'# #)
{-# INLINE cloneSBMArray #-}


-- | /O(sz)/ - Copy a subsection of a mutable array into a subsection of another or the same
-- mutable array. Therefore, unlike `copySBArray`, memory ia allowed to overlap between source
-- and destination.
--
-- Documentation for utilized primop: `copySmallMutableArray#`.
--
-- [Unsafe] When any of the preconditions for @srcStartIx@, @dstStartIx@ or @sz@ is violated
-- this function can result in a copy of some data that doesn't belong to @srcArray@ or more
-- likely a failure with a segfault.
--
-- @since 0.3.0
moveSBMArray ::
     forall e m s. MonadPrim s m
  => SBMArray e s -- ^ /srcMutArray/ - Source mutable array
  -> Int
  -- ^ /srcStartIx/ - Offset into the source mutable array where copy should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= srcStartIx
  --
  -- > srcSize <- getSizeOfSBMArray srcMutArray
  -- > srcStartIx < unSize srcSize
  -> SBMArray e s -- ^ /dstMutArray/ - Destination mutable array
  -> Int
  -- ^ /dstStartIx/ - Offset into the destination mutable array where copy should start to
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= dstStartIx
  --
  -- > dstSize <- getSizeOfSBMArray dstMutArray
  -- > dstStartIx < unSize dstSize
  -> Size
  -- ^ /sz/ - Number of elements to copy over
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > srcSize <- getSizeOfSBMArray srcMutArray
  -- > srcStartIx + unSize sz < unSize srcSize
  --
  -- > dstSize <- getSizeOfSBMArray dstMutArray
  -- > dstStartIx + unSize sz < unSize dstSize
  --
  -> m ()
moveSBMArray :: SBMArray e s -> Int -> SBMArray e s -> Int -> Size -> m ()
moveSBMArray (SBMArray SmallMutableArray# s e
src#) (I# Int#
srcOff#) (SBMArray SmallMutableArray# s e
dst#) (I# Int#
dstOff#) (Size (I# Int#
n#)) =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (SmallMutableArray# s e
-> Int#
-> SmallMutableArray# s e
-> Int#
-> Int#
-> State# s
-> State# s
forall d a.
SmallMutableArray# d a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallMutableArray# SmallMutableArray# s e
src# Int#
srcOff# SmallMutableArray# s e
dst# Int#
dstOff# Int#
n#)
{-# INLINE moveSBMArray #-}



-------------------
-- Unboxed Array --
-- ============= --


-- Immutable Unboxed Array --
-----------------------------

data UArray e = UArray ByteArray#
type role UArray nominal

instance (Prim e, Show e) => Show (UArray e) where
  showsPrec :: Int -> UArray e -> ShowS
showsPrec Int
n UArray e
arr
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = (Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
:)
    | Bool
otherwise = ShowS
inner
    where
      inner :: ShowS
inner = (String
"UArray " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> ShowS
forall a. Show a => a -> ShowS
shows (UArray e -> [Item (UArray e)]
forall l. IsList l => l -> [Item l]
toList UArray e
arr)

instance Prim e => IsList (UArray e) where
  type Item (UArray e) = e
  fromList :: [Item (UArray e)] -> UArray e
fromList = [Item (UArray e)] -> UArray e
forall e. Prim e => [e] -> UArray e
fromListUArray
  {-# INLINE fromList #-}
  fromListN :: Int -> [Item (UArray e)] -> UArray e
fromListN Int
n = Size -> [e] -> UArray e
forall e. Prim e => Size -> [e] -> UArray e
fromListUArrayN (Int -> Size
coerce Int
n)
  {-# INLINE fromListN #-}
  toList :: UArray e -> [Item (UArray e)]
toList = UArray e -> [Item (UArray e)]
forall e. Prim e => UArray e -> [e]
toListUArray
  {-# INLINE toList #-}

instance e ~ Char => IsString (UArray e) where
  fromString :: String -> UArray e
fromString = String -> UArray e
forall e. Prim e => [e] -> UArray e
fromListUArray
  {-# INLINE fromString #-}

-- | /O(1)/ - `UArray` is always in NF
instance NFData (UArray e) where
  rnf :: UArray e -> ()
rnf (UArray ByteArray#
_) = ()
  {-# INLINE rnf #-}

instance (Prim e, Eq e) => Eq (UArray e) where
  == :: UArray e -> UArray e -> Bool
(==) = (UArray e -> UArray e -> Bool)
-> (UArray e -> Size)
-> (UArray e -> Int -> e)
-> UArray e
-> UArray e
-> Bool
forall e (a :: * -> *).
Eq e =>
(a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Bool
eqWith UArray e -> UArray e -> Bool
forall a b. UArray a -> UArray b -> Bool
isSameUArray UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray UArray e -> Int -> e
forall e. Prim e => UArray e -> Int -> e
indexUArray
  {-# INLINE (==) #-}

instance (Prim e, Ord e) => Ord (UArray e) where
  compare :: UArray e -> UArray e -> Ordering
compare = (UArray e -> UArray e -> Bool)
-> (UArray e -> Size)
-> (UArray e -> Int -> e)
-> UArray e
-> UArray e
-> Ordering
forall e (a :: * -> *).
Ord e =>
(a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Ordering
compareWith UArray e -> UArray e -> Bool
forall a b. UArray a -> UArray b -> Bool
isSameUArray UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray UArray e -> Int -> e
forall e. Prim e => UArray e -> Int -> e
indexUArray
  {-# INLINE compare #-}


instance Prim e => Semigroup (UArray e) where
  <> :: UArray e -> UArray e -> UArray e
(<>) = (forall s. Size -> ST s (UMArray e s))
-> (forall s.
    UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ())
-> (forall s. UMArray e s -> ST s (UArray e))
-> (UArray e -> Size)
-> UArray e
-> UArray e
-> UArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> a e
-> a e
-> a e
appendWith forall s. Size -> ST s (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray forall s. UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UArray e -> Int -> UMArray e s -> Int -> Size -> m ()
copyUArray forall s. UMArray e s -> ST s (UArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
UMArray e s -> m (UArray e)
freezeUMArray UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray
  {-# INLINE (<>) #-}
  sconcat :: NonEmpty (UArray e) -> UArray e
sconcat NonEmpty (UArray e)
xs = (forall s. Size -> ST s (UMArray e s))
-> (forall s.
    UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ())
-> (forall s. UMArray e s -> ST s (UArray e))
-> (UArray e -> Size)
-> [UArray e]
-> UArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> [a e]
-> a e
concatWith forall s. Size -> ST s (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray forall s. UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UArray e -> Int -> UMArray e s -> Int -> Size -> m ()
copyUArray forall s. UMArray e s -> ST s (UArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
UMArray e s -> m (UArray e)
freezeUMArray UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray (NonEmpty (UArray e) -> [UArray e]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (UArray e)
xs)
  {-# INLINE sconcat #-}
  stimes :: b -> UArray e -> UArray e
stimes b
n = (forall s. Size -> ST s (UMArray e s))
-> (forall s.
    UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ())
-> (forall s. UMArray e s -> ST s (UArray e))
-> (UArray e -> Size)
-> Int
-> UArray e
-> UArray e
forall (a :: * -> *) e (ma :: * -> * -> *).
Monoid (a e) =>
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> Int
-> a e
-> a e
cycleWith forall s. Size -> ST s (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray forall s. UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UArray e -> Int -> UMArray e s -> Int -> Size -> m ()
copyUArray forall s. UMArray e s -> ST s (UArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
UMArray e s -> m (UArray e)
freezeUMArray UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n)
  {-# INLINE stimes #-}

instance Prim e => Monoid (UArray e) where
  mempty :: UArray e
mempty = (forall s. ST s (UArray e)) -> UArray e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UArray e)) -> UArray e)
-> (forall s. ST s (UArray e)) -> UArray e
forall a b. (a -> b) -> a -> b
$ Size -> ST s (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray Size
0 ST s (UMArray e s)
-> (UMArray e s -> ST s (UArray e)) -> ST s (UArray e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMArray e s -> ST s (UArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
UMArray e s -> m (UArray e)
freezeUMArray
  {-# NOINLINE mempty #-}
  mappend :: UArray e -> UArray e -> UArray e
mappend = UArray e -> UArray e -> UArray e
forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE mappend #-}
  mconcat :: [UArray e] -> UArray e
mconcat = (forall s. Size -> ST s (UMArray e s))
-> (forall s.
    UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ())
-> (forall s. UMArray e s -> ST s (UArray e))
-> (UArray e -> Size)
-> [UArray e]
-> UArray e
forall (ma :: * -> * -> *) e (a :: * -> *).
(forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> [a e]
-> a e
concatWith forall s. Size -> ST s (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray forall s. UArray e -> Int -> UMArray e s -> Int -> Size -> ST s ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UArray e -> Int -> UMArray e s -> Int -> Size -> m ()
copyUArray forall s. UMArray e s -> ST s (UArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
UMArray e s -> m (UArray e)
freezeUMArray UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray
  {-# INLINE mconcat #-}


-- | /O(1)/ - Compare pointers for two immutable arrays and see if they refer to the exact same one.
--
-- Documentation for utilized primop: `isSameByteArray#`.
--
-- @since 0.3.0
isSameUArray :: forall a b. UArray a -> UArray b -> Bool
isSameUArray :: UArray a -> UArray b -> Bool
isSameUArray (UArray ByteArray#
ma1#) (UArray ByteArray#
ma2#) = Int# -> Bool
isTrue# (ByteArray# -> ByteArray# -> Int#
isSameByteArray# ByteArray#
ma1# ByteArray#
ma2#)
{-# INLINE isSameUArray #-}


-- | /O(1)/ - Check if memory for immutable unboxed array was allocated as pinned.
--
-- Documentation for utilized primop: `isByteArrayPinned#`.
--
-- @since 0.3.0
isPinnedUArray :: forall e. UArray e -> Bool
isPinnedUArray :: UArray e -> Bool
isPinnedUArray (UArray ByteArray#
b#) = Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
b#)
{-# INLINE isPinnedUArray #-}



-- | /O(1)/ - Get the size of an immutable array in number of elements.
--
-- Documentation for utilized primop: `sizeofByteArray#`.
--
-- @since 0.3.0
sizeOfUArray ::
     forall e. Prim e
  => UArray e
  -> Size
sizeOfUArray :: UArray e -> Size
sizeOfUArray (UArray ByteArray#
a#) =
  Count e -> Size
coerce (Count Word8 -> Count e
forall e. Prim e => Count Word8 -> Count e
fromByteCount (Int -> Count Word8
coerce (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
a#))) :: Count e)
{-# INLINE sizeOfUArray #-}


-- | /O(1)/ - Index an element of a pure unboxed array.
--
-- Documentation for utilized primop: `indexByteArray#`.
--
-- [Unsafe] Bounds are not checked. When a precondition for @ix@ argument is violated the
-- result is either unpredictable output or failure with a segfault.
--
-- ==== __Examples__
--
-- >>> let a = fromListUArray ([Left pi, Right 123] :: [Either Double Int])
-- >>> indexUArray a 0
-- Left 3.141592653589793
-- >>> indexUArray a 1
-- Right 123
--
-- @since 0.3.0
indexUArray ::
     forall e. Prim e
  => UArray e
  -- ^ /array/ - Array where to lookup an element from
  -> Int
  -- ^ /ix/ - Position of the element within the @array@
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > ix < unSize (sizeOfUArray array)
  -> e
indexUArray :: UArray e -> Int -> e
indexUArray (UArray ByteArray#
a#) (I# Int#
i#) = ByteArray# -> Int# -> e
forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
a# Int#
i#
{-# INLINE indexUArray #-}


-- | /O(sz)/ - Copy a subsection of an immutable array into a subsection of another mutable
-- array. Source and destination arrays must not be the same array in different states.
--
-- Documentation for utilized primop: `copyByteArray#`.
--
-- [Unsafe] When any of the preconditions for @srcStartIx@, @dstStartIx@ or @sz@ is violated
-- this function can result in a copy of some data that doesn't belong to @srcArray@ or
-- failure with a segfault.
--
-- @since 0.3.0
copyUArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => UArray e
  -- ^ /srcArray/ - Source immutable array
  --
  -- /__Precondition:__/
  --
  -- > srcMutArray <- thawUArray srcArray
  -- > srcMutArray /= dstMutArray
  -> Int
  -- ^ /srcStartIx/ - Offset into the source immutable array where copy should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= srcStartIx
  --
  -- > srcStartIx < unSize (sizeOfUArray srcArray)
  -> UMArray e s -- ^ /dstMutArray/ - Destination mutable array
  -> Int
  -- ^ /dstStartIx/ - Offset into the destination mutable array where the copy should start
  -- at
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= dstStartIx
  --
  -- > dstSize <- getSizeOfMUArray dstMutArray
  -- > dstStartIx < unSize dstSize
  -> Size
  -- ^ /sz/ - Number of elements to copy over
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > srcStartIx + unSize sz < unSize (sizeOfUArray srcArray)
  --
  -- > dstSize <- getSizeOfMUArray dstMutArray
  -- > dstStartIx + unSize sz < unSize dstSize
  -> m ()
copyUArray :: UArray e -> Int -> UMArray e s -> Int -> Size -> m ()
copyUArray (UArray ByteArray#
src#) Int
srcOff (UMArray MutableByteArray# s
dst#) Int
dstOff Size
n =
  let srcOff# :: Int#
srcOff# = Off e -> Int#
forall e. Prim e => Off e -> Int#
unOffBytes# (Int -> Off e
coerce Int
srcOff :: Off e)
      dstOff# :: Int#
dstOff# = Off e -> Int#
forall e. Prim e => Off e -> Int#
unOffBytes# (Int -> Off e
coerce Int
dstOff :: Off e)
      n# :: Int#
n# = Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# (Size -> Count e
coerce Size
n :: Count e)
  in (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
src# Int#
srcOff# MutableByteArray# s
dst# Int#
dstOff# Int#
n#)
{-# INLINE copyUArray #-}


-- | /O(1)/ - Convert a pure immutable unboxed array into a mutable unboxed array. Use
-- `freezeUMArray` in order to go in the opposite direction.
--
-- Documentation for utilized primop: `unsafeThawByteArray#`.
--
-- [Unsafe] This function makes it possible to break referential transparency, because any
-- subsequent destructive operation to the mutable unboxed array will also be reflected in
-- the source immutable array as well.
--
-- ====__Examples__
--
-- >>> ma <- thawUArray $ fromListUArray [1 .. 5 :: Int]
-- >>> writeUMArray ma 1 10
-- >>> freezeUMArray ma
-- UArray [1,10,3,4,5]
--
-- Be careful not to retain a reference to the pure immutable source array after the
-- thawed version gets mutated.
--
-- >>> let a = fromListUArray [1 .. 5 :: Int]
-- >>> ma' <- thawUArray a
-- >>> writeUMArray ma' 0 100000
-- >>> a
-- UArray [100000,2,3,4,5]
--
-- @since 0.3.0
thawUArray :: forall e m s. MonadPrim s m => UArray e -> m (UMArray e s)
thawUArray :: UArray e -> m (UMArray e s)
thawUArray (UArray ByteArray#
a#) =
  (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s))
-> (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case ByteArray# -> State# s -> (# State# s, MutableByteArray# s #)
forall s.
ByteArray# -> State# s -> (# State# s, MutableByteArray# s #)
unsafeThawByteArray# ByteArray#
a# State# s
s of
      (# State# s
s', MutableByteArray# s
ma# #) -> (# State# s
s', MutableByteArray# s -> UMArray e s
forall e s. MutableByteArray# s -> UMArray e s
UMArray MutableByteArray# s
ma# #)
{-# INLINE thawUArray #-}



-- | /O(n)/ - Convert a pure boxed array into a list. It should work fine with GHC built-in list
-- fusion.
--
-- @since 0.1.0
toListUArray ::
     forall e. Prim e
  => UArray e
  -> [e]
toListUArray :: UArray e -> [e]
toListUArray UArray e
ba = (forall b. (e -> b -> b) -> b -> b) -> [e]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ e -> b -> b
c b
n -> (UArray e -> Size)
-> (UArray e -> Int -> e) -> (e -> b -> b) -> b -> UArray e -> b
forall (a :: * -> *) e b.
(a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray UArray e -> Int -> e
forall e. Prim e => UArray e -> Int -> e
indexUArray e -> b -> b
c b
n UArray e
ba)
{-# INLINE toListUArray #-}

-- | /O(min(length list, sz))/ - Same as `fromListUArray`, except it will allocate an array exactly of @n@ size, as
-- such it will not convert any portion of the list that doesn't fit into the newly
-- created array.
--
-- [Partial] When length of supplied list is in fact smaller then the expected size @sz@,
-- thunks with `UndefinedElement` exception throwing function will be placed in the tail
-- portion of the array.
--
-- [Unsafe] When a precondition @sz@ is violated this function can result in critical
-- failure with out of memory or `HeapOverflow` async exception.
--
-- ====__Examples__
--
-- >>> fromListUArrayN 3 [1 :: Int, 2, 3]
-- UArray [1,2,3]
-- >>> fromListUArrayN 3 [1 :: Int ..]
-- UArray [1,2,3]
--
-- @since 0.1.0
fromListUArrayN ::
     forall e. Prim e
  => Size -- ^ /sz/ - Expected number of elements in the @list@
  -> [e] -- ^ /list/ - A list to bew loaded into the array
  -> UArray e
fromListUArrayN :: Size -> [e] -> UArray e
fromListUArrayN Size
sz [e]
xs =
  (forall s. ST s (UArray e)) -> UArray e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UArray e)) -> UArray e)
-> (forall s. ST s (UArray e)) -> UArray e
forall a b. (a -> b) -> a -> b
$ (Size -> ST s (UMArray e s))
-> (UMArray e s -> Int -> e -> ST s ())
-> Size
-> [e]
-> ST s (UMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b) -> (b -> Int -> a -> m ()) -> Size -> [a] -> m b
fromListMutWith Size -> ST s (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray UMArray e s -> Int -> e -> ST s ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UMArray e s -> Int -> e -> m ()
writeUMArray Size
sz [e]
xs ST s (UMArray e s)
-> (UMArray e s -> ST s (UArray e)) -> ST s (UArray e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UMArray e s -> ST s (UArray e)
forall e (m :: * -> *) s.
MonadPrim s m =>
UMArray e s -> m (UArray e)
freezeUMArray
{-# INLINE fromListUArrayN #-}


-- | /O(length list)/ - Convert a list into an immutable boxed array. It is more efficient to use
-- `fromListUArrayN` when the number of elements is known ahead of time. The reason for this
-- is that it is necessary to iterate the whole list twice: once to count how many elements
-- there is in order to create large enough array that can fit them; and the second time to
-- load the actual elements. Naturally, infinite lists will grind the program to a halt.
--
-- ====__Example__
--
-- >>> fromListUArray "Hello Haskell"
-- UArray "Hello Haskell"
--
-- @since 0.3.0
fromListUArray ::
     forall e. Prim e
  => [e]
  -> UArray e
fromListUArray :: [e] -> UArray e
fromListUArray [e]
xs = Size -> [e] -> UArray e
forall e. Prim e => Size -> [e] -> UArray e
fromListUArrayN (Int -> Size
coerce ([e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
xs)) [e]
xs
{-# INLINE fromListUArray #-}

-- | /O(1)/ - cast an unboxed `A.UArray` that is wired with GHC to `UArray` from primal.
--
-- >>> import Data.Array.IArray as IA
-- >>> import Data.Array.Unboxed as UA
-- >>> let uarr = IA.listArray (10, 15) [30 .. 35] :: UA.UArray Int Word
-- >>> uarr
-- array (10,15) [(10,30),(11,31),(12,32),(13,33),(14,34),(15,35)]
-- >>> fromBaseUArray uarr
-- UArray [30,31,32,33,34,35]
--
-- @since 0.3.0
fromBaseUArray :: (Prim e, A.IArray A.UArray e) => A.UArray ix e -> UArray e
fromBaseUArray :: UArray ix e -> UArray e
fromBaseUArray (A.UArray ix
_ ix
_ Int
_ ByteArray#
ba#) = ByteArray# -> UArray e
forall e. ByteArray# -> UArray e
UArray ByteArray#
ba#

-- | /O(1)/ - cast an unboxed `UArray` from primal into `A.UArray`, which is wired with
-- GHC. Resulting array range starts at 0, like any sane array would.
--
-- >>> let uarr = fromListUArray [1, 2, 3 :: Int]
-- >>> uarr
-- UArray [1,2,3]
-- >>> toBaseUArray uarr
-- array (0,2) [(0,1),(1,2),(2,3)]
--
-- @since 0.3.0
toBaseUArray :: (Prim e, A.IArray A.UArray e) => UArray e -> A.UArray Int e
toBaseUArray :: UArray e -> UArray Int e
toBaseUArray a :: UArray e
a@(UArray ByteArray#
ba#) =
  let Size Int
n = UArray e -> Size
forall e. Prim e => UArray e -> Size
sizeOfUArray UArray e
a
  in Int -> Int -> Int -> ByteArray# -> UArray Int e
forall i e. i -> i -> Int -> ByteArray# -> UArray i e
A.UArray Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int
n ByteArray#
ba#

-- Mutable Unboxed Array --
---------------------------

data UMArray e s = UMArray (MutableByteArray# s)
type role UMArray nominal nominal

-- | Check if both of the arrays refer to the exact same one through poiner equality. None
-- of the elements are evaluated.
instance Eq (UMArray e s) where
  == :: UMArray e s -> UMArray e s -> Bool
(==) = UMArray e s -> UMArray e s -> Bool
forall a b s. UMArray a s -> UMArray b s -> Bool
isSameUMArray
  {-# INLINE (==) #-}

-- | /O(1)/ - `UMArray` is always in NF
instance NFData (UMArray e s) where
  rnf :: UMArray e s -> ()
rnf (UMArray MutableByteArray# s
_) = ()
  {-# INLINE rnf #-}

-- | /O(1)/ - Compare pointers for two mutable arrays and see if they refer to the exact same one.
--
-- Documentation for utilized primop: `sameMutableByteArray#`.
--
-- @since 0.3.0
isSameUMArray :: forall a b s. UMArray a s -> UMArray b s -> Bool
isSameUMArray :: UMArray a s -> UMArray b s -> Bool
isSameUMArray (UMArray MutableByteArray# s
ma1#) (UMArray MutableByteArray# s
ma2#) = Int# -> Bool
isTrue# (MutableByteArray# s -> MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> MutableByteArray# d -> Int#
sameMutableByteArray# MutableByteArray# s
ma1# MutableByteArray# s
ma2#)
{-# INLINE isSameUMArray #-}


-- | /O(1)/ - Check if memory for mutable unboxed array was allocated as pinned.
--
-- Documentation for utilized primop: `isMutableByteArrayPinned#`.
--
-- @since 0.3.0
isPinnedUMArray :: forall e s. UMArray e s -> Bool
isPinnedUMArray :: UMArray e s -> Bool
isPinnedUMArray (UMArray MutableByteArray# s
mb#) = Int# -> Bool
isTrue# (MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> Int#
isMutableByteArrayPinned# MutableByteArray# s
mb#)
{-# INLINE isPinnedUMArray #-}

-- | /O(1)/ - Get the size of a mutable unboxed array
--
-- Documentation for utilized primop: `getSizeofMutableByteArray#`.
--
-- ====__Example__
--
-- >>> ma <- thawUArray $ fromListUArray ['a' .. 'z']
-- >>> getSizeOfUMArray ma
-- Size {unSize = 26}
--
-- @since 0.3.0
getSizeOfUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => UMArray e s
  -> m Size
getSizeOfUMArray :: UMArray e s -> m Size
getSizeOfUMArray (UMArray MutableByteArray# s
ma#) =
  (State# s -> (# State# s, Size #)) -> m Size
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Size #)) -> m Size)
-> (State# s -> (# State# s, Size #)) -> m Size
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableByteArray# s -> State# s -> (# State# s, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# s
ma# State# s
s of
      (# State# s
s', Int#
n# #) -> (# State# s
s', Count e -> Size
coerce (Count Word8 -> Count e
forall e. Prim e => Count Word8 -> Count e
fromByteCount (Int -> Count Word8
forall e. Int -> Count e
Count (Int# -> Int
I# Int#
n#)) :: Count e) #)
{-# INLINE getSizeOfUMArray #-}



-- | /O(1)/ - Read an element from a mutable unboxed array at the supplied index.
--
-- Documentation for utilized primop: `readMutableByteArray#`.
--
-- [Unsafe] Violation of @ix@ preconditions can result in value that doesn't belong to
-- @srcMutArray@ or a failure with a segfault
--
-- ==== __Examples__
--
-- >>> ma <- thawUArray $ fromListUArray "Hi!"
-- >>> readUMArray ma 2
-- '!'
--
-- @since 0.3.0
readUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => UMArray e s -- ^ /srcMutArray/ - Array to read an element from
  -> Int
  -- ^ /ix/ - Index for the element we need within the the @srcMutArray@
  --
  -- /__Precoditions:__/
  --
  -- > 0 <= ix
  --
  -- > srcSize <- getSizeOfMUArray srcMutArray
  -- > ix < unSize srcSize
  -> m e
readUMArray :: UMArray e s -> Int -> m e
readUMArray (UMArray MutableByteArray# s
ma#) (I# Int#
i#) = (State# s -> (# State# s, e #)) -> m e
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readMutableByteArray# MutableByteArray# s
ma# Int#
i#)
{-# INLINE readUMArray #-}


-- | /O(1)/ - Write an element into an unboxed mutable array at a supplied index.
--
-- Documentation for utilized primop: `writeMutableByteArray#`.
--
-- [Unsafe] Violation of @ix@ preconditions can result in heap corruption or a failure
-- with a segfault
--
-- ==== __Examples__
--
-- >>> import Data.Prim
-- >>> ma <- newRawUMArray 4 :: IO (UMArray (Maybe Int) RW)
-- >>> mapM_ (\i -> writeUMArray ma i Nothing) [0, 1, 3]
-- >>> writeUMArray ma 2 (Just 2)
-- >>> freezeUMArray ma
-- UArray [Nothing,Nothing,Just 2,Nothing]
--
-- @since 0.3.0
writeUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => UMArray e s
  -> Int
  -> e
  -> m ()
writeUMArray :: UMArray e s -> Int -> e -> m ()
writeUMArray (UMArray MutableByteArray# s
ma#) (I# Int#
i#) e
a = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s -> Int# -> e -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeMutableByteArray# MutableByteArray# s
ma# Int#
i# e
a)
{-# INLINE writeUMArray #-}

-- prop> newUMArray sz a === makeUMArray sz (const (pure a))
-- | /O(sz)/ - Allocate new mutable unboxed array. Similar to `newRawUMArray`, except all
-- elements are initialized to the supplied initial value. This is equivalent to
-- @makeUMArray sz (const (pure a))@ but often will be more efficient.
--
-- [Unsafe] When any of preconditions for @sz@ argument is violated the outcome is
-- unpredictable. One possible outcome is termination with `HeapOverflow` async
-- exception.
--
-- ==== __Examples__
--
-- >>> import Data.Prim
-- >>> let xs = "Hello"
-- >>> ma <- newUMArray (Size (length xs) + 8) '!' :: IO (UMArray Char RW)
-- >>> mapM_ (\(i, x) -> writeUMArray ma i x) (zip [0..] xs)
-- >>> freezeUMArray ma
-- UArray "Hello!!!!!!!!"
--
-- @since 0.3.0
newUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -- ^ /sz/ - Size of the array in number of elements.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Susceptible to integer overflow:
  --
  -- > 0 <= toByteCount (Count (unSize n) :: Count e)
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> e
  -> m (UMArray e s)
newUMArray :: Size -> e -> m (UMArray e s)
newUMArray Size
n e
e = Size -> m (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray Size
n m (UMArray e s)
-> (UMArray e s -> m (UMArray e s)) -> m (UMArray e s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UMArray e s
ma -> UMArray e s
ma UMArray e s -> m () -> m (UMArray e s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ UMArray e s -> Int -> Size -> e -> m ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UMArray e s -> Int -> Size -> e -> m ()
setUMArray UMArray e s
ma Int
0 Size
n e
e
{-# INLINE newUMArray #-}


-- | Same `newUMArray`, but allocate memory as pinned. See `newRawPinnedUMArray` for more info.
--
-- [Unsafe] - Same reasons as `newUMArray`.
--
-- @since 0.3.0
newPinnedUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -> e
  -> m (UMArray e s)
newPinnedUMArray :: Size -> e -> m (UMArray e s)
newPinnedUMArray Size
n e
e = Size -> m (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawPinnedUMArray Size
n m (UMArray e s)
-> (UMArray e s -> m (UMArray e s)) -> m (UMArray e s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UMArray e s
ma -> UMArray e s
ma UMArray e s -> m () -> m (UMArray e s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ UMArray e s -> Int -> Size -> e -> m ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UMArray e s -> Int -> Size -> e -> m ()
setUMArray UMArray e s
ma Int
0 Size
n e
e
{-# INLINE newPinnedUMArray #-}


-- | Same `newUMArray`, but allocate memory as pinned and aligned. See
-- `newRawAlignedPinnedUMArray` for more info.
--
-- [Unsafe] - Same reasons as `newUMArray`.
--
-- @since 0.3.0
newAlignedPinnedUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -> e
  -> m (UMArray e s)
newAlignedPinnedUMArray :: Size -> e -> m (UMArray e s)
newAlignedPinnedUMArray Size
n e
e = Size -> m (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawAlignedPinnedUMArray Size
n m (UMArray e s)
-> (UMArray e s -> m (UMArray e s)) -> m (UMArray e s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UMArray e s
ma -> UMArray e s
ma UMArray e s -> m () -> m (UMArray e s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ UMArray e s -> Int -> Size -> e -> m ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UMArray e s -> Int -> Size -> e -> m ()
setUMArray UMArray e s
ma Int
0 Size
n e
e
{-# INLINE newAlignedPinnedUMArray #-}



-- | Create new mutable unboxed array of the supplied size and fill it with a monadic action
-- that is applied to indices of each array cell.
--
-- [Unsafe] Same reasons as `newUMArray`
--
-- ====__Examples__
--
-- >>> ma <- makeUMArray 5 $ \i -> (toEnum (i + 97) :: Char) <$ putStrLn ("Handling index: " ++ show i)
-- Handling index: 0
-- Handling index: 1
-- Handling index: 2
-- Handling index: 3
-- Handling index: 4
-- >>> freezeUMArray ma
-- UArray "abcde"
--
-- @since 0.3.0
makeUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -> (Int -> m e)
  -> m (UMArray e s)
makeUMArray :: Size -> (Int -> m e) -> m (UMArray e s)
makeUMArray = (Size -> m (UMArray e s))
-> (UMArray e s -> Int -> e -> m ())
-> Size
-> (Int -> m e)
-> m (UMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b)
-> (b -> Int -> a -> m ()) -> Size -> (Int -> m a) -> m b
makeMutWith Size -> m (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawUMArray UMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UMArray e s -> Int -> e -> m ()
writeUMArray
{-# INLINE makeUMArray #-}


-- | Same as `makeUMArray`, but allocate memory as pinned.
--
-- [Unsafe] Same reasons as `newUMArray`
--
-- @since 0.3.0
makePinnedUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -> (Int -> m e)
  -> m (UMArray e s)
makePinnedUMArray :: Size -> (Int -> m e) -> m (UMArray e s)
makePinnedUMArray = (Size -> m (UMArray e s))
-> (UMArray e s -> Int -> e -> m ())
-> Size
-> (Int -> m e)
-> m (UMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b)
-> (b -> Int -> a -> m ()) -> Size -> (Int -> m a) -> m b
makeMutWith Size -> m (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawPinnedUMArray UMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UMArray e s -> Int -> e -> m ()
writeUMArray
{-# INLINE makePinnedUMArray #-}

-- | Same as `makeUMArray`, but allocate memory as pinned and aligned.
--
-- [Unsafe] Same reasons as `newUMArray`
--
-- @since 0.3.0
makeAlignedPinnedUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -> (Int -> m e)
  -> m (UMArray e s)
makeAlignedPinnedUMArray :: Size -> (Int -> m e) -> m (UMArray e s)
makeAlignedPinnedUMArray = (Size -> m (UMArray e s))
-> (UMArray e s -> Int -> e -> m ())
-> Size
-> (Int -> m e)
-> m (UMArray e s)
forall (m :: * -> *) b a.
Monad m =>
(Size -> m b)
-> (b -> Int -> a -> m ()) -> Size -> (Int -> m a) -> m b
makeMutWith Size -> m (UMArray e s)
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
Size -> m (UMArray e s)
newRawAlignedPinnedUMArray UMArray e s -> Int -> e -> m ()
forall e (m :: * -> *) s.
(Prim e, MonadPrim s m) =>
UMArray e s -> Int -> e -> m ()
writeUMArray
{-# INLINE makeAlignedPinnedUMArray #-}


-- | /O(1)/ - Allocate new mutable unboxed array. None of the elements are initialized so
-- expect it to contain some random garbage.
--
-- Documentation for utilized primop: `newByteArray#`.
--
-- [Unsafe] When any of preconditions for @sz@ argument is violated the outcome is
-- unpredictable. One possible outcome is termination with `HeapOverflow` async
-- exception. In a pure setting, such as when executed within `runST`, if each cell in new
-- array is not overwritten it can lead to violation of referential transparency, because
-- contents of newly allocated unboxed array is non-determinstic.
--
-- ==== __Examples__
--
-- >>> import Data.Prim
-- >>> let xs = "Hello Haskell"
-- >>> ma <- newRawUMArray (Size (length xs)) :: IO (UMArray Char RW)
-- >>> mapM_ (\(i, x) -> writeUMArray ma i x) (zip [0..] xs)
-- >>> freezeUMArray ma
-- UArray "Hello Haskell"
--
-- @since 0.3.0
newRawUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -- ^ /sz/ - Size of the array in number of elements.
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Susceptible to integer overflow:
  --
  -- > 0 <= toByteCount (Count (unSize n) :: Count e)
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> m (UMArray e s)
newRawUMArray :: Size -> m (UMArray e s)
newRawUMArray Size
n =
  (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s))
-> (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# (Size -> Count e
coerce Size
n :: Count e)) State# s
s of
      (# State# s
s', MutableByteArray# s
ma# #) -> (# State# s
s', MutableByteArray# s -> UMArray e s
forall e s. MutableByteArray# s -> UMArray e s
UMArray MutableByteArray# s
ma# #)
{-# INLINE newRawUMArray #-}

-- | /O(1)/ - Same as `newRawUMArray` except allocate new mutable unboxed array as pinned
--
-- Documentation for utilized primop: `newPinnedByteArray#`.
--
-- [Unsafe] Same reasons as in `newRawUMArray`.
--
-- @since 0.3.0
newRawPinnedUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -> m (UMArray e s)
newRawPinnedUMArray :: Size -> m (UMArray e s)
newRawPinnedUMArray Size
n =
  (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s))
-> (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# (Size -> Count e
coerce Size
n :: Count e)) State# s
s of
      (# State# s
s', MutableByteArray# s
ma# #) -> (# State# s
s', MutableByteArray# s -> UMArray e s
forall e s. MutableByteArray# s -> UMArray e s
UMArray MutableByteArray# s
ma# #)
{-# INLINE newRawPinnedUMArray #-}

-- | /O(1)/ - Same as `newRawPinnedUMArray` except allocate new mutable unboxed array as
-- pinned and aligned according to the `Prim` instance for the type of element @__e__@
--
-- Documentation for utilized primop: `newAlignedPinnedByteArray#`.
--
-- [Unsafe] Same reasons as in `newRawUMArray`.
--
-- @since 0.3.0
newRawAlignedPinnedUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => Size
  -> m (UMArray e s)
newRawAlignedPinnedUMArray :: Size -> m (UMArray e s)
newRawAlignedPinnedUMArray Size
n =
  (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s))
-> (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    let c# :: Int#
c# = Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# (Size -> Count e
coerce Size
n :: Count e)
        a# :: Int#
a# = Proxy# e -> Int#
forall a. Prim a => Proxy# a -> Int#
alignment# (Proxy# e
forall k (a :: k). Proxy# a
proxy# :: Proxy# e)
     in case Int# -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
c# Int#
a# State# s
s of
          (# State# s
s', MutableByteArray# s
ma# #) -> (# State# s
s', MutableByteArray# s -> UMArray e s
forall e s. MutableByteArray# s -> UMArray e s
UMArray MutableByteArray# s
ma# #)
{-# INLINE newRawAlignedPinnedUMArray #-}


-- | /O(sz)/ - Copy a subsection of a mutable array into a subsection of another or the same
-- mutable array. Therefore, unlike `copyBArray`, memory ia allowed to overlap between
-- source and destination.
--
-- Documentation for utilized primop: `copyMutableByteArray#`.
--
-- [Unsafe] When any of the preconditions for @srcStartIx@, @dstStartIx@ or @sz@ is violated
-- this function can result in a copy of some data that doesn't belong to @srcArray@ or
-- failure with a segfault.
--
-- @since 0.3.0
moveUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => UMArray e s -- ^ /srcMutArray/ - Source mutable array
  -> Int
  -- ^ /srcStartIx/ - Offset into the source mutable array where copy should start from
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= srcStartIx
  --
  -- > srcSize <- getSizeOfMUArray srcMutArray
  -- > srcStartIx < unSize srcSize
  -> UMArray e s -- ^ /dstMutArray/ - Destination mutable array
  -> Int
  -- ^ /dstStartIx/ - Offset into the destination mutable array where copy should start to
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= dstStartIx
  --
  -- > dstSize <- getSizeOfMUArray dstMutArray
  -- > dstStartIx < unSize dstSize
  -> Size
  -- ^ /sz/ - Number of elements to copy over
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > srcSize <- getSizeOfMUArray srcMutArray
  -- > srcStartIx + unSize sz < unSize srcSize
  --
  -- > dstSize <- getSizeOfMUArray dstMutArray
  -- > dstStartIx + unSize sz < unSize dstSize
  -> m ()
moveUMArray :: UMArray e s -> Int -> UMArray e s -> Int -> Size -> m ()
moveUMArray (UMArray MutableByteArray# s
src#) Int
srcOff (UMArray MutableByteArray# s
dst#) Int
dstOff Size
n =
  let srcOff# :: Int#
srcOff# = Off e -> Int#
forall e. Prim e => Off e -> Int#
unOffBytes# (Int -> Off e
coerce Int
srcOff :: Off e)
      dstOff# :: Int#
dstOff# = Off e -> Int#
forall e. Prim e => Off e -> Int#
unOffBytes# (Int -> Off e
coerce Int
dstOff :: Off e)
      n# :: Int#
n# = Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# (Size -> Count e
coerce Size
n :: Count e)
  in (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# s
src# Int#
srcOff# MutableByteArray# s
dst# Int#
dstOff# Int#
n#)
{-# INLINE moveUMArray #-}


-- | /O(n)/ - Write the same element into the @dstMutArray@ mutable array @n@ times starting
-- at @dstStartIx@ offset.
--
-- [Unsafe]
--
-- @since 0.3.0
setUMArray ::
     forall e m s. (Prim e, MonadPrim s m)
  => UMArray e s -- ^ /dstMutArray/ - Mutable array
  -> Int
  -- ^ /dstStartIx/ - Offset into the mutable array
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= dstStartIx
  --
  -- > dstSize <- getSizeOfMUArray dstMutArray
  -- > dstStartIx < unSize dstSize
  -> Size
  -- ^ /n/ - Number of elements to overwrite
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= n
  --
  -- > dstSize <- getSizeOfMUArray dstMutArray
  -- > dstStartIx + unSize n < unSize dstSize
  -> e -- ^ /elt/ - Value to overwrite the cells with in the specified block
  -> m ()
setUMArray :: UMArray e s -> Int -> Size -> e -> m ()
setUMArray (UMArray MutableByteArray# s
ma#) (I# Int#
o#) (Size (I# Int#
n#)) e
a =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s -> Int# -> Int# -> e -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
setMutableByteArray# MutableByteArray# s
ma# Int#
o# Int#
n# e
a)
{-# INLINE setUMArray #-}


-- | /O(1)/ - Reduce the size of a mutable unboxed array.
--
-- Documentation for utilized primop: `shrinkMutableByteArray#`.
--
-- [Unsafe] - Violation of preconditions for @sz@ leads to undefined behavior
--
-- 0.3.0
shrinkUMArray ::
     forall e m s. (MonadPrim s m, Prim e)
  => UMArray e s -- ^ /mutArray/ - Mutable unboxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- > curSize <- getSizeOfUMArray mutArray
  -- > sz <= curSize
  -> m ()
shrinkUMArray :: UMArray e s -> Size -> m ()
shrinkUMArray (UMArray MutableByteArray# s
mb#) Size
sz =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s -> Int# -> State# s -> State# s
forall d. MutableByteArray# d -> Int# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# s
mb# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# (Size -> Count e
coerce Size
sz :: Count e)))
{-# INLINE shrinkUMArray #-}

-- | /O(1)/ - Either grow or shrink the size of a mutable unboxed array. Shrinking happens
-- without new allocation and data copy, while growing the array is implemented with
-- allocation of new unpinned array and copy of the data over from the source array
-- @srcMutArray@. This has a consequence that produced array @dstMutArray@ might refer to
-- the same @srcMutArray@ or to a totally new array, which can be checked with
-- `isSameUMArray`.
--
-- Documentation on the utilized primop: `resizeMutableByteArray#`.
--
-- [Unsafe] - Same reasons as in `newRawUMArray`. When size @sz@ is larger then the
-- size of @srcMutArray@ then @dstMutArray@ will contain uninitialized memory at its end,
-- hence a potential problem for referential transparency.
--
-- 0.3.0
resizeUMArray ::
     forall e m s. (MonadPrim s m, Prim e)
  => UMArray e s -- ^ /srcMutArray/ - Mutable unboxed array to be shrunk
  -> Size
  -- ^ /sz/ - New size for the array in number of elements
  --
  -- /__Preconditions:__/
  --
  -- > 0 <= sz
  --
  -- Susceptible to integer overflow:
  --
  -- > 0 <= toByteCount (Count (unSize n) :: Count e)
  --
  -- Should be below some upper limit that is dictated by the operating system and the total
  -- amount of available memory
  -> m (UMArray e s) -- ^ /dstMutArray/ - produces a resized version of /srcMutArray/.
resizeUMArray :: UMArray e s -> Size -> m (UMArray e s)
resizeUMArray (UMArray MutableByteArray# s
mb#) Size
sz =
  (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s))
-> (State# s -> (# State# s, UMArray e s #)) -> m (UMArray e s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableByteArray# s
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
resizeMutableByteArray# MutableByteArray# s
mb# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# (Size -> Count e
coerce Size
sz :: Count e)) State# s
s of
      (# State# s
s', MutableByteArray# s
mb'# #) -> (# State# s
s', MutableByteArray# s -> UMArray e s
forall e s. MutableByteArray# s -> UMArray e s
UMArray MutableByteArray# s
mb'# #)
{-# INLINE resizeUMArray #-}



-- | /O(1)/ - Convert a mutable unboxed array into an immutable one. Use `thawUArray` in order
-- to go in the opposite direction.
--
-- Documentation on the utilized primop: `unsafeFreezeByteArray#`.
--
-- [Unsafe] This function makes it possible to break referential transparency, because any
-- subsequent destructive operation to the source mutable boxed array will also be reflected
-- in the resulting immutable array. See `freezeCopyBMArray` that avoids this problem with
-- fresh allocation.
--
-- @since 0.3.0
freezeUMArray ::
     forall e m s. MonadPrim s m
  => UMArray e s
  -> m (UArray e)
freezeUMArray :: UMArray e s -> m (UArray e)
freezeUMArray (UMArray MutableByteArray# s
ma#) = (State# s -> (# State# s, UArray e #)) -> m (UArray e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, UArray e #)) -> m (UArray e))
-> (State# s -> (# State# s, UArray e #)) -> m (UArray e)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
  case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
ma# State# s
s of
    (# State# s
s', ByteArray#
a# #) -> (# State# s
s', ByteArray# -> UArray e
forall e. ByteArray# -> UArray e
UArray ByteArray#
a# #)
{-# INLINE freezeUMArray #-}

-------------
-- Helpers --
-- ======= --

-- | Default "raw" element for boxed arrays.
uninitialized ::
     HasCallStack
  => String -- ^ Module name
  -> String -- ^ Function name
  -> a
uninitialized :: String -> String -> a
uninitialized String
mname String
fname =
  ArrayException -> a
forall e a. Exception e => e -> a
impureThrow (ArrayException -> a) -> ArrayException -> a
forall a b. (a -> b) -> a -> b
$
  String -> ArrayException
UndefinedElement (String -> ArrayException) -> String -> ArrayException
forall a b. (a -> b) -> a -> b
$ String
mname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack
{-# NOINLINE uninitialized #-}

-- | Convert a list to a mutable array
fromListMutWith ::
     Monad m
  => (Size -> m b) -- ^ Function for array creation
  -> (b -> Int -> a -> m ()) -- ^ Function for writing elements
  -> Size -- ^ Size for the created array
  -> [a] -- ^ Function for generating elements from array index
  -> m b
fromListMutWith :: (Size -> m b) -> (b -> Int -> a -> m ()) -> Size -> [a] -> m b
fromListMutWith Size -> m b
new b -> Int -> a -> m ()
write sz :: Size
sz@(Size Int
n) [a]
ls = do
  b
ma <- Size -> m b
new Size
sz
  let go :: Int -> [a] -> m ()
go Int
i =
        \case
          a
x:[a]
xs
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n -> b -> Int -> a -> m ()
write b
ma Int
i a
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [a] -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
          [a]
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  b
ma b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> [a] -> m ()
go Int
0 [a]
ls
{-# INLINE fromListMutWith #-}


-- | Helper for generating mutable arrays
--
-- @since 0.3.0
makeMutWith ::
     Monad m
  => (Size -> m b) -- ^ Function for array creation
  -> (b -> Int -> a -> m ()) -- ^ Function for writing elements
  -> Size -- ^ Size for the created array
  -> (Int -> m a) -- ^ Function for generating elements from array index
  -> m b
makeMutWith :: (Size -> m b)
-> (b -> Int -> a -> m ()) -> Size -> (Int -> m a) -> m b
makeMutWith Size -> m b
new b -> Int -> a -> m ()
write sz :: Size
sz@(Size Int
n) Int -> m a
f = do
  b
ma <- Size -> m b
new Size
sz
  let go :: Int -> m ()
go Int
i = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> m a
f Int
i m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Int -> a -> m ()
write b
ma Int
i m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  b
ma b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> m ()
go Int
0
{-# INLINE makeMutWith #-}


-- | Right fold that is strict on the element. The key feature of this function is that it
--  can be used to convert an array to a list by integrating with list fusion using `build`.
--
-- @since 0.3.0
foldrWithFB ::
     (a e -> Size) -- ^ Function that produces the size of an array
  -> (a e -> Int -> e) -- ^ Indexing function
  -> (e -> b -> b) -- ^ Folding functions
  -> b -- ^ Initial accumulator
  -> a e -- ^ Array to fold over
  -> b
foldrWithFB :: (a e -> Size)
-> (a e -> Int -> e) -> (e -> b -> b) -> b -> a e -> b
foldrWithFB a e -> Size
size a e -> Int -> e
index e -> b -> b
c b
nil a e
a = Int -> b
go Int
0
  where
    k :: Int
k = Size -> Int
coerce (a e -> Size
size a e
a)
    go :: Int -> b
go Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k = b
nil
      | Bool
otherwise =
        let v :: e
v = a e -> Int -> e
index a e
a Int
i
         in e
v e -> b -> b
`seq` (e
v e -> b -> b
`c` Int -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
{-# INLINE[0] foldrWithFB #-}

-- | Check for equality of two arrays
--
-- @since 0.3.0
eqWith ::
     Eq e
  => (a e -> a e -> Bool) -- ^ Pointer equality
  -> (a e -> Size) -- ^ Get the size of array
  -> (a e -> Int -> e) -- ^ Index an element of an array
  -> a e -- ^ First array
  -> a e -- ^ Second array
  -> Bool
eqWith :: (a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Bool
eqWith a e -> a e -> Bool
isSame a e -> Size
sizeOf a e -> Int -> e
index a e
a1 a e
a2 = a e -> a e -> Bool
isSame a e
a1 a e
a2 Bool -> Bool -> Bool
|| (Size
sz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== a e -> Size
sizeOf a e
a2 Bool -> Bool -> Bool
&& Int -> Bool
loop Int
0)
  where
    sz1 :: Size
sz1@(Size Int
n) = a e -> Size
sizeOf a e
a1
    loop :: Int -> Bool
loop Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = a e -> Int -> e
index a e
a1 Int
i e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== a e -> Int -> e
index a e
a2 Int
i Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = Bool
True
{-# INLINE eqWith #-}



-- | Check for equality of two arrays
--
-- @since 0.3.0
liftEqWith ::
     (forall e. a e -> Size) -- ^ Get the size of array
  -> (forall e. a e -> Int -> e) -- ^ Index an element of an array
  -> (b -> c -> Bool)
  -> a b -- ^ First array
  -> a c -- ^ Second array
  -> Bool
liftEqWith :: (forall e. a e -> Size)
-> (forall e. a e -> Int -> e)
-> (b -> c -> Bool)
-> a b
-> a c
-> Bool
liftEqWith forall e. a e -> Size
sizeOf forall e. a e -> Int -> e
index b -> c -> Bool
eq a b
a1 a c
a2 = Size
sz1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== a c -> Size
forall e. a e -> Size
sizeOf a c
a2 Bool -> Bool -> Bool
&& Int -> Bool
loop Int
0
  where
    sz1 :: Size
sz1@(Size Int
n) = a b -> Size
forall e. a e -> Size
sizeOf a b
a1
    loop :: Int -> Bool
loop Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = (a b -> Int -> b
forall e. a e -> Int -> e
index a b
a1 Int
i b -> c -> Bool
`eq` a c -> Int -> c
forall e. a e -> Int -> e
index a c
a2 Int
i) Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = Bool
True
{-# INLINE liftEqWith #-}

liftShowsPrecArray :: Foldable f => String -> ([e] -> ShowS) -> Int -> f e -> ShowS
liftShowsPrecArray :: String -> ([e] -> ShowS) -> Int -> f e -> ShowS
liftShowsPrecArray String
tyName [e] -> ShowS
listShows Int
n f e
arr
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = (Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
:)
  | Bool
otherwise = ShowS
inner
  where
    inner :: ShowS
inner = (String
tyName String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [e] -> ShowS
listShows (f e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f e
arr)


-- | Compare two arrays using supplied functions
--
-- @since 0.3.0
compareWith ::
     Ord e
  => (a e -> a e -> Bool) -- ^ Pointer equality
  -> (a e -> Size) -- ^ Get the size of array
  -> (a e -> Int -> e) -- ^ Index an element of an array
  -> a e -- ^ First array
  -> a e -- ^ Second array
  -> Ordering
compareWith :: (a e -> a e -> Bool)
-> (a e -> Size) -> (a e -> Int -> e) -> a e -> a e -> Ordering
compareWith a e -> a e -> Bool
isSame a e -> Size
sizeOf a e -> Int -> e
index a e
a1 a e
a2
  | a e -> a e -> Bool
isSame a e
a1 a e
a2 = Ordering
EQ
  | Bool
otherwise = Int -> Ordering
loop Int
0
  where
    Size Int
n = Size -> Size -> Size
forall a. Ord a => a -> a -> a
min (a e -> Size
sizeOf a e
a1) (a e -> Size
sizeOf a e
a2)
    loop :: Int -> Ordering
loop Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = e -> e -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a e -> Int -> e
index a e
a1 Int
i) (a e -> Int -> e
index a e
a2 Int
i) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Int -> Ordering
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a e -> Size
sizeOf a e
a1) (a e -> Size
sizeOf a e
a2)
{-# INLINE compareWith #-}


-- | Compare two arrays using supplied functions
--
-- @since 0.3.0
liftCompareWith ::
     (forall e. a e -> Size) -- ^ Get the size of array
  -> (forall e. a e -> Int -> e) -- ^ Index an element of an array
  -> (b -> c -> Ordering)
  -> a b -- ^ First array
  -> a c -- ^ Second array
  -> Ordering
liftCompareWith :: (forall e. a e -> Size)
-> (forall e. a e -> Int -> e)
-> (b -> c -> Ordering)
-> a b
-> a c
-> Ordering
liftCompareWith forall e. a e -> Size
sizeOf forall e. a e -> Int -> e
index b -> c -> Ordering
comp a b
a1 a c
a2 = Int -> Ordering
loop Int
0
  where
    Size Int
n = Size -> Size -> Size
forall a. Ord a => a -> a -> a
min (a b -> Size
forall e. a e -> Size
sizeOf a b
a1) (a c -> Size
forall e. a e -> Size
sizeOf a c
a2)
    loop :: Int -> Ordering
loop Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = b -> c -> Ordering
comp (a b -> Int -> b
forall e. a e -> Int -> e
index a b
a1 Int
i) (a c -> Int -> c
forall e. a e -> Int -> e
index a c
a2 Int
i) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Int -> Ordering
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a b -> Size
forall e. a e -> Size
sizeOf a b
a1) (a c -> Size
forall e. a e -> Size
sizeOf a c
a2)
{-# INLINE liftCompareWith #-}

-- | Append two arrays together using supplied functions
--
-- @since 0.3.0
appendWith ::
     (forall s. Size -> ST s (ma e s))
  -> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
  -> (forall s. ma e s -> ST s (a e))
  -> (a e -> Size)
  -> a e
  -> a e
  -> a e
appendWith :: (forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> a e
-> a e
-> a e
appendWith forall s. Size -> ST s (ma e s)
newRaw forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ()
copy forall s. ma e s -> ST s (a e)
freeze a e -> Size
sizeOf a e
a1 a e
a2 =
  (forall s. ST s (a e)) -> a e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a e)) -> a e) -> (forall s. ST s (a e)) -> a e
forall a b. (a -> b) -> a -> b
$ do
    let n1 :: Size
n1 = a e -> Size
sizeOf a e
a1
        n2 :: Size
n2 = a e -> Size
sizeOf a e
a2
    ma e s
ma <- Size -> ST s (ma e s)
forall s. Size -> ST s (ma e s)
newRaw (Size
n1 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
n2)
    a e -> Int -> ma e s -> Int -> Size -> ST s ()
forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ()
copy a e
a1 Int
0 ma e s
ma Int
0 Size
n1
    a e -> Int -> ma e s -> Int -> Size -> ST s ()
forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ()
copy a e
a2 Int
0 ma e s
ma (Size -> Int
coerce Size
n1) Size
n2
    ma e s -> ST s (a e)
forall s. ma e s -> ST s (a e)
freeze ma e s
ma
{-# INLINE appendWith #-}


-- | Concat many arrays together using supplied functions
--
-- @since 0.3.0
concatWith ::
     (forall s. Size -> ST s (ma e s))
  -> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
  -> (forall s. ma e s -> ST s (a e))
  -> (a e -> Size)
  -> [a e]
  -> a e
concatWith :: (forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> [a e]
-> a e
concatWith forall s. Size -> ST s (ma e s)
newRaw forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ()
copy forall s. ma e s -> ST s (a e)
freeze a e -> Size
sizeOf [a e]
xs =
  (forall s. ST s (a e)) -> a e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a e)) -> a e) -> (forall s. ST s (a e)) -> a e
forall a b. (a -> b) -> a -> b
$ do
    let as :: [(Size, a e)]
as = [(a e -> Size
sizeOf a e
a, a e
a) | a e
a <- [a e]
xs]
        !n :: Size
n = Sum Size -> Size
forall a. Sum a -> a
getSum (Sum Size -> Size) -> Sum Size -> Size
forall a b. (a -> b) -> a -> b
$ ((Size, a e) -> Sum Size) -> [(Size, a e)] -> Sum Size
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Size -> Sum Size
forall a. a -> Sum a
Sum (Size -> Sum Size)
-> ((Size, a e) -> Size) -> (Size, a e) -> Sum Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size, a e) -> Size
forall a b. (a, b) -> a
fst) [(Size, a e)]
as
    ma e s
ma <- Size -> ST s (ma e s)
forall s. Size -> ST s (ma e s)
newRaw Size
n
    let load :: Int -> (Size, a e) -> ST s Int
load Int
i (Size
sz, a e
a) = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Size -> Int
coerce Size
sz) Int -> ST s () -> ST s Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a e -> Int -> ma e s -> Int -> Size -> ST s ()
forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ()
copy a e
a Int
0 ma e s
ma Int
i Size
sz
    (Int -> (Size, a e) -> ST s Int) -> Int -> [(Size, a e)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Int -> (Size, a e) -> ST s Int
load Int
0 [(Size, a e)]
as
    ma e s -> ST s (a e)
forall s. ma e s -> ST s (a e)
freeze ma e s
ma
{-# INLINE concatWith #-}


-- | Repeat an array N times and concat them together using supplied functions
--
-- @since 0.3.0
cycleWith ::
     Monoid (a e)
  => (forall s. Size -> ST s (ma e s))
  -> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
  -> (forall s. ma e s -> ST s (a e))
  -> (a e -> Size)
  -> Int
  -> a e
  -> a e
cycleWith :: (forall s. Size -> ST s (ma e s))
-> (forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ())
-> (forall s. ma e s -> ST s (a e))
-> (a e -> Size)
-> Int
-> a e
-> a e
cycleWith forall s. Size -> ST s (ma e s)
newRaw forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ()
copy forall s. ma e s -> ST s (a e)
freeze a e -> Size
sizeOf Int
k a e
a
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = a e
forall a. Monoid a => a
mempty
  | Bool
otherwise =
    (forall s. ST s (a e)) -> a e
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (a e)) -> a e) -> (forall s. ST s (a e)) -> a e
forall a b. (a -> b) -> a -> b
$ do
      let sz :: Size
sz@(Size Int
n) = a e -> Size
sizeOf a e
a
      ma e s
ma <- Size -> ST s (ma e s)
forall s. Size -> ST s (ma e s)
newRaw (Int -> Size
Size Int
k Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
sz)
      let load :: Int -> ST s ()
load Int
i = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ a e -> Int -> ma e s -> Int -> Size -> ST s ()
forall s. a e -> Int -> ma e s -> Int -> Size -> ST s ()
copy a e
a Int
0 ma e s
ma (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Size
sz ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
load (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      Int -> ST s ()
load Int
0
      ma e s -> ST s (a e)
forall s. ma e s -> ST s (a e)
freeze ma e s
ma
{-# INLINE cycleWith #-}