{-# LANGUAGE CPP, MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

-- |
-- Module      : Data.Primitive.Array
-- Copyright   : (c) Roman Leshchinskiy 2009-2012
-- License     : BSD-style
--
-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
-- Portability : non-portable
--
-- Primitive arrays of boxed values.

module Data.Primitive.Array (
  Array(..), MutableArray(..),

  newArray, readArray, writeArray, indexArray, indexArrayM, indexArray##,
  freezeArray, thawArray, runArray, createArray,
  unsafeFreezeArray, unsafeThawArray, sameMutableArray,
  copyArray, copyMutableArray,
  cloneArray, cloneMutableArray,
  sizeofArray, sizeofMutableArray,
  emptyArray,
  arrayFromListN, arrayFromList,
  mapArray',
  traverseArrayP
) where

import Control.DeepSeq
import Control.Monad.Primitive
import Data.Primitive.Internal.Read (Tag(..),lexTag)

import GHC.Exts hiding (toList)
import qualified GHC.Exts as Exts

import Data.Typeable ( Typeable )
import Data.Data
  (Data(..), DataType, mkDataType, mkNoRepType, Constr, mkConstr, Fixity(..), constrIndex)

import Control.Monad.ST (ST, runST)

import Control.Applicative
import Control.Monad (MonadPlus(..), when, liftM2)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import qualified Data.Foldable as Foldable
import Control.Monad.Zip
import Data.Foldable (Foldable(..), toList)
import qualified GHC.ST as GHCST
import qualified Data.Foldable as F
import Data.Semigroup
import Data.Functor.Identity
#if !MIN_VERSION_base(4,10,0)
import GHC.Base (runRW#)
#endif

import Text.Read (Read (..), parens, prec)
import Text.ParserCombinators.ReadPrec (ReadPrec)
import qualified Text.ParserCombinators.ReadPrec as RdPrc
import Text.ParserCombinators.ReadP

import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), Read1(..))
import Language.Haskell.TH.Syntax (Lift (..))

