{-# language BangPatterns #-}
{-# language MagicHash #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language TypeFamilies #-}
{-# language UnboxedTuples #-}
{-# language RoleAnnotations #-}

-- |
-- A version of the 'Data.Primitive.Unlifted.Array' interface
-- specialized to 'ST'. This is intended primarily so library
-- developers can easily check whether the basic operations are
-- unboxed properly, but its more constrained type signatures
-- also offer somewhat better type inference where applicable.
module Data.Primitive.Unlifted.Array.ST
  ( -- * Types
    UnliftedArray_(..)
  , UnliftedArray
  , MutableUnliftedArray_(..)
  , MutableUnliftedArray
    -- * Operations
  , newUnliftedArray
  , unsafeNewUnliftedArray
  , sizeofUnliftedArray
  , sizeofMutableUnliftedArray
  , sameMutableUnliftedArray
  , writeUnliftedArray
  , readUnliftedArray
  , indexUnliftedArray
  , unsafeFreezeUnliftedArray
  , freezeUnliftedArray
  , thawUnliftedArray
  , unsafeThawUnliftedArray
  , setUnliftedArray
  , copyUnliftedArray
  , copyMutableUnliftedArray
  , cloneUnliftedArray
  , cloneMutableUnliftedArray
  , emptyUnliftedArray
  , singletonUnliftedArray
  , runUnliftedArray
  , dupableRunUnliftedArray
    -- * List Conversion
  , unliftedArrayToList
  , unliftedArrayFromList
  , unliftedArrayFromListN
    -- * Folding
  , foldrUnliftedArray
  , foldrUnliftedArray'
  , foldlUnliftedArray
  , foldlUnliftedArray'
  , foldlUnliftedArrayM'
    -- * Traversals
  , traverseUnliftedArray_
  , itraverseUnliftedArray_
    -- * Mapping
  , mapUnliftedArray
  ) where

import Data.Primitive.Unlifted.Class (PrimUnlifted (..))
import Data.Primitive.Unlifted.Array.Primops
import GHC.Exts (Int(I#),State#)
import GHC.ST (ST (..))

import qualified Data.List as L
import qualified GHC.Exts as Exts

-- | Using a specialized copy of primitive_ here makes the Core a little
-- easier to read by eliminating unnecessary PrimState coercions.
primitive_ :: (State# s -> State# s) -> ST s ()
{-# INLINE primitive_ #-}
primitive_ :: (State# s -> State# s) -> ST s ()
primitive_ State# s -> State# s
m = STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (\State# s
s -> (# State# s -> State# s
m State# s
s, () #))

-- | An @UnliftedArray_ a unlifted_a@ represents an array of values of a
-- lifted type @a@ that wrap values of an unlifted type @unlifted_a@.
-- It is expected that @unlifted_a ~ Unlifted a@, but imposing that constraint
-- here would force the type roles to @nominal@, which is often undesirable
-- when arrays are used as components of larger datatypes.
data UnliftedArray_ a unlifted_a
  = UnliftedArray (UnliftedArray# unlifted_a)
type role UnliftedArray_ phantom representational

-- | A type synonym for an 'UnliftedArray_' containing lifted values of
-- a particular type. As a general rule, this type synonym should not be used in
-- class instances—use 'UnliftedArray_' with an equality constraint instead.
-- It also should not be used when defining newtypes or datatypes, unless those
-- will have restrictive type roles regardless—use 'UnliftedArray_' instead.
type UnliftedArray a = UnliftedArray_ a (Unlifted a)

-- | A mutable version of 'UnliftedArray_'.
data MutableUnliftedArray_ s a unlifted_a
  = MutableUnliftedArray (MutableUnliftedArray# s unlifted_a)
type role MutableUnliftedArray_ nominal phantom representational

-- | A mutable version of 'MutableUnliftedArray'.
type MutableUnliftedArray s a = MutableUnliftedArray_ s a (Unlifted a)

instance unlifted_a ~ Unlifted a => PrimUnlifted (UnliftedArray_ a unlifted_a) where
  type Unlifted (UnliftedArray_ _ unlifted_a) = UnliftedArray# unlifted_a
  toUnlifted# :: UnliftedArray_ a unlifted_a
-> Unlifted (UnliftedArray_ a unlifted_a)
toUnlifted# (UnliftedArray UnliftedArray# unlifted_a
a) = UnliftedArray# unlifted_a
Unlifted (UnliftedArray_ a unlifted_a)
a
  fromUnlifted# :: Unlifted (UnliftedArray_ a unlifted_a)
-> UnliftedArray_ a unlifted_a
fromUnlifted# Unlifted (UnliftedArray_ a unlifted_a)
x = UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray UnliftedArray# unlifted_a
Unlifted (UnliftedArray_ a unlifted_a)
x

instance unlifted_a ~ Unlifted a => PrimUnlifted (MutableUnliftedArray_ s a unlifted_a) where
  type Unlifted (MutableUnliftedArray_ s _ unlifted_a) = MutableUnliftedArray# s unlifted_a
  toUnlifted# :: MutableUnliftedArray_ s a unlifted_a
-> Unlifted (MutableUnliftedArray_ s a unlifted_a)
toUnlifted# (MutableUnliftedArray MutableUnliftedArray# s unlifted_a
a) = MutableUnliftedArray# s unlifted_a
Unlifted (MutableUnliftedArray_ s a unlifted_a)
a
  fromUnlifted# :: Unlifted (MutableUnliftedArray_ s a unlifted_a)
-> MutableUnliftedArray_ s a unlifted_a
fromUnlifted# Unlifted (MutableUnliftedArray_ s a unlifted_a)
x = MutableUnliftedArray# s unlifted_a
-> MutableUnliftedArray_ s a unlifted_a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s unlifted_a
-> MutableUnliftedArray_ s a unlifted_a
MutableUnliftedArray MutableUnliftedArray# s unlifted_a
Unlifted (MutableUnliftedArray_ s a unlifted_a)
x

-- | Creates a new 'MutableUnliftedArray' with the specified value as initial
-- contents.
newUnliftedArray
  :: PrimUnlifted a
  => Int -- ^ size
  -> a -- ^ initial value
  -> ST s (MutableUnliftedArray s a)
newUnliftedArray :: Int -> a -> ST s (MutableUnliftedArray s a)
newUnliftedArray (I# Int#
len) a
v = STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall s a. STRep s a -> ST s a
ST (STRep s (MutableUnliftedArray s a)
 -> ST s (MutableUnliftedArray s a))
-> STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Int#
-> Unlifted a
-> State# s
-> (# State# s, MutableUnliftedArray# s (Unlifted a) #)
forall (a :: TYPE 'UnliftedRep) s.
Int# -> a -> State# s -> (# State# s, MutableUnliftedArray# s a #)
newUnliftedArray# Int#
len (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
v) State# s
s of
  (# State# s
s', MutableUnliftedArray# s (Unlifted a)
ma #) -> (# State# s
s', MutableUnliftedArray# s (Unlifted a) -> MutableUnliftedArray s a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s unlifted_a
-> MutableUnliftedArray_ s a unlifted_a
MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
ma #)
{-# inline newUnliftedArray #-}

setUnliftedArray
  :: PrimUnlifted a
  => MutableUnliftedArray s a -- ^ destination
  -> a -- ^ value to fill with
  -> Int -- ^ offset
  -> Int -- ^ length
  -> ST s ()
{-# inline setUnliftedArray #-}
setUnliftedArray :: MutableUnliftedArray s a -> a -> Int -> Int -> ST s ()
setUnliftedArray MutableUnliftedArray s a
mua a
v Int
off Int
len = Int -> ST s ()
loop (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
 where
 loop :: Int -> ST s ()
loop Int
i
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
off = () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
   | Bool
otherwise = MutableUnliftedArray s a -> Int -> a -> ST s ()
forall a s.
PrimUnlifted a =>
MutableUnliftedArray s a -> Int -> a -> ST s ()
writeUnliftedArray MutableUnliftedArray s a
mua Int
i a
v ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

-- | Yields the length of an 'UnliftedArray'.
sizeofUnliftedArray :: UnliftedArray e -> Int
{-# inline sizeofUnliftedArray #-}
sizeofUnliftedArray :: UnliftedArray e -> Int
sizeofUnliftedArray (UnliftedArray UnliftedArray# (Unlifted e)
ar) = Int# -> Int
I# (UnliftedArray# (Unlifted e) -> Int#
forall (a :: TYPE 'UnliftedRep). UnliftedArray# a -> Int#
sizeofUnliftedArray# UnliftedArray# (Unlifted e)
ar)

-- | Yields the length of a 'MutableUnliftedArray'.
sizeofMutableUnliftedArray :: MutableUnliftedArray s e -> Int
{-# inline sizeofMutableUnliftedArray #-}
sizeofMutableUnliftedArray :: MutableUnliftedArray s e -> Int
sizeofMutableUnliftedArray (MutableUnliftedArray MutableUnliftedArray# s (Unlifted e)
maa#)
  = Int# -> Int
I# (MutableUnliftedArray# s (Unlifted e) -> Int#
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a -> Int#
sizeofMutableUnliftedArray# MutableUnliftedArray# s (Unlifted e)
maa#)

writeUnliftedArray :: PrimUnlifted a
  => MutableUnliftedArray s a
  -> Int
  -> a
  -> ST s ()
{-# inline writeUnliftedArray #-}
writeUnliftedArray :: MutableUnliftedArray s a -> Int -> a -> ST s ()
writeUnliftedArray (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
arr) (I# Int#
ix) a
a =
  (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
primitive_ (MutableUnliftedArray# s (Unlifted a)
-> Int# -> Unlifted a -> State# s -> State# s
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a -> Int# -> a -> State# s -> State# s
writeUnliftedArray# MutableUnliftedArray# s (Unlifted a)
arr Int#
ix (a -> Unlifted a
forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# a
a))

readUnliftedArray :: PrimUnlifted a
  => MutableUnliftedArray s a
  -> Int
  -> ST s a
{-# inline readUnliftedArray #-}
readUnliftedArray :: MutableUnliftedArray s a -> Int -> ST s a
readUnliftedArray (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
arr) (I# Int#
ix) =
  STRep s a -> ST s a
forall s a. STRep s a -> ST s a
ST (STRep s a -> ST s a) -> STRep s a -> ST s a
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableUnliftedArray# s (Unlifted a)
-> Int# -> State# s -> (# State# s, Unlifted a #)
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a -> Int# -> State# s -> (# State# s, a #)
readUnliftedArray# MutableUnliftedArray# s (Unlifted a)
arr Int#
ix State# s
s of
    (# State# s
s', Unlifted a
a #) -> (# State# s
s', Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# Unlifted a
a #)

indexUnliftedArray :: PrimUnlifted a
  => UnliftedArray a
  -> Int
  -> a
{-# inline indexUnliftedArray #-}
indexUnliftedArray :: UnliftedArray a -> Int -> a
indexUnliftedArray (UnliftedArray UnliftedArray# (Unlifted a)
arr) (I# Int#
ix) =
  Unlifted a -> a
forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# (UnliftedArray# (Unlifted a) -> Int# -> Unlifted a
forall (a :: TYPE 'UnliftedRep). UnliftedArray# a -> Int# -> a
indexUnliftedArray# UnliftedArray# (Unlifted a)
arr Int#
ix)

-- | Freezes a 'MutableUnliftedArray', yielding an 'UnliftedArray'. This simply
-- marks the array as frozen in place, so it should only be used when no further
-- modifications to the mutable array will be performed.
unsafeFreezeUnliftedArray
  :: MutableUnliftedArray s a
  -> ST s (UnliftedArray a)
unsafeFreezeUnliftedArray :: MutableUnliftedArray s a -> ST s (UnliftedArray a)
unsafeFreezeUnliftedArray (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
maa#)
  = STRep s (UnliftedArray a) -> ST s (UnliftedArray a)
forall s a. STRep s a -> ST s a
ST (STRep s (UnliftedArray a) -> ST s (UnliftedArray a))
-> STRep s (UnliftedArray a) -> ST s (UnliftedArray a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableUnliftedArray# s (Unlifted a)
-> State# s -> (# State# s, UnliftedArray# (Unlifted a) #)
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a
-> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# MutableUnliftedArray# s (Unlifted a)
maa# State# s
s of
      (# State# s
s', UnliftedArray# (Unlifted a)
aa# #) -> (# State# s
s', UnliftedArray# (Unlifted a) -> UnliftedArray a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray UnliftedArray# (Unlifted a)
aa# #)
{-# inline unsafeFreezeUnliftedArray #-}

-- | Determines whether two 'MutableUnliftedArray' values are the same. This is
-- object/pointer identity, not based on the contents.
sameMutableUnliftedArray
  :: MutableUnliftedArray s a
  -> MutableUnliftedArray s a
  -> Bool
sameMutableUnliftedArray :: MutableUnliftedArray s a -> MutableUnliftedArray s a -> Bool
sameMutableUnliftedArray (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
maa1#) (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
maa2#)
  = Int# -> Bool
Exts.isTrue# (MutableUnliftedArray# s (Unlifted a)
-> MutableUnliftedArray# s (Unlifted a) -> Int#
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a -> MutableUnliftedArray# s a -> Int#
sameMutableUnliftedArray# MutableUnliftedArray# s (Unlifted a)
maa1# MutableUnliftedArray# s (Unlifted a)
maa2#)
{-# inline sameMutableUnliftedArray #-}

-- | Copies the contents of an immutable array into a mutable array.
copyUnliftedArray
  :: MutableUnliftedArray s a -- ^ destination
  -> Int -- ^ offset into destination
  -> UnliftedArray a -- ^ source
  -> Int -- ^ offset into source
  -> Int -- ^ number of elements to copy
  -> ST s ()
{-# inline copyUnliftedArray #-}
copyUnliftedArray :: MutableUnliftedArray s a
-> Int -> UnliftedArray a -> Int -> Int -> ST s ()
copyUnliftedArray
  (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
dst) (I# Int#
doff)
  (UnliftedArray UnliftedArray# (Unlifted a)
src) (I# Int#
soff) (I# Int#
ln) =
    (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
primitive_ ((State# s -> State# s) -> ST s ())
-> (State# s -> State# s) -> ST s ()
forall a b. (a -> b) -> a -> b
$ UnliftedArray# (Unlifted a)
-> Int#
-> MutableUnliftedArray# s (Unlifted a)
-> Int#
-> Int#
-> State# s
-> State# s
forall (a :: TYPE 'UnliftedRep) s.
UnliftedArray# a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyUnliftedArray# UnliftedArray# (Unlifted a)
src Int#
soff MutableUnliftedArray# s (Unlifted a)
dst Int#
doff Int#
ln

-- | Copies the contents of one mutable array into another.
copyMutableUnliftedArray
  :: MutableUnliftedArray s a -- ^ destination
  -> Int -- ^ offset into destination
  -> MutableUnliftedArray s a -- ^ source
  -> Int -- ^ offset into source
  -> Int -- ^ number of elements to copy
  -> ST s ()
{-# inline copyMutableUnliftedArray #-}
copyMutableUnliftedArray :: MutableUnliftedArray s a
-> Int -> MutableUnliftedArray s a -> Int -> Int -> ST s ()
copyMutableUnliftedArray
  (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
dst) (I# Int#
doff)
  (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
src) (I# Int#
soff) (I# Int#
ln) =
    (State# s -> State# s) -> ST s ()
forall s. (State# s -> State# s) -> ST s ()
primitive_ ((State# s -> State# s) -> ST s ())
-> (State# s -> State# s) -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutableUnliftedArray# s (Unlifted a)
-> Int#
-> MutableUnliftedArray# s (Unlifted a)
-> Int#
-> Int#
-> State# s
-> State# s
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyMutableUnliftedArray# MutableUnliftedArray# s (Unlifted a)
src Int#
soff MutableUnliftedArray# s (Unlifted a)
dst Int#
doff Int#
ln

-- | Freezes a portion of a 'MutableUnliftedArray', yielding an 'UnliftedArray'.
-- This operation is safe, in that it copies the frozen portion, and the
-- existing mutable array may still be used afterward.
freezeUnliftedArray
  :: MutableUnliftedArray s a -- ^ source
  -> Int -- ^ offset
  -> Int -- ^ length
  -> ST s (UnliftedArray a)
freezeUnliftedArray :: MutableUnliftedArray s a -> Int -> Int -> ST s (UnliftedArray a)
freezeUnliftedArray (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
mary) (I# Int#
off) (I# Int#
len) =
    STRep s (UnliftedArray a) -> ST s (UnliftedArray a)
forall s a. STRep s a -> ST s a
ST (STRep s (UnliftedArray a) -> ST s (UnliftedArray a))
-> STRep s (UnliftedArray a) -> ST s (UnliftedArray a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableUnliftedArray# s (Unlifted a)
-> Int#
-> Int#
-> State# s
-> (# State# s, UnliftedArray# (Unlifted a) #)
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a
-> Int# -> Int# -> State# s -> (# State# s, UnliftedArray# a #)
freezeUnliftedArray# MutableUnliftedArray# s (Unlifted a)
mary Int#
off Int#
len State# s
s of
      (# State# s
s', UnliftedArray# (Unlifted a)
ary #) -> (# State# s
s', UnliftedArray# (Unlifted a) -> UnliftedArray a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray UnliftedArray# (Unlifted a)
ary #)
{-# inline freezeUnliftedArray #-}

-- | Thaws a portion of an 'UnliftedArray', yielding a 'MutableUnliftedArray'.
-- This copies the thawed portion, so mutations will not affect the original
-- array.
thawUnliftedArray
  :: UnliftedArray a -- ^ source
  -> Int -- ^ offset
  -> Int -- ^ length
  -> ST s (MutableUnliftedArray s a)
{-# inline thawUnliftedArray #-}
thawUnliftedArray :: UnliftedArray a -> Int -> Int -> ST s (MutableUnliftedArray s a)
thawUnliftedArray (UnliftedArray UnliftedArray# (Unlifted a)
ary) (I# Int#
off) (I# Int#
len) =
    STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall s a. STRep s a -> ST s a
ST (STRep s (MutableUnliftedArray s a)
 -> ST s (MutableUnliftedArray s a))
-> STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case UnliftedArray# (Unlifted a)
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s (Unlifted a) #)
forall (a :: TYPE 'UnliftedRep) s.
UnliftedArray# a
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s a #)
thawUnliftedArray# UnliftedArray# (Unlifted a)
ary Int#
off Int#
len State# s
s of
      (# State# s
s', MutableUnliftedArray# s (Unlifted a)
mary #) -> (# State# s
s', MutableUnliftedArray# s (Unlifted a) -> MutableUnliftedArray s a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s unlifted_a
-> MutableUnliftedArray_ s a unlifted_a
MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
mary #)

-- | Thaws an 'UnliftedArray', yielding a 'MutableUnliftedArray'. This
-- does not make a copy.
unsafeThawUnliftedArray
  :: UnliftedArray a -- ^ source
  -> ST s (MutableUnliftedArray s a)
{-# inline unsafeThawUnliftedArray #-}
unsafeThawUnliftedArray :: UnliftedArray a -> ST s (MutableUnliftedArray s a)
unsafeThawUnliftedArray (UnliftedArray UnliftedArray# (Unlifted a)
ary) =
    STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall s a. STRep s a -> ST s a
ST (STRep s (MutableUnliftedArray s a)
 -> ST s (MutableUnliftedArray s a))
-> STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case UnliftedArray# (Unlifted a)
-> State# s -> (# State# s, MutableUnliftedArray# s (Unlifted a) #)
forall (a :: TYPE 'UnliftedRep) s.
UnliftedArray# a
-> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeThawUnliftedArray# UnliftedArray# (Unlifted a)
ary State# s
s of
      (# State# s
s', MutableUnliftedArray# s (Unlifted a)
mary #) -> (# State# s
s', MutableUnliftedArray# s (Unlifted a) -> MutableUnliftedArray s a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s unlifted_a
-> MutableUnliftedArray_ s a unlifted_a
MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
mary #)

-- | Execute a stateful computation and freeze the resulting array.
runUnliftedArray
  :: (forall s. ST s (MutableUnliftedArray s a))
  -> UnliftedArray a
{-# INLINE runUnliftedArray #-}
-- This is what we'd like to write, but GHC does not yet
-- produce properly unboxed code when we do
-- runUnliftedArray m = runST $ noDuplicate >> m >>= unsafeFreezeUnliftedArray
runUnliftedArray :: (forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
runUnliftedArray forall s. ST s (MutableUnliftedArray s a)
m = UnliftedArray# (Unlifted a) -> UnliftedArray a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray ((forall s. ST s (MutableUnliftedArray s a))
-> UnliftedArray# (Unlifted a)
forall a.
(forall s. ST s (MutableUnliftedArray s a))
-> UnliftedArray# (Unlifted a)
runUnliftedArray# forall s. ST s (MutableUnliftedArray s a)
m)

runUnliftedArray#
  :: (forall s. ST s (MutableUnliftedArray s a))
  -> UnliftedArray# (Unlifted a)
runUnliftedArray# :: (forall s. ST s (MutableUnliftedArray s a))
-> UnliftedArray# (Unlifted a)
runUnliftedArray# forall s. ST s (MutableUnliftedArray s a)
m = case (State# RealWorld
 -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
-> (# State# RealWorld, UnliftedArray# (Unlifted a) #)
forall o. (State# RealWorld -> o) -> o
Exts.runRW# ((State# RealWorld
  -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
 -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
-> (State# RealWorld
    -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
-> (# State# RealWorld, UnliftedArray# (Unlifted a) #)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
  case State# RealWorld -> State# RealWorld
forall d. State# d -> State# d
Exts.noDuplicate# State# RealWorld
s0 of { State# RealWorld
s ->
  case ST RealWorld (MutableUnliftedArray_ RealWorld a (Unlifted a))
-> State# RealWorld
-> (# State# RealWorld,
      MutableUnliftedArray_ RealWorld a (Unlifted a) #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST ST RealWorld (MutableUnliftedArray_ RealWorld a (Unlifted a))
forall s. ST s (MutableUnliftedArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', MutableUnliftedArray MutableUnliftedArray# RealWorld (Unlifted a)
mary# #) ->
  MutableUnliftedArray# RealWorld (Unlifted a)
-> State# RealWorld
-> (# State# RealWorld, UnliftedArray# (Unlifted a) #)
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a
-> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# MutableUnliftedArray# RealWorld (Unlifted a)
mary# State# RealWorld
s'}} of (# State# RealWorld
_, UnliftedArray# (Unlifted a)
ary# #) -> UnliftedArray# (Unlifted a)
ary#
{-# INLINE runUnliftedArray# #-}

-- | Execute a stateful computation and freeze the resulting array.
-- It is possible, but unlikely, that the computation will be run
-- multiple times in multiple threads.
dupableRunUnliftedArray
  :: (forall s. ST s (MutableUnliftedArray s a))
  -> UnliftedArray a
{-# INLINE dupableRunUnliftedArray #-}
-- This is what we'd like to write, but GHC does not yet
-- produce properly unboxed code when we do
-- runUnliftedArray m = runST $ m >>= unsafeFreezeUnliftedArray
dupableRunUnliftedArray :: (forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
dupableRunUnliftedArray forall s. ST s (MutableUnliftedArray s a)
m = UnliftedArray# (Unlifted a) -> UnliftedArray a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray ((forall s. ST s (MutableUnliftedArray s a))
-> UnliftedArray# (Unlifted a)
forall a.
(forall s. ST s (MutableUnliftedArray s a))
-> UnliftedArray# (Unlifted a)
dupableRunUnliftedArray# forall s. ST s (MutableUnliftedArray s a)
m)

dupableRunUnliftedArray#
  :: (forall s. ST s (MutableUnliftedArray s a))
  -> UnliftedArray# (Unlifted a)
dupableRunUnliftedArray# :: (forall s. ST s (MutableUnliftedArray s a))
-> UnliftedArray# (Unlifted a)
dupableRunUnliftedArray# forall s. ST s (MutableUnliftedArray s a)
m = case (State# RealWorld
 -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
-> (# State# RealWorld, UnliftedArray# (Unlifted a) #)
forall o. (State# RealWorld -> o) -> o
Exts.runRW# ((State# RealWorld
  -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
 -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
-> (State# RealWorld
    -> (# State# RealWorld, UnliftedArray# (Unlifted a) #))
-> (# State# RealWorld, UnliftedArray# (Unlifted a) #)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case ST RealWorld (MutableUnliftedArray_ RealWorld a (Unlifted a))
-> State# RealWorld
-> (# State# RealWorld,
      MutableUnliftedArray_ RealWorld a (Unlifted a) #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST ST RealWorld (MutableUnliftedArray_ RealWorld a (Unlifted a))
forall s. ST s (MutableUnliftedArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', MutableUnliftedArray MutableUnliftedArray# RealWorld (Unlifted a)
mary# #) ->
  MutableUnliftedArray# RealWorld (Unlifted a)
-> State# RealWorld
-> (# State# RealWorld, UnliftedArray# (Unlifted a) #)
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a
-> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# MutableUnliftedArray# RealWorld (Unlifted a)
mary# State# RealWorld
s'} of (# State# RealWorld
_, UnliftedArray# (Unlifted a)
ary# #) -> UnliftedArray# (Unlifted a)
ary#
{-# INLINE dupableRunUnliftedArray# #-}

unST :: ST s a -> State# s -> (# State# s, a #)
unST :: ST s a -> State# s -> (# State# s, a #)
unST (ST State# s -> (# State# s, a #)
f) = State# s -> (# State# s, a #)
f

unsafeCreateUnliftedArray
  :: Int
  -> (forall s. MutableUnliftedArray s a -> ST s ())
  -> UnliftedArray a
unsafeCreateUnliftedArray :: Int
-> (forall s. MutableUnliftedArray s a -> ST s ())
-> UnliftedArray a
unsafeCreateUnliftedArray !Int
n forall s. MutableUnliftedArray s a -> ST s ()
f = (forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
forall a.
(forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
runUnliftedArray ((forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a)
-> (forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
forall a b. (a -> b) -> a -> b
$ do
  MutableUnliftedArray s a
mary <- Int -> ST s (MutableUnliftedArray s a)
forall s a. Int -> ST s (MutableUnliftedArray s a)
unsafeNewUnliftedArray Int
n
  MutableUnliftedArray s a -> ST s ()
forall s. MutableUnliftedArray s a -> ST s ()
f MutableUnliftedArray s a
mary
  MutableUnliftedArray s a -> ST s (MutableUnliftedArray s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableUnliftedArray s a
mary

-- | Creates a new 'MutableUnliftedArray'. This function is unsafe because it
-- initializes all elements of the array as pointers to the empty array. Attempting
-- to read one of these elements before writing to it is in effect an unsafe
-- coercion from @'UnliftedArray' a@ to the element type.
unsafeNewUnliftedArray
  :: Int -- ^ size
  -> ST s (MutableUnliftedArray s a)
{-# inline unsafeNewUnliftedArray #-}
unsafeNewUnliftedArray :: Int -> ST s (MutableUnliftedArray s a)
unsafeNewUnliftedArray (I# Int#
i) = STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall s a. STRep s a -> ST s a
ST (STRep s (MutableUnliftedArray s a)
 -> ST s (MutableUnliftedArray s a))
-> STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case Int#
-> State# s -> (# State# s, MutableUnliftedArray# s (Unlifted a) #)
forall s (a :: TYPE 'UnliftedRep).
Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeNewUnliftedArray# Int#
i State# s
s of
  (# State# s
s', MutableUnliftedArray# s (Unlifted a)
ma #) -> (# State# s
s', MutableUnliftedArray# s (Unlifted a) -> MutableUnliftedArray s a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s unlifted_a
-> MutableUnliftedArray_ s a unlifted_a
MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
ma #)


-- | Creates a copy of a portion of an 'UnliftedArray'
cloneUnliftedArray
  :: UnliftedArray a -- ^ source
  -> Int -- ^ offset
  -> Int -- ^ length
  -> UnliftedArray a
{-# inline cloneUnliftedArray #-}
cloneUnliftedArray :: UnliftedArray a -> Int -> Int -> UnliftedArray a
cloneUnliftedArray (UnliftedArray UnliftedArray# (Unlifted a)
ary) (I# Int#
off) (I# Int#
len)
  = UnliftedArray# (Unlifted a) -> UnliftedArray a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray (UnliftedArray# (Unlifted a)
-> Int# -> Int# -> UnliftedArray# (Unlifted a)
forall (a :: TYPE 'UnliftedRep).
UnliftedArray# a -> Int# -> Int# -> UnliftedArray# a
cloneUnliftedArray# UnliftedArray# (Unlifted a)
ary Int#
off Int#
len)

-- | Creates a new 'MutableUnliftedArray' containing a copy of a portion of
-- another mutable array.
cloneMutableUnliftedArray
  :: MutableUnliftedArray s a -- ^ source
  -> Int -- ^ offset
  -> Int -- ^ length
  -> ST s (MutableUnliftedArray s a)
{-# inline cloneMutableUnliftedArray #-}
cloneMutableUnliftedArray :: MutableUnliftedArray s a
-> Int -> Int -> ST s (MutableUnliftedArray s a)
cloneMutableUnliftedArray (MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
mary) (I# Int#
off) (I# Int#
len)
  = STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall s a. STRep s a -> ST s a
ST (STRep s (MutableUnliftedArray s a)
 -> ST s (MutableUnliftedArray s a))
-> STRep s (MutableUnliftedArray s a)
-> ST s (MutableUnliftedArray s a)
forall a b. (a -> b) -> a -> b
$ \State# s
s -> case MutableUnliftedArray# s (Unlifted a)
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s (Unlifted a) #)
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> (# State# s, MutableUnliftedArray# s a #)
cloneMutableUnliftedArray# MutableUnliftedArray# s (Unlifted a)
mary Int#
off Int#
len State# s
s of
      (# State# s
s', MutableUnliftedArray# s (Unlifted a)
mary' #) -> (# State# s
s', MutableUnliftedArray# s (Unlifted a) -> MutableUnliftedArray s a
forall s a (unlifted_a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s unlifted_a
-> MutableUnliftedArray_ s a unlifted_a
MutableUnliftedArray MutableUnliftedArray# s (Unlifted a)
mary' #)

emptyUnliftedArray :: UnliftedArray a
emptyUnliftedArray :: UnliftedArray a
emptyUnliftedArray = UnliftedArray# (Unlifted a) -> UnliftedArray a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray ((# #) -> UnliftedArray# (Unlifted a)
forall (a :: TYPE 'UnliftedRep). (# #) -> UnliftedArray# a
emptyUnliftedArray# (##))

singletonUnliftedArray :: PrimUnlifted a => a -> UnliftedArray a
{-# INLINE singletonUnliftedArray #-}
singletonUnliftedArray :: a -> UnliftedArray a
singletonUnliftedArray a
x = (forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
forall a.
(forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
dupableRunUnliftedArray ((forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a)
-> (forall s. ST s (MutableUnliftedArray s a)) -> UnliftedArray a
forall a b. (a -> b) -> a -> b
$ Int -> a -> ST s (MutableUnliftedArray s a)
forall a s.
PrimUnlifted a =>
Int -> a -> ST s (MutableUnliftedArray s a)
newUnliftedArray Int
1 a
x

concatUnliftedArray :: UnliftedArray a -> UnliftedArray a -> UnliftedArray a
{-# INLINE concatUnliftedArray #-}
concatUnliftedArray :: UnliftedArray a -> UnliftedArray a -> UnliftedArray a
concatUnliftedArray (UnliftedArray UnliftedArray# (Unlifted a)
a1) (UnliftedArray UnliftedArray# (Unlifted a)
a2)
  = UnliftedArray# (Unlifted a) -> UnliftedArray a
forall a (unlifted_a :: TYPE 'UnliftedRep).
UnliftedArray# unlifted_a -> UnliftedArray_ a unlifted_a
UnliftedArray (UnliftedArray# (Unlifted a)
-> UnliftedArray# (Unlifted a) -> UnliftedArray# (Unlifted a)
forall (a :: TYPE 'UnliftedRep).
UnliftedArray# a -> UnliftedArray# a -> UnliftedArray# a
concatUnliftedArray# UnliftedArray# (Unlifted a)
a1 UnliftedArray# (Unlifted a)
a2)

-- This junk is to make sure we unbox properly. Inlining this doesn't seem
-- likely to be much of a win ever, and could potentially lead to reboxing,
-- so we NOINLINE. It would be nice to find a prettier way to do this.
concatUnliftedArray# :: UnliftedArray# a -> UnliftedArray# a -> UnliftedArray# a
{-# NOINLINE concatUnliftedArray# #-}
concatUnliftedArray# :: UnliftedArray# a -> UnliftedArray# a -> UnliftedArray# a
concatUnliftedArray# UnliftedArray# a
a1 UnliftedArray# a
a2 =
  let !sza1 :: Int#
sza1 = UnliftedArray# a -> Int#
forall (a :: TYPE 'UnliftedRep). UnliftedArray# a -> Int#
sizeofUnliftedArray# UnliftedArray# a
a1
  in
    if Int# -> Bool
Exts.isTrue# (Int#
sza1 Int# -> Int# -> Int#
Exts.==# Int#
0#)
    then UnliftedArray# a
a2
    else
      let !sza2 :: Int#
sza2 = UnliftedArray# a -> Int#
forall (a :: TYPE 'UnliftedRep). UnliftedArray# a -> Int#
sizeofUnliftedArray# UnliftedArray# a
a2
      in
        if Int# -> Bool
Exts.isTrue# (Int#
sza2 Int# -> Int# -> Int#
Exts.==# Int#
0#)
        then UnliftedArray# a
a1
        else (State# RealWorld -> UnliftedArray# a) -> UnliftedArray# a
forall o. (State# RealWorld -> o) -> o
Exts.runRW# ((State# RealWorld -> UnliftedArray# a) -> UnliftedArray# a)
-> (State# RealWorld -> UnliftedArray# a) -> UnliftedArray# a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s0 ->
          let
            finish :: State# RealWorld -> UnliftedArray# a
finish State# RealWorld
s =
              case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableUnliftedArray# RealWorld a #)
forall s (a :: TYPE 'UnliftedRep).
Int# -> State# s -> (# State# s, MutableUnliftedArray# s a #)
unsafeNewUnliftedArray# (Int#
sza1 Int# -> Int# -> Int#
Exts.+# Int#
sza2) State# RealWorld
s of { (# State# RealWorld
s', MutableUnliftedArray# RealWorld a
ma #) ->
              case UnliftedArray# a
-> Int#
-> MutableUnliftedArray# RealWorld a
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall (a :: TYPE 'UnliftedRep) s.
UnliftedArray# a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyUnliftedArray# UnliftedArray# a
a1 Int#
0# MutableUnliftedArray# RealWorld a
ma Int#
0# Int#
sza1 State# RealWorld
s' of { State# RealWorld
s'' ->
              case UnliftedArray# a
-> Int#
-> MutableUnliftedArray# RealWorld a
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall (a :: TYPE 'UnliftedRep) s.
UnliftedArray# a
-> Int#
-> MutableUnliftedArray# s a
-> Int#
-> Int#
-> State# s
-> State# s
copyUnliftedArray# UnliftedArray# a
a2 Int#
0# MutableUnliftedArray# RealWorld a
ma Int#
sza1 Int#
sza2 State# RealWorld
s'' of { State# RealWorld
s''' ->
              case MutableUnliftedArray# RealWorld a
-> State# RealWorld -> (# State# RealWorld, UnliftedArray# a #)
forall s (a :: TYPE 'UnliftedRep).
MutableUnliftedArray# s a
-> State# s -> (# State# s, UnliftedArray# a #)
unsafeFreezeUnliftedArray# MutableUnliftedArray# RealWorld a
ma State# RealWorld
s''' of
                (# State# RealWorld
_, UnliftedArray# a
ar #) -> UnliftedArray# a
ar}}}
            -- GHC wants to inline this, but I very much doubt it's worth the
            -- extra code, considering that it calls multiple out-of-line
            -- primops.
            {-# NOINLINE finish #-}
          in
            -- When the final array will be "small", we tolerate the possibility that
            -- it could be constructed multiple times in different threads. Currently,
            -- "small" means fewer than 1000 elements. This is a totally arbitrary
            -- cutoff that has not been tuned whatsoever.
            if Int# -> Bool
Exts.isTrue# ((Int#
sza1 Int# -> Int# -> Int#
Exts.+# Int#
sza2) Int# -> Int# -> Int#
Exts.>=# Int#
1000#)
            then State# RealWorld -> UnliftedArray# a
finish (State# RealWorld -> State# RealWorld
forall d. State# d -> State# d
Exts.noDuplicate# State# RealWorld
s0)
            else State# RealWorld -> UnliftedArray# a
finish State# RealWorld
s0

foldrUnliftedArray :: forall a b. PrimUnlifted a => (a -> b -> b) -> b -> UnliftedArray a -> b
{-# INLINE foldrUnliftedArray #-}
foldrUnliftedArray :: (a -> b -> b) -> b -> UnliftedArray a -> b
foldrUnliftedArray a -> b -> b
f b
z UnliftedArray a
arr = Int -> b
go Int
0
  where
    !sz :: Int
sz = UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr
    go :: Int -> b
go !Int
i
      | Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = a -> b -> b
f (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
i) (Int -> b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
      | Bool
otherwise = b
z

-- | Strict right-associated fold over the elements of an 'UnliftedArray.
{-# INLINE foldrUnliftedArray' #-}
foldrUnliftedArray' :: forall a b. PrimUnlifted a => (a -> b -> b) -> b -> UnliftedArray a -> b
foldrUnliftedArray' :: (a -> b -> b) -> b -> UnliftedArray a -> b
foldrUnliftedArray' a -> b -> b
f b
z0 UnliftedArray a
arr = Int -> b -> b
go (UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b
z0
  where
    go :: Int -> b -> b
go !Int
i !b
acc
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = b
acc
      | Bool
otherwise = Int -> b -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (a -> b -> b
f (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
i) b
acc)

-- | Lazy left-associated fold over the elements of an 'UnliftedArray'.
{-# INLINE foldlUnliftedArray #-}
foldlUnliftedArray :: forall a b. PrimUnlifted a => (b -> a -> b) -> b -> UnliftedArray a -> b
foldlUnliftedArray :: (b -> a -> b) -> b -> UnliftedArray a -> b
foldlUnliftedArray b -> a -> b
f b
z UnliftedArray a
arr = Int -> b
go (UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    go :: Int -> b
go !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = b
z
      | Bool
otherwise = b -> a -> b
f (Int -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
i)

-- | Strict left-associated fold over the elements of an 'UnliftedArray'.
{-# INLINE foldlUnliftedArray' #-}
foldlUnliftedArray' :: forall a b. PrimUnlifted a => (b -> a -> b) -> b -> UnliftedArray a -> b
foldlUnliftedArray' :: (b -> a -> b) -> b -> UnliftedArray a -> b
foldlUnliftedArray' b -> a -> b
f b
z0 UnliftedArray a
arr = Int -> b -> b
go Int
0 b
z0
  where
    !sz :: Int
sz = UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr
    go :: Int -> b -> b
go !Int
i !b
acc
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = Int -> b -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (b -> a -> b
f b
acc (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
i))
      | Bool
otherwise = b
acc

-- | Strict effectful left-associated fold over the elements of an 'UnliftedArray'.
{-# INLINE foldlUnliftedArrayM' #-}
foldlUnliftedArrayM' :: (PrimUnlifted a, Monad m)
  => (b -> a -> m b) -> b -> UnliftedArray a -> m b
foldlUnliftedArrayM' :: (b -> a -> m b) -> b -> UnliftedArray a -> m b
foldlUnliftedArrayM' b -> a -> m b
f b
z0 UnliftedArray a
arr = Int -> b -> m b
go Int
0 b
z0
  where
    !sz :: Int
sz = UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr
    go :: Int -> b -> m b
go !Int
i !b
acc
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = b -> a -> m b
f b
acc (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
i) m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> b -> m b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) 
      | Bool
otherwise = b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
acc

-- | Effectfully traverse the elements of an 'UnliftedArray', discarding
-- the resulting values.
{-# INLINE traverseUnliftedArray_ #-}
traverseUnliftedArray_ :: (PrimUnlifted a, Applicative m)
  => (a -> m b) -> UnliftedArray a -> m ()
traverseUnliftedArray_ :: (a -> m b) -> UnliftedArray a -> m ()
traverseUnliftedArray_ a -> m b
f UnliftedArray a
arr = Int -> m ()
go Int
0
  where
    !sz :: Int
sz = UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr
    go :: Int -> m ()
go !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = a -> m b
f (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
i) m b -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) 
      | Bool
otherwise = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Effectful indexed traversal of the elements of an 'UnliftedArray',
-- discarding the resulting values.
{-# INLINE itraverseUnliftedArray_ #-}
itraverseUnliftedArray_ :: (PrimUnlifted a, Applicative m)
  => (Int -> a -> m b) -> UnliftedArray a -> m ()
itraverseUnliftedArray_ :: (Int -> a -> m b) -> UnliftedArray a -> m ()
itraverseUnliftedArray_ Int -> a -> m b
f UnliftedArray a
arr = Int -> m ()
go Int
0
  where
    !sz :: Int
sz = UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr
    go :: Int -> m ()
go !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = Int -> a -> m b
f Int
i (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
i) m b -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) 
      | Bool
otherwise = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Map over the elements of an 'UnliftedArray'.
{-# INLINE mapUnliftedArray #-}
mapUnliftedArray :: (PrimUnlifted a, PrimUnlifted b)
  => (a -> b)
  -> UnliftedArray a
  -> UnliftedArray b
-- TODO: Do we need unsafeCreateUnliftedArray here, or would it be better
-- to use a hypothetical unsafeDupableCreateUnliftedArray? I don't have
-- much intuition for this. On one hand, if the operation creates a
-- bunch of expensive objects to stick in the array, then we really don't want
-- to duplicate that work. On the other hand, it's likely that creating
-- a bunch of expensive objects will also allocate a bunch of memory, which
-- will likely trigger garbage collection that (as I understand it) will
-- notice that one thunk is being evaluated twice and deduplicate. On the
-- other other hand, I don't think there's any guarantee that the thread that wins will be
-- the one that's further along, so maybe the noDuplicate is for the best.
mapUnliftedArray :: (a -> b) -> UnliftedArray a -> UnliftedArray b
mapUnliftedArray a -> b
f UnliftedArray a
arr = Int
-> (forall s. MutableUnliftedArray s b -> ST s ())
-> UnliftedArray b
forall a.
Int
-> (forall s. MutableUnliftedArray s a -> ST s ())
-> UnliftedArray a
unsafeCreateUnliftedArray Int
sz ((forall s. MutableUnliftedArray s b -> ST s ())
 -> UnliftedArray b)
-> (forall s. MutableUnliftedArray s b -> ST s ())
-> UnliftedArray b
forall a b. (a -> b) -> a -> b
$ \MutableUnliftedArray s b
marr -> do
  let go :: Int -> ST s ()
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz
        then do
          let b :: b
b = a -> b
f (UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
arr Int
ix)
          MutableUnliftedArray s b -> Int -> b -> ST s ()
forall a s.
PrimUnlifted a =>
MutableUnliftedArray s a -> Int -> a -> ST s ()
writeUnliftedArray MutableUnliftedArray s b
marr Int
ix b
b
          Int -> ST s ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Int -> ST s ()
go Int
0
  where
  !sz :: Int
sz = UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
arr

-- | Convert the unlifted array to a list.
{-# INLINE unliftedArrayToList #-}
unliftedArrayToList :: PrimUnlifted a => UnliftedArray a -> [a]
unliftedArrayToList :: UnliftedArray a -> [a]
unliftedArrayToList UnliftedArray a
xs = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
Exts.build (\a -> b -> b
c b
n -> (a -> b -> b) -> b -> UnliftedArray a -> b
forall a b.
PrimUnlifted a =>
(a -> b -> b) -> b -> UnliftedArray a -> b
foldrUnliftedArray a -> b -> b
c b
n UnliftedArray a
xs)

unliftedArrayFromList :: PrimUnlifted a => [a] -> UnliftedArray a
unliftedArrayFromList :: [a] -> UnliftedArray a
unliftedArrayFromList [a]
xs = Int -> [a] -> UnliftedArray a
forall a. PrimUnlifted a => Int -> [a] -> UnliftedArray a
unliftedArrayFromListN ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [a]
xs) [a]
xs

unliftedArrayFromListN :: forall a. PrimUnlifted a => Int -> [a] -> UnliftedArray a
unliftedArrayFromListN :: Int -> [a] -> UnliftedArray a
unliftedArrayFromListN Int
len [a]
vs = Int
-> (forall s. MutableUnliftedArray s a -> ST s ())
-> UnliftedArray a
forall a.
Int
-> (forall s. MutableUnliftedArray s a -> ST s ())
-> UnliftedArray a
unsafeCreateUnliftedArray Int
len forall s. MutableUnliftedArray s a -> ST s ()
run where
  run :: forall s. MutableUnliftedArray s a -> ST s ()
  run :: MutableUnliftedArray s a -> ST s ()
run MutableUnliftedArray s a
arr = do
    let go :: [a] -> Int -> ST s ()
        go :: [a] -> Int -> ST s ()
go [] !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
          -- The size check is mandatory since failure to initialize all elements
          -- introduces the possibility of a segfault happening when someone attempts
          -- to read the unitialized element. See the docs for unsafeNewUnliftedArray.
          then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> String -> ST s ()
forall a. String -> String -> a
die String
"unliftedArrayFromListN" String
"list length less than specified size"
        go (a
a : [a]
as) !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
          then do
            MutableUnliftedArray s a -> Int -> a -> ST s ()
forall a s.
PrimUnlifted a =>
MutableUnliftedArray s a -> Int -> a -> ST s ()
writeUnliftedArray MutableUnliftedArray s a
arr Int
ix a
a
            [a] -> Int -> ST s ()
go [a]
as (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          else String -> String -> ST s ()
forall a. String -> String -> a
die String
"unliftedArrayFromListN" String
"list length greater than specified size"
    [a] -> Int -> ST s ()
go [a]
vs Int
0

instance (PrimUnlifted a, unlifted_a ~ Unlifted a)
  => Exts.IsList (UnliftedArray_ a unlifted_a) where
  type Item (UnliftedArray_ a _) = a
  fromList :: [Item (UnliftedArray_ a unlifted_a)] -> UnliftedArray_ a unlifted_a
fromList = [Item (UnliftedArray_ a unlifted_a)] -> UnliftedArray_ a unlifted_a
forall a. PrimUnlifted a => [a] -> UnliftedArray a
unliftedArrayFromList
  fromListN :: Int
-> [Item (UnliftedArray_ a unlifted_a)]
-> UnliftedArray_ a unlifted_a
fromListN = Int
-> [Item (UnliftedArray_ a unlifted_a)]
-> UnliftedArray_ a unlifted_a
forall a. PrimUnlifted a => Int -> [a] -> UnliftedArray a
unliftedArrayFromListN
  toList :: UnliftedArray_ a unlifted_a -> [Item (UnliftedArray_ a unlifted_a)]
toList = UnliftedArray_ a unlifted_a -> [Item (UnliftedArray_ a unlifted_a)]
forall a. PrimUnlifted a => UnliftedArray a -> [a]
unliftedArrayToList

instance (PrimUnlifted a, unlifted_a ~ Unlifted a)
  => Semigroup (UnliftedArray_ a unlifted_a) where
  <> :: UnliftedArray_ a unlifted_a
-> UnliftedArray_ a unlifted_a -> UnliftedArray_ a unlifted_a
(<>) = UnliftedArray_ a unlifted_a
-> UnliftedArray_ a unlifted_a -> UnliftedArray_ a unlifted_a
forall a. UnliftedArray a -> UnliftedArray a -> UnliftedArray a
concatUnliftedArray

instance (PrimUnlifted a, unlifted_a ~ Unlifted a) => Monoid (UnliftedArray_ a unlifted_a) where
  mempty :: UnliftedArray_ a unlifted_a
mempty = UnliftedArray_ a unlifted_a
forall a. UnliftedArray a
emptyUnliftedArray

instance (Show a, PrimUnlifted a, unlifted_a ~ Unlifted a) => Show (UnliftedArray_ a unlifted_a) where
  showsPrec :: Int -> UnliftedArray_ a unlifted_a -> ShowS
showsPrec Int
p UnliftedArray_ a unlifted_a
a = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromListN " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray_ a unlifted_a
UnliftedArray a
a) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (UnliftedArray a -> [a]
forall a. PrimUnlifted a => UnliftedArray a -> [a]
unliftedArrayToList UnliftedArray_ a unlifted_a
UnliftedArray a
a)

instance unlifted_a ~ Unlifted a => Eq (MutableUnliftedArray_ s a unlifted_a) where
  == :: MutableUnliftedArray_ s a unlifted_a
-> MutableUnliftedArray_ s a unlifted_a -> Bool
(==) = MutableUnliftedArray_ s a unlifted_a
-> MutableUnliftedArray_ s a unlifted_a -> Bool
forall s a.
MutableUnliftedArray s a -> MutableUnliftedArray s a -> Bool
sameMutableUnliftedArray

instance (Eq a, PrimUnlifted a, unlifted_a ~ Unlifted a) => Eq (UnliftedArray_ a unlifted_a) where
  UnliftedArray_ a unlifted_a
aa1 == :: UnliftedArray_ a unlifted_a -> UnliftedArray_ a unlifted_a -> Bool
== UnliftedArray_ a unlifted_a
aa2 = UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray_ a unlifted_a
UnliftedArray a
aa1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray_ a unlifted_a
UnliftedArray a
aa2
            Bool -> Bool -> Bool
&& Int -> Bool
loop (UnliftedArray a -> Int
forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray_ a unlifted_a
UnliftedArray a
aa1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
   where
   loop :: Int -> Bool
loop Int
i
     | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
True
     | Bool
otherwise = UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray_ a unlifted_a
UnliftedArray a
aa1 Int
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== UnliftedArray a -> Int -> a
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray_ a unlifted_a
UnliftedArray a
aa2 Int
i Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

die :: String -> String -> a
die :: String -> String -> a
die String
fun String
problem = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.Primitive.UnliftedArray.ST." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fun String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
problem