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

-- |
-- 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,
  unsafeFreezeArray, unsafeThawArray, sameMutableArray,
  copyArray, copyMutableArray,
  cloneArray, cloneMutableArray,
  sizeofArray, sizeofMutableArray,
  fromListN, fromList,
  arrayFromListN, arrayFromList,
  mapArray',
  traverseArrayP
) where

import Control.DeepSeq
import Control.Monad.Primitive
import Data.Data (mkNoRepType)

import GHC.Base  ( Int(..) )
import GHC.Exts
#if (MIN_VERSION_base(4,7,0))
  hiding (toList)
#endif
import qualified GHC.Exts as Exts
#if (MIN_VERSION_base(4,7,0))
import GHC.Exts (fromListN, fromList)
#endif

import Data.Typeable ( Typeable )
import Data.Data
  (Data(..), DataType, mkDataType, Constr, mkConstr, Fixity(..), constrIndex)
import Data.Primitive.Internal.Compat ( isTrue# )

import Control.Monad.ST(ST,runST)

import Control.Applicative
import Control.Monad (MonadPlus(..), when)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import qualified Data.Foldable as Foldable
#if MIN_VERSION_base(4,4,0)
import Control.Monad.Zip
#endif
import Data.Foldable (Foldable(..), toList)
#if !(MIN_VERSION_base(4,8,0))
import Data.Traversable (Traversable(..))
import Data.Monoid
#endif
#if MIN_VERSION_base(4,9,0)
import qualified GHC.ST as GHCST
import qualified Data.Foldable as F
import Data.Semigroup
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity
#endif
#if MIN_VERSION_base(4,10,0)
import GHC.Exts (runRW#)
#elif MIN_VERSION_base(4,9,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

#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),Read1(..))
#endif
import Control.Monad (liftM2)

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

#if MIN_VERSION_deepseq(1,4,3)
instance NFData1 Array where
  liftRnf :: (a -> ()) -> Array a -> ()
liftRnf a -> ()
r = (() -> a -> ()) -> () -> Array a -> ()
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 = (() -> a -> ()) -> () -> Array a -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\()
_ -> a -> ()
forall a. NFData a => a -> ()
rnf) ()

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

sizeofArray :: Array a -> Int
sizeofArray :: Array a -> Int
sizeofArray Array a
a = Int# -> Int
I# (Array# a -> Int#
forall a. Array# a -> Int#
sizeofArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
a))
{-# INLINE sizeofArray #-}

sizeofMutableArray :: MutableArray s a -> Int
sizeofMutableArray :: MutableArray s a -> Int
sizeofMutableArray MutableArray s a
a = Int# -> Int
I# (MutableArray# s a -> Int#
forall d a. MutableArray# d a -> Int#
sizeofMutableArray# (MutableArray s a -> MutableArray# s a
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 :: Int -> a -> m (MutableArray (PrimState m) a)
newArray (I# Int#
n#) a
x = (State# (PrimState m)
 -> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
   (\State# (PrimState m)
s# -> case Int#
-> a
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
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 = MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
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 :: MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray (PrimState m) a
arr (I# Int#
i#) = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (MutableArray# (PrimState m) a
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# (MutableArray (PrimState m) a -> MutableArray# (PrimState m) a
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 :: MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray (PrimState m) a
arr (I# Int#
i#) a
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableArray# (PrimState m) a
-> Int# -> a -> State# (PrimState m) -> State# (PrimState m)
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# (MutableArray (PrimState m) a -> MutableArray# (PrimState m) a
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 :: Array a -> Int -> a
indexArray Array a
arr (I# Int#
i#) = case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
indexArray# (Array a -> Array# a
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## :: Array a -> Int -> (# a #)
indexArray## Array a
arr (I# Int#
i) = Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i
{-# INLINE indexArray## #-}

-- | Monadically read a value from the immutable array at the given index.
-- 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 primitive 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 :: Monad m => Array a -> Int -> m a
{-# INLINE indexArrayM #-}
indexArrayM :: Array a -> Int -> m a
indexArrayM Array a
arr (I# Int#
i#)
  = case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i# of (# a
x #) -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return 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.
freezeArray
  :: PrimMonad m
  => MutableArray (PrimState m) a -- ^ source
  -> Int                          -- ^ offset
  -> Int                          -- ^ length
  -> m (Array a)
{-# INLINE freezeArray #-}
freezeArray :: MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray (MutableArray MutableArray# (PrimState m) a
ma#) (I# Int#
off#) (I# Int#
len#) =
  (State# (PrimState m) -> (# State# (PrimState m), Array a #))
-> m (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), Array a #))
 -> m (Array a))
-> (State# (PrimState m) -> (# State# (PrimState m), Array a #))
-> m (Array a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Array# a #)
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', Array# a -> Array a
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 :: MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) a
arr
  = (State# (PrimState m) -> (# State# (PrimState m), Array a #))
-> m (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case MutableArray# (PrimState m) a
-> State# (PrimState m) -> (# State# (PrimState m), Array# a #)
forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
unsafeFreezeArray# (MutableArray (PrimState m) a -> MutableArray# (PrimState m) a
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 = Array# a -> Array 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.
thawArray
  :: PrimMonad m
  => Array a -- ^ source
  -> Int     -- ^ offset
  -> Int     -- ^ length
  -> m (MutableArray (PrimState m) a)
{-# INLINE thawArray #-}
thawArray :: Array a -> Int -> Int -> m (MutableArray (PrimState m) a)
thawArray (Array Array# a
a#) (I# Int#
off#) (I# Int#
len#) =
  (State# (PrimState m)
 -> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), MutableArray (PrimState m) a #))
 -> m (MutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case Array# a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
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', MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
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 :: Array a -> m (MutableArray (PrimState m) a)
unsafeThawArray Array a
a
  = (State# (PrimState m)
 -> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case Array# a
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
forall a d.
Array# a -> State# d -> (# State# d, MutableArray# d a #)
unsafeThawArray# (Array a -> Array# a
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 = MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
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 :: MutableArray s a -> MutableArray s a -> Bool
sameMutableArray MutableArray s a
arr MutableArray s a
brr
  = Int# -> Bool
isTrue# (MutableArray# s a -> MutableArray# s a -> Int#
forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# (MutableArray s a -> MutableArray# s a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
arr) (MutableArray s a -> MutableArray# s a
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 #-}
#if __GLASGOW_HASKELL__ > 706
-- NOTE: copyArray# and copyMutableArray# are slightly broken in GHC 7.6.* and earlier
copyArray :: 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#)
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Array# a
-> Int#
-> MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
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#)
#else
copyArray !dst !doff !src !soff !len = go 0
  where
    go i | i < len = do
                       x <- indexArrayM src (soff+i)
                       writeArray dst (doff+i) x
                       go (i+1)
         | otherwise = return ()
#endif

-- | Copy a slice of a mutable array to another array. The two arrays must
-- not be the same when using this library with GHC versions 7.6 and older.
-- In GHC 7.8 and newer, overlapping arrays will behave correctly.
--
-- /Note:/ The order of arguments is different from that of 'copyMutableArray#'. The primop
-- has the source first while this wrapper has the destination first.
--
-- /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 #-}
#if __GLASGOW_HASKELL__ > 706
-- NOTE: copyArray# and copyMutableArray# are slightly broken in GHC 7.6.* and earlier
copyMutableArray :: 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#)
  = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableArray# (PrimState m) a
-> Int#
-> MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
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#)
#else
copyMutableArray !dst !doff !src !soff !len = go 0
  where
    go i | i < len = do
                       x <- readArray src (soff+i)
                       writeArray dst (doff+i) x
                       go (i+1)
         | otherwise = return ()
#endif

-- | 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 :: Array a -> Int -> Int -> Array a
cloneArray (Array Array# a
arr#) (I# Int#
off#) (I# Int#
len#)
  = case Array# a -> Int# -> Int# -> Array# a
forall a. Array# a -> Int# -> Int# -> Array# a
cloneArray# Array# a
arr# Int#
off# Int#
len# of Array# a
arr'# -> Array# a -> Array a
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 :: MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
cloneMutableArray (MutableArray MutableArray# (PrimState m) a
arr#) (I# Int#
off#) (I# Int#
len#) = (State# (PrimState m)
 -> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
   (\State# (PrimState m)
s# -> case MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
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'#, MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr'# #))

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

#if !MIN_VERSION_base(4,9,0)
createArray
  :: Int
  -> a
  -> (forall s. MutableArray s a -> ST s ())
  -> Array a
createArray 0 _ _ = emptyArray
createArray n x f = runArray $ do
  mary <- newArray n x
  f mary
  pure mary

runArray
  :: (forall s. ST s (MutableArray s a))
  -> Array a
runArray m = runST $ m >>= unsafeFreezeArray

#else /* Below, runRW# is available. */

-- 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
  :: Int
  -> a
  -> (forall s. MutableArray s a -> ST s ())
  -> Array a
createArray :: Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
0 a
_ forall s. MutableArray s a -> ST s ()
_ = Array# a -> Array a
forall a. Array# a -> Array a
Array ((# #) -> Array# a
forall a. (# #) -> Array# a
emptyArray# (# #))
createArray Int
n a
x forall s. MutableArray s a -> ST s ()
f = (forall s. ST s (MutableArray s a)) -> Array a
forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray ((forall s. ST s (MutableArray s a)) -> Array a)
-> (forall s. ST s (MutableArray s a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
  MutableArray s a
mary <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n a
x
  MutableArray s a -> ST s ()
forall s. MutableArray s a -> ST s ()
f MutableArray s a
mary
  MutableArray s a -> ST s (MutableArray s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableArray s a
mary

-- |
-- Execute the monadic action(s) and freeze the resulting array.
runArray
  :: (forall s. ST s (MutableArray s a))
  -> Array a
runArray :: (forall s. ST s (MutableArray s a)) -> Array a
runArray forall s. ST s (MutableArray s a)
m = Array# a -> Array a
forall a. Array# a -> Array a
Array ((forall s. ST s (MutableArray s a)) -> Array# a
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 s. ST s (MutableArray s a)) -> Array# a
runArray# forall s. ST s (MutableArray s a)
m = case (State# RealWorld -> (# State# RealWorld, Array# a #))
-> (# State# RealWorld, Array# a #)
forall o. (State# RealWorld -> o) -> o
runRW# ((State# RealWorld -> (# State# RealWorld, Array# a #))
 -> (# State# RealWorld, Array# a #))
-> (State# RealWorld -> (# State# RealWorld, Array# a #))
-> (# State# RealWorld, Array# a #)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case ST RealWorld (MutableArray RealWorld a)
-> State# RealWorld
-> (# State# RealWorld, MutableArray RealWorld a #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST ST RealWorld (MutableArray RealWorld a)
forall s. ST s (MutableArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', MutableArray MutableArray# RealWorld a
mary# #) ->
  MutableArray# RealWorld a
-> State# RealWorld -> (# State# RealWorld, Array# a #)
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 :: ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST State# s -> (# State# s, a #)
f) = State# s -> (# State# s, a #)
f

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


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.Array." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
problem

arrayLiftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq a -> b -> Bool
p Array a
a1 Array b
a2 = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
a2 Bool -> Bool -> Bool
&& Int -> Bool
loop (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a1 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
               | (# a
x1 #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
               , (# b
x2 #) <- Array b -> Int -> (# b #)
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
iInt -> Int -> Int
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 = (a -> a -> Bool) -> Array a -> Array a -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Array a
a1 Array a
a2

#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
-- | @since 0.6.4.0
instance Eq1 Array where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
  liftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
liftEq = (a -> b -> Bool) -> Array a -> Array b -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq
#else
  eq1 = arrayLiftEq (==)
#endif
#endif

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

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

#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
-- | @since 0.6.4.0
instance Ord1 Array where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
  liftCompare :: (a -> b -> Ordering) -> Array a -> Array b -> Ordering
liftCompare = (a -> b -> Ordering) -> Array a -> Array b -> Ordering
forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare
#else
  compare1 = arrayLiftCompare compare
#endif
#endif

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 :: (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f = \b
z !Array a
ary ->
    let
      !sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
      go :: Int -> b
go Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = b
z
        | (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = a -> b -> b
f a
x (Int -> b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
    in Int -> b
go Int
0
  {-# INLINE foldr #-}
  foldl :: (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = b
z
        | (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = b -> a -> b
f (Int -> b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) a
x
    in Int -> b
go (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  {-# INLINE foldl #-}
  foldr1 :: (a -> a -> a) -> Array a -> a
foldr1 a -> a -> a
f = \ !Array a
ary ->
    let
      !sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      go :: Int -> a
go Int
i =
        case Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
          (# a
x #) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz -> a
x
                  | Bool
otherwise -> a -> a -> a
f a
x (Int -> a
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
    in if Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
       then String -> String -> a
forall a. String -> String -> a
die String
"foldr1" String
"empty array"
       else Int -> a
go Int
0
  {-# INLINE foldr1 #-}
  foldl1 :: (a -> a -> a) -> Array a -> a
foldl1 a -> a -> a
f = \ !Array a
ary ->
    let
      !sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      go :: Int -> a
go Int
i =
        case Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
          (# a
x #) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> a
x
                  | Bool
otherwise -> a -> a -> a
f (Int -> a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) a
x
    in if Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
       then String -> String -> a
forall a. String -> String -> a
die String
"foldl1" String
"empty array"
       else Int -> a
go Int
sz
  {-# INLINE foldl1 #-}
#if MIN_VERSION_base(4,6,0)
  foldr' :: (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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = b
acc
        | (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = Int -> b -> b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (a -> b -> b
f a
x b
acc)
    in Int -> b -> b
go (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b
z
  {-# INLINE foldr' #-}
  foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f = \b
z !Array a
ary ->
    let
      !sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
      go :: Int -> b -> b
go Int
i !b
acc
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = b
acc
        | (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
        = Int -> b -> b
go (Int
iInt -> Int -> Int
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' #-}
#endif
#if MIN_VERSION_base(4,8,0)
  null :: Array a -> Bool
null Array a
a = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  {-# INLINE null #-}
  length :: Array a -> Int
length = Array a -> Int
forall a. Array a -> Int
sizeofArray
  {-# INLINE length #-}
  maximum :: Array a -> a
maximum Array a
ary | Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = String -> String -> a
forall a. String -> String -> a
die String
"maximum" String
"empty array"
              | (# a
frst #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
              = Int -> a -> a
go Int
1 a
frst
   where
     sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
     go :: Int -> a -> a
go Int
i !a
e
       | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
       | (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
       = Int -> a -> a
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
e a
x)
  {-# INLINE maximum #-}
  minimum :: Array a -> a
minimum Array a
ary | Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = String -> String -> a
forall a. String -> String -> a
die String
"minimum" String
"empty array"
              | (# a
frst #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
              = Int -> a -> a
go Int
1 a
frst
   where sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
         go :: Int -> a -> a
go Int
i !a
e
           | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
           | (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
           = Int -> a -> a
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (a -> a -> a
forall a. Ord a => a -> a -> a
min a
e a
x)
  {-# INLINE minimum #-}
  sum :: Array a -> a
sum = (a -> a -> a) -> a -> Array a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
  {-# INLINE sum #-}
  product :: Array a -> a
product = (a -> a -> a) -> a -> Array a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1
  {-# INLINE product #-}
#endif

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

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

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

instance Traversable Array where
  traverse :: (a -> f b) -> Array a -> f (Array b)
traverse a -> f b
f = (a -> f b) -> Array a -> f (Array b)
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 :: (a -> f b) -> Array a -> f (Array b)
traverseArray a -> f b
f = \ !Array a
ary ->
  let
    !len :: Int
len = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
    go :: Int -> f (STA b)
go !Int
i
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = STA b -> f (STA b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STA b -> f (STA b)) -> STA b -> f (STA b)
forall a b. (a -> b) -> a -> b
$ (forall s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA ((forall s. MutableArray# s b -> ST s (Array b)) -> STA b)
-> (forall s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary -> MutableArray (PrimState (ST s)) b -> ST s (Array b)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray (MutableArray# s b -> MutableArray s b
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary)
      | (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
      = (b -> STA b -> STA b) -> f b -> f (STA b) -> f (STA b)
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 s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA ((forall s. MutableArray# s b -> ST s (Array b)) -> STA b)
-> (forall s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary ->
                  MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray (MutableArray# s b -> MutableArray s b
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary) Int
i b
b ST s () -> ST s (Array b) -> ST s (Array b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableArray# s b -> ST s (Array 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  in if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
     then Array b -> f (Array b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Array b
forall a. Array a
emptyArray
     else Int -> STA b -> Array b
forall a. Int -> STA a -> Array a
runSTA Int
len (STA b -> Array b) -> f (STA b) -> f (Array b)
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
 #-}
#if MIN_VERSION_base(4,8,0)
{-# RULES
"traverse/Id" forall (f :: a -> Identity b). traverseArray f =
   (coerce :: (Array a -> Array (Identity b))
           -> Array a -> Identity (Array b)) (fmap f)
 #-}
#endif

-- | 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 :: (a -> m b) -> Array a -> m (Array b)
traverseArrayP a -> m b
f = \ !Array a
ary ->
  let
    !sz :: Int
sz = Array a -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz
      = MutableArray (PrimState m) b -> m (Array b)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) b
mary
      | Bool
otherwise
      = do
          a
a <- Array a -> Int -> m a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
ary Int
i
          b
b <- a -> m b
f a
a
          MutableArray (PrimState m) b -> Int -> b -> m ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MutableArray (PrimState m) b
mary
  in do
    MutableArray (PrimState m) b
mary <- Int -> b -> m (MutableArray (PrimState m) b)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz b
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' :: (a -> b) -> Array a -> Array b
mapArray' a -> b
f Array a
a =
  Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) (String -> String -> b
forall a. String -> String -> a
die String
"mapArray'" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
    let go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a
             = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             | Bool
otherwise
             = do a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad 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
                  MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb Int
i b
y ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
iInt -> Int -> Int
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 :: Int -> [a] -> Array a
arrayFromListN Int
n [a]
l =
  Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
n (String -> String -> a
forall a. String -> String -> a
die String
"fromListN" String
"uninitialized element") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \MutableArray s a
sma ->
    let go :: Int -> [a] -> ST s ()
go !Int
ix [] = if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
          then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          else String -> String -> ST s ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
          then do
            MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
sma Int
ix a
x
            Int -> [a] -> ST s ()
go (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
xs
          else String -> String -> ST s ()
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 :: [a] -> Array a
arrayFromList [a]
l = Int -> [a] -> Array a
forall a. Int -> [a] -> Array a
arrayFromListN ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) [a]
l

#if MIN_VERSION_base(4,7,0)
instance Exts.IsList (Array a) where
  type Item (Array a) = a
  fromListN :: Int -> [Item (Array a)] -> Array a
fromListN = Int -> [Item (Array a)] -> Array a
forall a. Int -> [a] -> Array a
arrayFromListN
  fromList :: [Item (Array a)] -> Array a
fromList = [Item (Array a)] -> Array a
forall a. [a] -> Array a
arrayFromList
  toList :: Array a -> [Item (Array a)]
toList = Array a -> [Item (Array a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
#else
fromListN :: Int -> [a] -> Array a
fromListN = arrayFromListN

fromList :: [a] -> Array a
fromList = arrayFromList
#endif

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

instance Applicative Array where
  pure :: a -> Array a
pure a
x = (forall s. ST s (MutableArray s a)) -> Array a
forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray ((forall s. ST s (MutableArray s a)) -> Array a)
-> (forall s. ST s (MutableArray s a)) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
1 a
x
  Array (a -> b)
ab <*> :: Array (a -> b) -> Array a -> Array b
<*> Array a
a = Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
szabInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sza) (String -> String -> b
forall a. String -> String -> a
die String
"<*>" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
    let go1 :: Int -> ST s ()
go1 Int
i = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
szab) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
            do
              a -> b
f <- Array (a -> b) -> Int -> ST s (a -> b)
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array (a -> b)
ab Int
i
              Int -> (a -> b) -> Int -> ST s ()
go2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sza) a -> b
f Int
0
              Int -> ST s ()
go1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        go2 :: Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f Int
j = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sza) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
            do
              a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
j
              MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb (Int
off Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    in Int -> ST s ()
go1 Int
0
   where szab :: Int
szab = Array (a -> b) -> Int
forall a. Array a -> Int
sizeofArray Array (a -> b)
ab ; sza :: Int
sza = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a
  Array a
a *> :: Array a -> Array b -> Array b
*> Array b
b = Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
szaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
szb) (String -> String -> b
forall a. String -> String -> a
die String
"*>" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
    let go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sza   = MutableArray (PrimState (ST s)) b
-> Int -> Array b -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
szb) Array b
b Int
0 Int
szb
             | Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     in Int -> ST s ()
go Int
0
   where sza :: Int
sza = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a ; szb :: Int
szb = Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
b
  Array a
a <* :: Array a -> Array b -> Array a
<* Array b
b = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
szaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
szb) (String -> String -> a
forall a. String -> String -> a
die String
"<*" String
"impossible") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
szb   = MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) a
e ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> a -> ST s ()
fill Int
off (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
e
                     | Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sza
             = do a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
                  Int -> Int -> a -> ST s ()
fill (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
szb) Int
0 a
x ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
             | Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     in Int -> ST s ()
go Int
0
   where sza :: Int
sza = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a ; szb :: Int
szb = Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
b

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

  Array a
ary >>= :: Array a -> (a -> Array b) -> Array b
>>= a -> Array b
f = Int -> ArrayStack b -> Int -> Array b
collect Int
0 ArrayStack b
forall a. ArrayStack a
EmptyStack (Int
laInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
   where
   la :: Int
la = Array a -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (String -> String -> b
forall a. String -> String -> a
die String
">>=" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ Int -> ArrayStack b -> MutableArray (PrimState (ST s)) b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill Int
0 ArrayStack b
stk
     | (# a
x #) <- Array a -> Int -> (# a #)
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 = Array b -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
       then Int -> ArrayStack b -> Int -> Array b
collect Int
sz ArrayStack b
stk (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
       else Int -> ArrayStack b -> Int -> Array b
collect (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lsb) (Array b -> ArrayStack b -> ArrayStack b
forall a. Array a -> ArrayStack a -> ArrayStack a
PushArray Array b
sb ArrayStack b
stk) (Int
iInt -> Int -> Int
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
_   = () -> m ()
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 = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
sb
     = MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
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)
         m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill (Int
off Int -> Int -> Int
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 :: String -> Array a
fail String
_ = Array a
forall (f :: * -> *) a. Alternative f => f a
empty

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

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

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

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

#if MIN_VERSION_base(4,9,0)
-- | @since 0.6.3.0
instance Semigroup (Array a) where
  <> :: Array a -> Array a -> Array a
(<>) = Array a -> Array a -> Array a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  sconcat :: NonEmpty (Array a) -> Array a
sconcat = [Array a] -> Array a
forall a. Monoid a => [a] -> a
mconcat ([Array a] -> Array a)
-> (NonEmpty (Array a) -> [Array a])
-> NonEmpty (Array a)
-> Array a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Array a) -> [Array a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
#endif

instance Monoid (Array a) where
  mempty :: Array a
mempty = Array a
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 = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (String -> String -> a
forall a. String -> String -> a
die String
"mconcat" String
"impossible") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
    let go :: Int -> [Array a] -> ST s ()
go !Int
_  [    ] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go Int
off (Array a
a:[Array a]
as) =
          MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma Int
off Array a
a Int
0 (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Array a] -> ST s ()
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array a -> Int
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 = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Array a] -> [Int]) -> [Array a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array a -> Int) -> [Array a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array a -> Int
forall a. Array a -> Int
sizeofArray ([Array a] -> Int) -> [Array a] -> Int
forall a b. (a -> b) -> a -> b
$ [Array a]
l

arrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
arrayLiftShowsPrec Int -> a -> String -> String
elemShowsPrec [a] -> String -> String
elemListShowsPrec Int
p Array a
a = Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
  String -> String -> String
showString String
"fromListN " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Show a => a -> String -> String
shows (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" "
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> [a] -> String -> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> [a] -> String -> String
listLiftShowsPrec Int -> a -> String -> String
elemShowsPrec [a] -> String -> String
elemListShowsPrec Int
11 (Array a -> [a]
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 :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> [a] -> String -> String
listLiftShowsPrec Int -> a -> String -> String
_ [a] -> String -> String
sl Int
_ = [a] -> String -> String
sl

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

#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
-- | @since 0.6.4.0
instance Show1 Array where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
  liftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
liftShowsPrec = (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
arrayLiftShowsPrec
#else
  showsPrec1 = arrayLiftShowsPrec showsPrec showList
#endif
#endif

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

#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
-- | @since 0.6.4.0
instance Read1 Array where
#if MIN_VERSION_base(4,10,0)
  liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
liftReadPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec
#elif MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
  liftReadsPrec = arrayLiftReadsPrec
#else
  readsPrec1 = arrayLiftReadsPrec readsPrec readList
#endif
#endif

-- 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 :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec ReadPrec a
_ ReadPrec [a]
read_list = ReadPrec (Array a) -> ReadPrec (Array a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Array a) -> ReadPrec (Array a))
-> ReadPrec (Array a) -> ReadPrec (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Array a) -> ReadPrec (Array a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec (ReadPrec (Array a) -> ReadPrec (Array a))
-> ReadPrec (Array a) -> ReadPrec (Array a)
forall a b. (a -> b) -> a -> b
$ ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP ()
skipSpaces ReadPrec () -> ReadPrec (Array a) -> ReadPrec (Array a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    (([a] -> Array a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Array a) -> ReadPrec [a] -> ReadPrec (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
read_list) ReadPrec (Array a) -> ReadPrec (Array a) -> ReadPrec (Array a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
RdPrc.+++
      do
        Tag
tag <- ReadP Tag -> ReadPrec Tag
forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP Tag
lexTag
        case Tag
tag of
          Tag
FromListTag -> [a] -> Array a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Array a) -> ReadPrec [a] -> ReadPrec (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
read_list
          Tag
FromListNTag -> (Int -> [a] -> Array a)
-> ReadPrec Int -> ReadPrec [a] -> ReadPrec (Array a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int -> [a] -> Array a
forall l. IsList l => Int -> [Item l] -> l
fromListN ReadPrec Int
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
read_list)
   where
     app_prec :: Int
app_prec = Int
10

data Tag = FromListTag | FromListNTag

-- Why don't we just use lexP? The general problem with lexP is that
-- it doesn't always fail as fast as we might like. It will
-- happily read to the end of an absurdly long lexeme (e.g., a 200MB string
-- literal) before returning, at which point we'll immediately discard
-- the result because it's not an identifier. Doing the job ourselves, we
-- can see very quickly when we've run into a problem. We should also get
-- a slight efficiency boost by going through the string just once.
lexTag :: ReadP Tag
lexTag :: ReadP Tag
lexTag = do
  String
_ <- String -> ReadP String
string String
"fromList"
  String
s <- ReadP String
look
  case String
s of
    Char
'N':Char
c:String
_
      | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
      -> String -> ReadP Tag
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"" -- We have fromListN3 or similar
      | Bool
otherwise -> Tag
FromListNTag Tag -> ReadP Char -> ReadP Tag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP Char
get -- Skip the 'N'
    String
_ -> Tag -> ReadP Tag
forall (m :: * -> *) a. Monad m => a -> m a
return Tag
FromListTag

#if !MIN_VERSION_base(4,10,0)
arrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Array a)
arrayLiftReadsPrec reads_prec list_reads_prec = RdPrc.readPrec_to_S $
  arrayLiftReadPrec (RdPrc.readS_to_Prec reads_prec) (RdPrc.readS_to_Prec (const list_reads_prec))
#endif


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 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 -> c ([a] -> Array a) -> c (Array a)
forall b r. Data b => c (b -> r) -> c r
k (([a] -> Array a) -> c ([a] -> Array a)
forall r. r -> c r
z [a] -> Array a
forall l. IsList l => [Item l] -> l
fromList)
    Int
_ -> String -> c (Array a)
forall a. HasCallStack => String -> a
error String
"gunfold"
  gfoldl :: (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 = ([a] -> Array a) -> c ([a] -> Array a)
forall g. g -> c g
z [a] -> Array a
forall l. IsList l => [Item l] -> l
fromList c ([a] -> Array a) -> [a] -> c (Array a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` Array a -> [a]
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
_ = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
  gunfold :: (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
_ = String -> Constr -> c (MutableArray s a)
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"