-- | Boxed arrays.
data Array a = Array
  { forall a. Array a -> Array# a
array# :: Array# a }
  deriving ( Typeable )

instance Lift a => Lift (Array a) where
#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => Array a -> Code m (Array a)
liftTyped Array a
ary = case [a]
lst of
    [] -> [|| Array (emptyArray# (##)) ||]
    [a
x] -> [|| pure $! x ||]
    a
x : [a]
xs -> [|| unsafeArrayFromListN' len x xs ||]
#else
  lift ary = case lst of
    [] -> [| Array (emptyArray# (##)) |]
    [x] -> [| pure $! x |]
    x : xs -> [| unsafeArrayFromListN' len x xs |]
#endif
    where
      len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length Array a
ary
      lst :: [a]
lst = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
ary

-- | Strictly create an array from a nonempty list (represented as
-- a first element and a list of the rest) of a known length. If the length
-- of the list does not match the given length, this makes demons fly
-- out of your nose. We use it in the 'Lift' instance. If you edit the
-- splice and break it, you get to keep both pieces.
unsafeArrayFromListN' :: Int -> a -> [a] -> Array a
unsafeArrayFromListN' :: forall a. Int -> a -> [a] -> Array a
unsafeArrayFromListN' Int
n a
y [a]
ys =
  forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
n a
y forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
    let go :: Int -> [a] -> ST s ()
go !Int
_ix [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go !Int
ix (!a
x : [a]
xs) = do
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
ma Int
ix a
x
            Int -> [a] -> ST s ()
go (Int
ixforall a. Num a => a -> a -> a
+Int
1) [a]
xs
    in Int -> [a] -> ST s ()
go Int
1 [a]
ys

#if MIN_VERSION_deepseq(1,4,3)
instance NFData1 Array where
  liftRnf :: forall a. (a -> ()) -> Array a -> ()
liftRnf a -> ()
r = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\()
_ -> a -> ()
r) ()
#endif

instance NFData a => NFData (Array a) where
  rnf :: Array a -> ()
rnf = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\()
_ -> forall a. NFData a => a -> ()
rnf) ()

-- | Mutable boxed arrays associated with a primitive state token.
data MutableArray s a = MutableArray
  { forall s a. MutableArray s a -> MutableArray# s a
marray# :: MutableArray# s a }
  deriving ( Typeable )

-- | The number of elements in an immutable array.
sizeofArray :: Array a -> Int
sizeofArray :: forall a. Array a -> Int
sizeofArray Array a
a = Int# -> Int
I# (forall a. Array# a -> Int#
sizeofArray# (forall a. Array a -> Array# a
array# Array a
a))
{-# INLINE sizeofArray #-}

-- | The number of elements in a mutable array.
sizeofMutableArray :: MutableArray s a -> Int
sizeofMutableArray :: forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray s a
a = Int# -> Int
I# (forall d a. MutableArray# d a -> Int#
sizeofMutableArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
a))
{-# INLINE sizeofMutableArray #-}

-- | Create a new mutable array of the specified size and initialise all
-- elements with the given value.
--
-- /Note:/ this function does not check if the input is non-negative.
newArray :: PrimMonad m => Int -> a -> m (MutableArray (PrimState m) a)
{-# INLINE newArray #-}
newArray :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (I# Int#
n#) a
x = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
   (\State# (PrimState m)
s# -> case forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
n# a
x State# (PrimState m)
s# of
             (# State# (PrimState m)
s'#, MutableArray# (PrimState m) a
arr# #) ->
               let ma :: MutableArray (PrimState m) a
ma = forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr#
               in (# State# (PrimState m)
s'# , MutableArray (PrimState m) a
ma #))

-- | Read a value from the array at the given index.
--
-- /Note:/ this function does not do bounds checking.
readArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m a
{-# INLINE readArray #-}
readArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray (PrimState m) a
arr (I# Int#
i#) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray (PrimState m) a
arr) Int#
i#)

-- | Write a value to the array at the given index.
--
-- /Note:/ this function does not do bounds checking.
writeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> a -> m ()
{-# INLINE writeArray #-}
writeArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray (PrimState m) a
arr (I# Int#
i#) a
x = forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray (PrimState m) a
arr) Int#
i# a
x)

-- | Read a value from the immutable array at the given index.
--
-- /Note:/ this function does not do bounds checking.
indexArray :: Array a -> Int -> a
{-# INLINE indexArray #-}
indexArray :: forall a. Array a -> Int -> a
indexArray Array a
arr (I# Int#
i#) = case forall a. Array# a -> Int# -> (# a #)
indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i# of (# a
x #) -> a
x

-- | Read a value from the immutable array at the given index, returning
-- the result in an unboxed unary tuple. This is currently used to implement
-- folds.
--
-- /Note:/ this function does not do bounds checking.
indexArray## :: Array a -> Int -> (# a #)
indexArray## :: forall a. Array a -> Int -> (# a #)
indexArray## Array a
arr (I# Int#
i) = forall a. Array# a -> Int# -> (# a #)
indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i
{-# INLINE indexArray## #-}

-- | Read a value from the immutable array at the given index using an applicative.
-- This allows us to be strict in the array while remaining lazy in the read
-- element which is very useful for collective operations. Suppose we want to
-- copy an array. We could do something like this:
--
-- > copy marr arr ... = do ...
-- >                        writeArray marr i (indexArray arr i) ...
-- >                        ...
--
-- But since the arrays are lazy, the calls to 'indexArray' will not be
-- evaluated. Rather, @marr@ will be filled with thunks each of which would
-- retain a reference to @arr@. This is definitely not what we want!
--
-- With 'indexArrayM', we can instead write
--
-- > copy marr arr ... = do ...
-- >                        x <- indexArrayM arr i
-- >                        writeArray marr i x
-- >                        ...
--
-- Now, indexing is executed immediately although the returned element is
-- still not evaluated.
--
-- /Note:/ this function does not do bounds checking.
indexArrayM :: Applicative m => Array a -> Int -> m a
{-# INLINE indexArrayM #-}
indexArrayM :: forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array a
arr (I# Int#
i#)
  = case forall a. Array# a -> Int# -> (# a #)
indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i# of (# a
x #) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Create an immutable copy of a slice of an array.
--
-- This operation makes a copy of the specified section, so it is safe to
-- continue using the mutable array afterward.
--
-- /Note:/ The provided array should contain the full subrange
-- specified by the two Ints, but this is not checked.
freezeArray
  :: PrimMonad m
  => MutableArray (PrimState m) a -- ^ source
  -> Int                          -- ^ offset
  -> Int                          -- ^ length
  -> m (Array a)
{-# INLINE freezeArray #-}
freezeArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray (MutableArray MutableArray# (PrimState m) a
ma#) (I# Int#
off#) (I# Int#
len#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, Array# a #)
freezeArray# MutableArray# (PrimState m) a
ma# Int#
off# Int#
len# State# (PrimState m)
s of
    (# State# (PrimState m)
s', Array# a
a# #) -> (# State# (PrimState m)
s', forall a. Array# a -> Array a
Array Array# a
a# #)

-- | Convert a mutable array to an immutable one without copying. The
-- array should not be modified after the conversion.
unsafeFreezeArray :: PrimMonad m => MutableArray (PrimState m) a -> m (Array a)
{-# INLINE unsafeFreezeArray #-}
unsafeFreezeArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) a
arr
  = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
unsafeFreezeArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray (PrimState m) a
arr) State# (PrimState m)
s# of
                        (# State# (PrimState m)
s'#, Array# a
arr'# #) ->
                          let a :: Array a
a = forall a. Array# a -> Array a
Array Array# a
arr'#
                          in (# State# (PrimState m)
s'#, Array a
a #))

-- | Create a mutable array from a slice of an immutable array.
--
-- This operation makes a copy of the specified slice, so it is safe to use the
-- immutable array afterward.
--
-- /Note:/ The provided array should contain the full subrange
-- specified by the two Ints, but this is not checked.
thawArray
  :: PrimMonad m
  => Array a -- ^ source
  -> Int     -- ^ offset
  -> Int     -- ^ length
  -> m (MutableArray (PrimState m) a)
{-# INLINE thawArray #-}
thawArray :: forall (m :: * -> *) a.
PrimMonad m =>
Array a -> Int -> Int -> m (MutableArray (PrimState m) a)
thawArray (Array Array# a
a#) (I# Int#
off#) (I# Int#
len#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall a d.
Array# a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
thawArray# Array# a
a# Int#
off# Int#
len# State# (PrimState m)
s of
    (# State# (PrimState m)
s', MutableArray# (PrimState m) a
ma# #) -> (# State# (PrimState m)
s', forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
ma# #)

-- | Convert an immutable array to an mutable one without copying. The
-- immutable array should not be used after the conversion.
unsafeThawArray :: PrimMonad m => Array a -> m (MutableArray (PrimState m) a)
{-# INLINE unsafeThawArray #-}
unsafeThawArray :: forall (m :: * -> *) a.
PrimMonad m =>
Array a -> m (MutableArray (PrimState m) a)
unsafeThawArray Array a
a
  = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case forall a d.
Array# a -> State# d -> (# State# d, MutableArray# d a #)
unsafeThawArray# (forall a. Array a -> Array# a
array# Array a
a) State# (PrimState m)
s# of
                        (# State# (PrimState m)
s'#, MutableArray# (PrimState m) a
arr'# #) ->
                          let ma :: MutableArray (PrimState m) a
ma = forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr'#
                          in (# State# (PrimState m)
s'#, MutableArray (PrimState m) a
ma #))

-- | Check whether the two arrays refer to the same memory block.
sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool
{-# INLINE sameMutableArray #-}
sameMutableArray :: forall s a. MutableArray s a -> MutableArray s a -> Bool
sameMutableArray MutableArray s a
arr MutableArray s a
brr
  = Int# -> Bool
isTrue# (forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
arr) (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
brr))

-- | Copy a slice of an immutable array to a mutable array.
--
-- /Note:/ this function does not do bounds or overlap checking.
copyArray :: PrimMonad m
          => MutableArray (PrimState m) a    -- ^ destination array
          -> Int                             -- ^ offset into destination array
          -> Array a                         -- ^ source array
          -> Int                             -- ^ offset into source array
          -> Int                             -- ^ number of elements to copy
          -> m ()
{-# INLINE copyArray #-}
copyArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray (MutableArray MutableArray# (PrimState m) a
dst#) (I# Int#
doff#) (Array Array# a
src#) (I# Int#
soff#) (I# Int#
len#)
  = forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall a d.
Array# a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyArray# Array# a
src# Int#
soff# MutableArray# (PrimState m) a
dst# Int#
doff# Int#
len#)

-- | Copy a slice of a mutable array to another array. The two arrays may overlap.
--
-- /Note:/ this function does not do bounds or overlap checking.
copyMutableArray :: PrimMonad m
          => MutableArray (PrimState m) a    -- ^ destination array
          -> Int                             -- ^ offset into destination array
          -> MutableArray (PrimState m) a    -- ^ source array
          -> Int                             -- ^ offset into source array
          -> Int                             -- ^ number of elements to copy
          -> m ()
{-# INLINE copyMutableArray #-}
copyMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray (MutableArray MutableArray# (PrimState m) a
dst#) (I# Int#
doff#)
                 (MutableArray MutableArray# (PrimState m) a
src#) (I# Int#
soff#) (I# Int#
len#)
  = forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray# MutableArray# (PrimState m) a
src# Int#
soff# MutableArray# (PrimState m) a
dst# Int#
doff# Int#
len#)

-- | Return a newly allocated 'Array' with the specified subrange of the
-- provided 'Array'.
--
-- /Note:/ The provided array should contain the full subrange
-- specified by the two Ints, but this is not checked.
cloneArray :: Array a -- ^ source array
           -> Int     -- ^ offset into destination array
           -> Int     -- ^ number of elements to copy
           -> Array a
{-# INLINE cloneArray #-}
cloneArray :: forall a. Array a -> Int -> Int -> Array a
cloneArray (Array Array# a
arr#) (I# Int#
off#) (I# Int#
len#)
  = case forall a. Array# a -> Int# -> Int# -> Array# a
cloneArray# Array# a
arr# Int#
off# Int#
len# of Array# a
arr'# -> forall a. Array# a -> Array a
Array Array# a
arr'#

-- | Return a newly allocated 'MutableArray'. with the specified subrange of
-- the provided 'MutableArray'. The provided 'MutableArray' should contain the
-- full subrange specified by the two Ints, but this is not checked.
--
-- /Note:/ The provided array should contain the full subrange
-- specified by the two Ints, but this is not checked.
cloneMutableArray :: PrimMonad m
        => MutableArray (PrimState m) a -- ^ source array
        -> Int                          -- ^ offset into destination array
        -> Int                          -- ^ number of elements to copy
        -> m (MutableArray (PrimState m) a)
{-# INLINE cloneMutableArray #-}
cloneMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
cloneMutableArray (MutableArray MutableArray# (PrimState m) a
arr#) (I# Int#
off#) (I# Int#
len#) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
   (\State# (PrimState m)
s# -> case forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
cloneMutableArray# MutableArray# (PrimState m) a
arr# Int#
off# Int#
len# State# (PrimState m)
s# of
             (# State# (PrimState m)
s'#, MutableArray# (PrimState m) a
arr'# #) -> (# State# (PrimState m)
s'#, forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr'# #))

-- | The empty 'Array'.
emptyArray :: Array a
emptyArray :: forall a. Array a
emptyArray =
  forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 (forall a. String -> String -> a
die String
"emptyArray" String
"impossible") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray
{-# NOINLINE emptyArray #-}

-- | Execute the monadic action and freeze the resulting array.
--
-- > runArray m = runST $ m >>= unsafeFreezeArray
runArray
  :: (forall s. ST s (MutableArray s a))
  -> Array a
runArray :: forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray forall s. ST s (MutableArray s a)
m = forall a. Array# a -> Array a
Array (forall a. (forall s. ST s (MutableArray s a)) -> Array# a
runArray# forall s. ST s (MutableArray s a)
m)

runArray#
  :: (forall s. ST s (MutableArray s a))
  -> Array# a
runArray# :: forall a. (forall s. ST s (MutableArray s a)) -> Array# a
runArray# forall s. ST s (MutableArray s a)
m = case forall o. (State# RealWorld -> o) -> o
runRW# forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case forall s a. ST s a -> State# s -> (# State# s, a #)
unST forall s. ST s (MutableArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', MutableArray MutableArray# RealWorld a
mary# #) ->
  forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
unsafeFreezeArray# MutableArray# RealWorld a
mary# State# RealWorld
s'} of (# State# RealWorld
_, Array# a
ary# #) -> Array# a
ary#

unST :: ST s a -> State# s -> (# State# s, a #)
unST :: forall s a. ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST STRep s a
f) = STRep s a
f

emptyArray# :: (# #) -> Array# a
emptyArray# :: forall a. (# #) -> Array# a
emptyArray# (# #)
_ = case forall a. Array a
emptyArray of Array Array# a
ar -> Array# a
ar
{-# NOINLINE emptyArray# #-}

-- | Create an array of the given size with a default value,
-- apply the monadic function and freeze the result. If the
-- size is 0, return 'emptyArray' (rather than a new copy thereof).
--
-- > createArray 0 _ _ = emptyArray
-- > createArray n x f = runArray $ do
-- >   mary <- newArray n x
-- >   f mary
-- >   pure mary
createArray
  :: Int
  -> a
  -> (forall s. MutableArray s a -> ST s ())
  -> Array a
-- This low-level business is designed to work with GHC's worker-wrapper
-- transformation. A lot of the time, we don't actually need an Array
-- constructor. By putting it on the outside, and being careful about
-- how we special-case the empty array, we can make GHC smarter about this.
-- The only downside is that separately created 0-length arrays won't share
-- their Array constructors, although they'll share their underlying
-- Array#s.
createArray :: forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
0 a
_ forall s. MutableArray s a -> ST s ()
_ = forall a. Array# a -> Array a
Array (forall a. (# #) -> Array# a
emptyArray# (# #))
createArray Int
n a
x forall s. MutableArray s a -> ST s ()
f = forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray forall a b. (a -> b) -> a -> b
$ do
  MutableArray s a
mary <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n a
x
  forall s. MutableArray s a -> ST s ()
f MutableArray s a
mary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableArray s a
mary


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

arrayLiftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq :: forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq a -> b -> Bool
p Array a
a1 Array b
a2 = forall a. Array a -> Int
sizeofArray Array a
a1 forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
sizeofArray Array b
a2 Bool -> Bool -> Bool
&& Int -> Bool
loop (forall a. Array a -> Int
sizeofArray Array a
a1 forall a. Num a => a -> a -> a
- Int
1)
  where loop :: Int -> Bool
loop Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
0     = Bool
True
               | (# a
x1 #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
               , (# b
x2 #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array b
a2 Int
i
               , Bool
otherwise = a -> b -> Bool
p a
x1 b
x2 Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
i forall a. Num a => a -> a -> a
- Int
1)

instance Eq a => Eq (Array a) where
  Array a
a1 == :: Array a -> Array a -> Bool
== Array a
a2 = forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq forall a. Eq a => a -> a -> Bool
(==) Array a
a1 Array a
a2

-- | @since 0.6.4.0
instance Eq1 Array where
  liftEq :: forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
liftEq = forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq

instance Eq (MutableArray s a) where
  MutableArray s a
ma1 == :: MutableArray s a -> MutableArray s a -> Bool
== MutableArray s a
ma2 = Int# -> Bool
isTrue# (forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ma1) (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ma2))

arrayLiftCompare :: (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare :: forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare a -> b -> Ordering
elemCompare Array a
a1 Array b
a2 = Int -> Ordering
loop Int
0
  where
  mn :: Int
mn = forall a. Array a -> Int
sizeofArray Array a
a1 forall a. Ord a => a -> a -> a
`min` forall a. Array a -> Int
sizeofArray Array b
a2
  loop :: Int -> Ordering
loop Int
i
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
mn
    , (# a
x1 #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
    , (# b
x2 #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array b
a2 Int
i
    = a -> b -> Ordering
elemCompare a
x1 b
x2 forall a. Monoid a => a -> a -> a
`mappend` Int -> Ordering
loop (Int
i forall a. Num a => a -> a -> a
+ Int
1)
    | Bool
otherwise = forall a. Ord a => a -> a -> Ordering
compare (forall a. Array a -> Int
sizeofArray Array a
a1) (forall a. Array a -> Int
sizeofArray Array b
a2)

-- | Lexicographic ordering. Subject to change between major versions.
instance Ord a => Ord (Array a) where
  compare :: Array a -> Array a -> Ordering
compare Array a
a1 Array a
a2 = forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare forall a. Ord a => a -> a -> Ordering
compare Array a
a1 Array a
a2

-- | @since 0.6.4.0
instance Ord1 Array where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
liftCompare = forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare

instance Foldable Array where
  -- Note: we perform the array lookups eagerly so we won't
  -- create thunks to perform lookups even if GHC can't see
  -- that the folding function is strict.
  foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f = \b
z !Array a
ary ->
    let
      !sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
      go :: Int -> b
go Int
i
        | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = b
z
        | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = a -> b -> b
f a
x (Int -> b
go (Int
i forall a. Num a => a -> a -> a
+ Int
1))
    in Int -> b
go Int
0
  {-# INLINE foldr #-}
  foldl :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl b -> a -> b
f = \b
z !Array a
ary ->
    let
      go :: Int -> b
go Int
i
        | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = b
z
        | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = b -> a -> b
f (Int -> b
go (Int
i forall a. Num a => a -> a -> a
- Int
1)) a
x
    in Int -> b
go (forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1)
  {-# INLINE foldl #-}
  foldr1 :: forall a. (a -> a -> a) -> Array a -> a
foldr1 a -> a -> a
f = \ !Array a
ary ->
    let
      !sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1
      go :: Int -> a
go Int
i =
        case forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
          (# a
x #) | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz -> a
x
                  | Bool
otherwise -> a -> a -> a
f a
x (Int -> a
go (Int
i forall a. Num a => a -> a -> a
+ Int
1))
    in if Int
sz forall a. Ord a => a -> a -> Bool
< Int
0
       then forall a. String -> String -> a
die String
"foldr1" String
"empty array"
       else Int -> a
go Int
0
  {-# INLINE foldr1 #-}
  foldl1 :: forall a. (a -> a -> a) -> Array a -> a
foldl1 a -> a -> a
f = \ !Array a
ary ->
    let
      !sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1
      go :: Int -> a
go Int
i =
        case forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
          (# a
x #) | Int
i forall a. Eq a => a -> a -> Bool
== Int
0 -> a
x
                  | Bool
otherwise -> a -> a -> a
f (Int -> a
go (Int
i forall a. Num a => a -> a -> a
- Int
1)) a
x
    in if Int
sz forall a. Ord a => a -> a -> Bool
< Int
0
       then forall a. String -> String -> a
die String
"foldl1" String
"empty array"
       else Int -> a
go Int
sz
  {-# INLINE foldl1 #-}
  foldr' :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr' a -> b -> b
f = \b
z !Array a
ary ->
    let
      go :: Int -> b -> b
go Int
i !b
acc
        | Int
i forall a. Eq a => a -> a -> Bool
== -Int
1 = b
acc
        | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = Int -> b -> b
go (Int
i forall a. Num a => a -> a -> a
- Int
1) (a -> b -> b
f a
x b
acc)
    in Int -> b -> b
go (forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1) b
z
  {-# INLINE foldr' #-}
  foldl' :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f = \b
z !Array a
ary ->
    let
      !sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
      go :: Int -> b -> b
go Int
i !b
acc
        | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = b
acc
        | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = Int -> b -> b
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (b -> a -> b
f b
acc a
x)
    in Int -> b -> b
go Int
0 b
z
  {-# INLINE foldl' #-}
  null :: forall a. Array a -> Bool
null Array a
a = forall a. Array a -> Int
sizeofArray Array a
a forall a. Eq a => a -> a -> Bool
== Int
0
  {-# INLINE null #-}
  length :: forall a. Array a -> Int
length = forall a. Array a -> Int
sizeofArray
  {-# INLINE length #-}
  maximum :: forall a. Ord a => Array a -> a
maximum Array a
ary | Int
sz forall a. Eq a => a -> a -> Bool
== Int
0   = forall a. String -> String -> a
die String
"maximum" String
"empty array"
              | (# a
frst #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
              = Int -> a -> a
go Int
1 a
frst
   where
     sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
     go :: Int -> a -> a
go Int
i !a
e
       | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
       | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
       = Int -> a -> a
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall a. Ord a => a -> a -> a
max a
e a
x)
  {-# INLINE maximum #-}
  minimum :: forall a. Ord a => Array a -> a
minimum Array a
ary | Int
sz forall a. Eq a => a -> a -> Bool
== Int
0   = forall a. String -> String -> a
die String
"minimum" String
"empty array"
              | (# a
frst #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
              = Int -> a -> a
go Int
1 a
frst
   where sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
         go :: Int -> a -> a
go Int
i !a
e
           | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
           | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
           = Int -> a -> a
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall a. Ord a => a -> a -> a
min a
e a
x)
  {-# INLINE minimum #-}
  sum :: forall a. Num a => Array a -> a
sum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0
  {-# INLINE sum #-}
  product :: forall a. Num a => Array a -> a
product = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(*) a
1
  {-# INLINE product #-}

newtype STA a = STA { forall a. STA a -> forall s. MutableArray# s a -> ST s (Array a)
_runSTA :: forall s. MutableArray# s a -> ST s (Array a) }

runSTA :: Int -> STA a -> Array a
runSTA :: forall a. Int -> STA a -> Array a
runSTA !Int
sz = \ (STA forall s. MutableArray# s a -> ST s (Array a)
m) -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. Int -> ST s (MutableArray s a)
newArray_ Int
sz forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ MutableArray s a
ar -> forall s. MutableArray# s a -> ST s (Array a)
m (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ar)
{-# INLINE runSTA #-}

newArray_ :: Int -> ST s (MutableArray s a)
newArray_ :: forall s a. Int -> ST s (MutableArray s a)
newArray_ !Int
n = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n forall a. a
badTraverseValue

badTraverseValue :: a
badTraverseValue :: forall a. a
badTraverseValue = forall a. String -> String -> a
die String
"traverse" String
"bad indexing"
{-# NOINLINE badTraverseValue #-}

instance Traversable Array where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverse a -> f b
f = forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverseArray a -> f b
f
  {-# INLINE traverse #-}

traverseArray
  :: Applicative f
  => (a -> f b)
  -> Array a
  -> f (Array b)
traverseArray :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverseArray a -> f b
f = \ !Array a
ary ->
  let
    !len :: Int
len = forall a. Array a -> Int
sizeofArray Array a
ary
    go :: Int -> f (STA b)
go !Int
i
      | Int
i forall a. Eq a => a -> a -> Bool
== Int
len = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary -> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray (forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary)
      | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
      = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\b
b (STA forall s. MutableArray# s b -> ST s (Array b)
m) -> forall a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary ->
                  forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray (forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary) Int
i b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. MutableArray# s b -> ST s (Array b)
m MutableArray# s b
mary)
               (a -> f b
f a
x) (Int -> f (STA b)
go (Int
i forall a. Num a => a -> a -> a
+ Int
1))
  in if Int
len forall a. Eq a => a -> a -> Bool
== Int
0
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Array a
emptyArray
    else forall a. Int -> STA a -> Array a
runSTA Int
len forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f (STA b)
go Int
0
{-# INLINE [1] traverseArray #-}

{-# RULES
"traverse/ST" forall (f :: a -> ST s b). traverseArray f =
   traverseArrayP f
"traverse/IO" forall (f :: a -> IO b). traverseArray f =
   traverseArrayP f
"traverse/Id" forall (f :: a -> Identity b). traverseArray f =
   (coerce :: (Array a -> Array (Identity b))
           -> Array a -> Identity (Array b)) (fmap f)
 #-}

-- | This is the fastest, most straightforward way to traverse
-- an array, but it only works correctly with a sufficiently
-- "affine" 'PrimMonad' instance. In particular, it must only produce
-- /one/ result array. 'Control.Monad.Trans.List.ListT'-transformed
-- monads, for example, will not work right at all.
traverseArrayP
  :: PrimMonad m
  => (a -> m b)
  -> Array a
  -> m (Array b)
traverseArrayP :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> m b) -> Array a -> m (Array b)
traverseArrayP a -> m b
f = \ !Array a
ary ->
  let
    !sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
    go :: Int -> MutableArray (PrimState m) b -> m (Array b)
go !Int
i !MutableArray (PrimState m) b
mary
      | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz
      = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) b
mary
      | Bool
otherwise
      = do
          a
a <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array a
ary Int
i
          b
b <- a -> m b
f a
a
          forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray (PrimState m) b
mary Int
i b
b
          Int -> MutableArray (PrimState m) b -> m (Array b)
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) MutableArray (PrimState m) b
mary
  in do
    MutableArray (PrimState m) b
mary <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz forall a. a
badTraverseValue
    Int -> MutableArray (PrimState m) b -> m (Array b)
go Int
0 MutableArray (PrimState m) b
mary
{-# INLINE traverseArrayP #-}

-- | Strict map over the elements of the array.
mapArray' :: (a -> b) -> Array a -> Array b
mapArray' :: forall a b. (a -> b) -> Array a -> Array b
mapArray' a -> b
f Array a
a =
  forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray Array a
a) (forall a. String -> String -> a
die String
"mapArray'" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
    let go :: Int -> ST s ()
go Int
i | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
sizeofArray Array a
a
             = forall (m :: * -> *) a. Monad m => a -> m a
return ()
             | Bool
otherwise
             = do a
x <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
                  -- We use indexArrayM here so that we will perform the
                  -- indexing eagerly even if f is lazy.
                  let !y :: b
y = a -> b
f a
x
                  forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb Int
i b
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
     in Int -> ST s ()
go Int
0
{-# INLINE mapArray' #-}

-- | Create an array from a list of a known length. If the length
-- of the list does not match the given length, this throws an exception.
arrayFromListN :: Int -> [a] -> Array a
arrayFromListN :: forall a. Int -> [a] -> Array a
arrayFromListN Int
n [a]
l =
  forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
n (forall a. String -> String -> a
die String
"fromListN" String
"uninitialized element") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
sma ->
    let go :: Int -> [a] -> ST s ()
go !Int
ix [] = if Int
ix forall a. Eq a => a -> a -> Bool
== Int
n
          then forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else forall a. String -> String -> a
die String
"fromListN" String
"list length less than specified size"
        go !Int
ix (a
x : [a]
xs) = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
n
          then do
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
sma Int
ix a
x
            Int -> [a] -> ST s ()
go (Int
ixforall a. Num a => a -> a -> a
+Int
1) [a]
xs
          else forall a. String -> String -> a
die String
"fromListN" String
"list length greater than specified size"
    in Int -> [a] -> ST s ()
go Int
0 [a]
l

-- | Create an array from a list.
arrayFromList :: [a] -> Array a
arrayFromList :: forall a. [a] -> Array a
arrayFromList [a]
l = forall a. Int -> [a] -> Array a
arrayFromListN (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) [a]
l

instance Exts.IsList (Array a) where
  type Item (Array a) = a
  fromListN :: Int -> [Item (Array a)] -> Array a
fromListN = forall a. Int -> [a] -> Array a
arrayFromListN
  fromList :: [Item (Array a)] -> Array a
fromList = forall a. [a] -> Array a
arrayFromList
  toList :: Array a -> [Item (Array a)]
toList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance Functor Array where
  fmap :: forall a b. (a -> b) -> Array a -> Array b
fmap a -> b
f Array a
a =
    forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray Array a
a) (forall a. String -> String -> a
die String
"fmap" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
      let go :: Int -> ST s ()
go Int
i | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
sizeofArray Array a
a
               = forall (m :: * -> *) a. Monad m => a -> m a
return ()
               | Bool
otherwise
               = do a
x <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
                    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb Int
i (a -> b
f a
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
       in Int -> ST s ()
go Int
0
  a
e <$ :: forall a b. a -> Array b -> Array a
<$ Array b
a = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray Array b
a) a
e (\ !MutableArray s a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Applicative Array where
  pure :: forall a. a -> Array a
pure a
x = forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
1 a
x

  Array (a -> b)
ab <*> :: forall a b. Array (a -> b) -> Array a -> Array b
<*> Array a
a = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
szab forall a. Num a => a -> a -> a
* Int
sza) (forall a. String -> String -> a
die String
"<*>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
    let go1 :: Int -> ST s ()
go1 Int
i = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
szab) forall a b. (a -> b) -> a -> b
$
            do
              a -> b
f <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array (a -> b)
ab Int
i
              Int -> (a -> b) -> Int -> ST s ()
go2 (Int
i forall a. Num a => a -> a -> a
* Int
sza) a -> b
f Int
0
              Int -> ST s ()
go1 (Int
i forall a. Num a => a -> a -> a
+ Int
1)
        go2 :: Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f Int
j = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j forall a. Ord a => a -> a -> Bool
< Int
sza) forall a b. (a -> b) -> a -> b
$
            do
              a
x <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array a
a Int
j
              forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb (Int
off forall a. Num a => a -> a -> a
+ Int
j) (a -> b
f a
x)
              Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f (Int
j forall a. Num a => a -> a -> a
+ Int
1)
    in Int -> ST s ()
go1 Int
0
   where szab :: Int
szab = forall a. Array a -> Int
sizeofArray Array (a -> b)
ab; sza :: Int
sza = forall a. Array a -> Int
sizeofArray Array a
a

  Array a
a *> :: forall a b. Array a -> Array b -> Array b
*> Array b
b = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza forall a. Num a => a -> a -> a
* Int
szb) (forall a. String -> String -> a
die String
"*>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
    let go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
sza   = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s b
mb (Int
i forall a. Num a => a -> a -> a
* Int
szb) Array b
b Int
0 Int
szb forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
             | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    in Int -> ST s ()
go Int
0
   where sza :: Int
sza = forall a. Array a -> Int
sizeofArray Array a
a; szb :: Int
szb = forall a. Array a -> Int
sizeofArray Array b
b

  Array a
a <* :: forall a b. Array a -> Array b -> Array a
<* Array b
b = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza forall a. Num a => a -> a -> a
* Int
szb) (forall a. String -> String -> a
die String
"<*" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
    let fill :: Int -> Int -> a -> ST s ()
fill Int
off Int
i a
e | Int
i forall a. Ord a => a -> a -> Bool
< Int
szb   = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
ma (Int
off forall a. Num a => a -> a -> a
+ Int
i) a
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> a -> ST s ()
fill Int
off (Int
i forall a. Num a => a -> a -> a
+ Int
1) a
e
                     | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
sza
             = do a
x <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
                  Int -> Int -> a -> ST s ()
fill (Int
i forall a. Num a => a -> a -> a
* Int
szb) Int
0 a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
             | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    in Int -> ST s ()
go Int
0
   where sza :: Int
sza = forall a. Array a -> Int
sizeofArray Array a
a; szb :: Int
szb = forall a. Array a -> Int
sizeofArray Array b
b

instance Alternative Array where
  empty :: forall a. Array a
empty = forall a. Array a
emptyArray
  Array a
a1 <|> :: forall a. Array a -> Array a -> Array a
<|> Array a
a2 = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza1 forall a. Num a => a -> a -> a
+ Int
sza2) (forall a. String -> String -> a
die String
"<|>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma Int
0 Array a
a1 Int
0 Int
sza1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma Int
sza1 Array a
a2 Int
0 Int
sza2
   where sza1 :: Int
sza1 = forall a. Array a -> Int
sizeofArray Array a
a1; sza2 :: Int
sza2 = forall a. Array a -> Int
sizeofArray Array a
a2
  some :: forall a. Array a -> Array [a]
some Array a
a | forall a. Array a -> Int
sizeofArray Array a
a forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Array a
emptyArray
         | Bool
otherwise = forall a. String -> String -> a
die String
"some" String
"infinite arrays are not well defined"
  many :: forall a. Array a -> Array [a]
many Array a
a | forall a. Array a -> Int
sizeofArray Array a
a forall a. Eq a => a -> a -> Bool
== Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
         | Bool
otherwise = forall a. String -> String -> a
die String
"many" String
"infinite arrays are not well defined"

data ArrayStack a
  = PushArray !(Array a) !(ArrayStack a)
  | EmptyStack
-- See the note in SmallArray about how we might improve this.

instance Monad Array where
  return :: forall a. a -> Array a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >> :: forall a b. Array a -> Array b -> Array b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

  Array a
ary >>= :: forall a b. Array a -> (a -> Array b) -> Array b
>>= a -> Array b
f = Int -> ArrayStack b -> Int -> Array b
collect Int
0 forall a. ArrayStack a
EmptyStack (Int
la forall a. Num a => a -> a -> a
- Int
1)
   where
    la :: Int
la = forall a. Array a -> Int
sizeofArray Array a
ary
    collect :: Int -> ArrayStack b -> Int -> Array b
collect Int
sz ArrayStack b
stk Int
i
      | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (forall a. String -> String -> a
die String
">>=" String
"impossible") forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a}.
PrimMonad m =>
Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill Int
0 ArrayStack b
stk
      | (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
      , let sb :: Array b
sb = a -> Array b
f a
x
            lsb :: Int
lsb = forall a. Array a -> Int
sizeofArray Array b
sb
        -- If we don't perform this check, we could end up allocating
        -- a stack full of empty arrays if someone is filtering most
        -- things out. So we refrain from pushing empty arrays.
      = if Int
lsb forall a. Eq a => a -> a -> Bool
== Int
0
        then Int -> ArrayStack b -> Int -> Array b
collect Int
sz ArrayStack b
stk (Int
i forall a. Num a => a -> a -> a
- Int
1)
        else Int -> ArrayStack b -> Int -> Array b
collect (Int
sz forall a. Num a => a -> a -> a
+ Int
lsb) (forall a. Array a -> ArrayStack a -> ArrayStack a
PushArray Array b
sb ArrayStack b
stk) (Int
i forall a. Num a => a -> a -> a
- Int
1)

    fill :: Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill Int
_ ArrayStack a
EmptyStack MutableArray (PrimState m) a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fill Int
off (PushArray Array a
sb ArrayStack a
sbs) MutableArray (PrimState m) a
smb
      | let lsb :: Int
lsb = forall a. Array a -> Int
sizeofArray Array a
sb
      = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray (PrimState m) a
smb Int
off Array a
sb Int
0 Int
lsb
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill (Int
off forall a. Num a => a -> a -> a
+ Int
lsb) ArrayStack a
sbs MutableArray (PrimState m) a
smb

#if !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail
#endif

instance Fail.MonadFail Array where
  fail :: forall a. String -> Array a
fail String
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance MonadPlus Array where
  mzero :: forall a. Array a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a. Array a -> Array a -> Array a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

zipW :: String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW :: forall a b c.
String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
s a -> b -> c
f Array a
aa Array b
ab = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
mn (forall a. String -> String -> a
die String
s String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s c
mc ->
  let go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
mn
           = do
               a
x <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array a
aa Int
i
               b
y <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array b
ab Int
i
               forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s c
mc Int
i (a -> b -> c
f a
x b
y)
               Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
           | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
   in Int -> ST s ()
go Int
0
 where mn :: Int
mn = forall a. Array a -> Int
sizeofArray Array a
aa forall a. Ord a => a -> a -> a
`min` forall a. Array a -> Int
sizeofArray Array b
ab
{-# INLINE zipW #-}

instance MonadZip Array where
  mzip :: forall a b. Array a -> Array b -> Array (a, b)
mzip Array a
aa Array b
ab = forall a b c.
String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
"mzip" (,) Array a
aa Array b
ab
  mzipWith :: forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c
mzipWith a -> b -> c
f Array a
aa Array b
ab = forall a b c.
String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
"mzipWith" a -> b -> c
f Array a
aa Array b
ab
  munzip :: forall a b. Array (a, b) -> (Array a, Array b)
munzip Array (a, b)
aab = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    let sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array (a, b)
aab
    MutableArray s a
ma <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz (forall a. String -> String -> a
die String
"munzip" String
"impossible")
    MutableArray s b
mb <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz (forall a. String -> String -> a
die String
"munzip" String
"impossible")
    let go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
sz = do
          (a
a, b
b) <- forall (m :: * -> *) a. Applicative m => Array a -> Int -> m a
indexArrayM Array (a, b)
aab Int
i
          forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
ma Int
i a
a
          forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb Int
i b
b
          Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
        go Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Int -> ST s ()
go Int
0
    (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
ma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s b
mb

instance MonadFix Array where
  mfix :: forall a. (a -> Array a) -> Array a
mfix a -> Array a
f = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray (a -> Array a
f forall a. a
err))
                       (forall a. String -> String -> a
die String
"mfix" String
"impossible") forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix Int
0 forall a b. (a -> b) -> a -> b
$
    \Int -> MutableArray s a -> ST s ()
r !Int
i !MutableArray s a
mary -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
sz) forall a b. (a -> b) -> a -> b
$ do
                      forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
mary Int
i (forall a. (a -> a) -> a
fix (\a
xi -> a -> Array a
f a
xi forall a. Array a -> Int -> a
`indexArray` Int
i))
                      Int -> MutableArray s a -> ST s ()
r (Int
i forall a. Num a => a -> a -> a
+ Int
1) MutableArray s a
mary
    where
      sz :: Int
sz = forall a. Array a -> Int
sizeofArray (a -> Array a
f forall a. a
err)
      err :: a
err = forall a. HasCallStack => String -> a
error String
"mfix for Data.Primitive.Array applied to strict function."

-- | @since 0.6.3.0
instance Semigroup (Array a) where
  <> :: Array a -> Array a -> Array a
(<>) = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  sconcat :: NonEmpty (Array a) -> Array a
sconcat = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  stimes :: forall b. Integral b => b -> Array a -> Array a
stimes b
n Array a
arr = case forall a. Ord a => a -> a -> Ordering
compare b
n b
0 of
    Ordering
LT -> forall a. String -> String -> a
die String
"stimes" String
"negative multiplier"
    Ordering
EQ -> forall (f :: * -> *) a. Alternative f => f a
empty
    Ordering
GT -> forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
n' forall a. Num a => a -> a -> a
* forall a. Array a -> Int
sizeofArray Array a
arr) (forall a. String -> String -> a
die String
"stimes" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
      let go :: Int -> ST s ()
go Int
i = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
n') forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma (Int
i forall a. Num a => a -> a -> a
* forall a. Array a -> Int
sizeofArray Array a
arr) Array a
arr Int
0 (forall a. Array a -> Int
sizeofArray Array a
arr)
            Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
      in Int -> ST s ()
go Int
0
    where n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n :: Int

instance Monoid (Array a) where
  mempty :: Array a
mempty = forall (f :: * -> *) a. Alternative f => f a
empty
#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif
  mconcat :: [Array a] -> Array a
mconcat [Array a]
l = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (forall a. String -> String -> a
die String
"mconcat" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
    let go :: Int -> [Array a] -> ST s ()
go !Int
_  [    ] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go Int
off (Array a
a:[Array a]
as) =
          forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma Int
off Array a
a Int
0 (forall a. Array a -> Int
sizeofArray Array a
a) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Array a] -> ST s ()
go (Int
off forall a. Num a => a -> a -> a
+ forall a. Array a -> Int
sizeofArray Array a
a) [Array a]
as
     in Int -> [Array a] -> ST s ()
go Int
0 [Array a]
l
   where sz :: Int
sz = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Array a -> Int
sizeofArray forall a b. (a -> b) -> a -> b
$ [Array a]
l

arrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec Int -> a -> ShowS
elemShowsPrec [a] -> ShowS
elemListShowsPrec Int
_ Array a
a =
  forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec Int -> a -> ShowS
elemShowsPrec [a] -> ShowS
elemListShowsPrec Int
11 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
a)

-- this need to be included for older ghcs
listLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
sl Int
_ = [a] -> ShowS
sl

instance Show a => Show (Array a) where
  showsPrec :: Int -> Array a -> ShowS
showsPrec Int
p Array a
a = forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList Int
p Array a
a

-- | @since 0.6.4.0
instance Show1 Array where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
liftShowsPrec = forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec

instance Read a => Read (Array a) where
  readPrec :: ReadPrec (Array a)
readPrec = forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec forall a. Read a => ReadPrec a
readPrec forall a. Read a => ReadPrec [a]
readListPrec

-- | @since 0.6.4.0
instance Read1 Array where
#if MIN_VERSION_base(4,10,0)
  liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
liftReadPrec = forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec
#else
  -- This is just the default implementation of liftReadsPrec, but
  -- it is not present in older versions of base.
  liftReadsPrec rp rl = RdPrc.readPrec_to_S $
    arrayLiftReadPrec (RdPrc.readS_to_Prec rp) (RdPrc.readS_to_Prec (const rl))
#endif

-- Note [Forgiving Array Read Instance]
-- We're really forgiving here. We accept
-- "[1,2,3]", "fromList [1,2,3]", and "fromListN 3 [1,2,3]".
-- We consider fromListN with an invalid length to be an
-- error, rather than a parse failure, because doing otherwise
-- seems weird and likely to make debugging difficult.
arrayLiftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec ReadPrec a
_ ReadPrec [a]
read_list =
  ( forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP ()
skipSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList ReadPrec [a]
read_list )
  forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
RdPrc.+++
  ( forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec forall a b. (a -> b) -> a -> b
$ do
      forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP ()
skipSpaces
      Tag
tag <- forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP Tag
lexTag
      case Tag
tag of
        Tag
FromListTag -> forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
read_list
        Tag
FromListNTag -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall l. IsList l => Int -> [Item l] -> l
fromListN forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
read_list
  )
  where
  app_prec :: Int
app_prec = Int
10

arrayDataType :: DataType
arrayDataType :: DataType
arrayDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Primitive.Array.Array" [Constr
fromListConstr]

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
arrayDataType String
"fromList" [] Fixity
Prefix

instance Data a => Data (Array a) where
  toConstr :: Array a -> Constr
toConstr Array a
_ = Constr
fromListConstr
  dataTypeOf :: Array a -> DataType
dataTypeOf Array a
_ = DataType
arrayDataType
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall l. IsList l => [Item l] -> l
fromList)
    Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array a -> c (Array a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Array a
m = forall g. g -> c g
z forall l. IsList l => [Item l] -> l
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
m

instance (Typeable s, Typeable a) => Data (MutableArray s a) where
  toConstr :: MutableArray s a -> Constr
toConstr MutableArray s a
_ = forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MutableArray s a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: MutableArray s a -> DataType
dataTypeOf MutableArray s a
_ = String -> DataType
mkNoRepType String
"Data.Primitive.Array.MutableArray"