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

-- |
-- Module : Data.Primitive.SmallArray
-- Copyright: (c) 2015 Dan Doel
-- License: BSD3
--
-- Maintainer: libraries@haskell.org
-- Portability: non-portable
--
-- Small arrays are boxed (im)mutable arrays.
--
-- The underlying structure of the 'Array' type contains a card table, allowing
-- segments of the array to be marked as having been mutated. This allows the
-- garbage collector to only re-traverse segments of the array that have been
-- marked during certain phases, rather than having to traverse the entire
-- array.
--
-- 'SmallArray' lacks this table. This means that it takes up less memory and
-- has slightly faster writes. It is also more efficient during garbage
-- collection so long as the card table would have a single entry covering the
-- entire array. These advantages make them suitable for use as arrays that are
-- known to be small.
--
-- The card size is 128, so for uses much larger than that, 'Array' would likely
-- be superior.
--
-- The underlying type, 'SmallArray#', was introduced in GHC 7.10, so prior to
-- that version, this module simply implements small arrays as 'Array'.

module Data.Primitive.SmallArray
  ( SmallArray(..)
  , SmallMutableArray(..)
  , newSmallArray
  , readSmallArray
  , writeSmallArray
  , copySmallArray
  , copySmallMutableArray
  , indexSmallArray
  , indexSmallArrayM
  , indexSmallArray##
  , cloneSmallArray
  , cloneSmallMutableArray
  , freezeSmallArray
  , unsafeFreezeSmallArray
  , thawSmallArray
  , runSmallArray
  , unsafeThawSmallArray
  , sizeofSmallArray
  , sizeofSmallMutableArray
#if MIN_VERSION_base(4,14,0)
  , shrinkSmallMutableArray
#endif
  , smallArrayFromList
  , smallArrayFromListN
  , mapSmallArray'
  , traverseSmallArrayP
  ) where


#if (__GLASGOW_HASKELL__ >= 710)
#define HAVE_SMALL_ARRAY 1
#endif

#if MIN_VERSION_base(4,7,0)
import GHC.Exts hiding (toList)
import qualified GHC.Exts
#endif

import Control.Applicative
import Control.DeepSeq
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.Primitive
import Control.Monad.ST
import Control.Monad.Zip
import Data.Data
import Data.Foldable as Foldable
import Data.Functor.Identity
#if !(MIN_VERSION_base(4,10,0))
import Data.Monoid
#endif
#if MIN_VERSION_base(4,9,0)
import qualified GHC.ST as GHCST
import qualified Data.Semigroup as Sem
#endif
import Text.ParserCombinators.ReadP
#if MIN_VERSION_base(4,10,0)
import GHC.Exts (runRW#)
#elif MIN_VERSION_base(4,9,0)
import GHC.Base (runRW#)
#endif

#if !(HAVE_SMALL_ARRAY)
import Data.Primitive.Array
import Data.Traversable
import qualified Data.Primitive.Array as Array
#endif

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

#if HAVE_SMALL_ARRAY
data SmallArray a = SmallArray (SmallArray# a)
  deriving Typeable
#else
newtype SmallArray a = SmallArray (Array a) deriving
  ( Eq
  , Ord
  , Show
  , Read
  , Foldable
  , Traversable
  , Functor
  , Applicative
  , Alternative
  , Monad
  , MonadPlus
  , MonadZip
  , MonadFix
  , Monoid
  , NFData
#if MIN_VERSION_deepseq(1,4,3)
  , NFData1
#endif
  , Typeable
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
  , Eq1
  , Ord1
  , Show1
  , Read1
#endif
  )

#if MIN_VERSION_base(4,7,0)
instance IsList (SmallArray a) where
  type Item (SmallArray a) = a
  fromListN n l = SmallArray (fromListN n l)
  fromList l = SmallArray (fromList l)
  toList a = Foldable.toList a
#endif
#endif

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

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

#if HAVE_SMALL_ARRAY
data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)
  deriving Typeable
#else
newtype SmallMutableArray s a = SmallMutableArray (MutableArray s a)
  deriving (Eq, Typeable)
#endif

-- | Create a new small mutable array.
--
-- /Note:/ this function does not check if the input is non-negative.
newSmallArray
  :: PrimMonad m
  => Int -- ^ size
  -> a   -- ^ initial contents
  -> m (SmallMutableArray (PrimState m) a)
#if HAVE_SMALL_ARRAY
newSmallArray :: Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (I# Int#
i#) a
x = (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s ->
  case Int#
-> a
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
i# a
x State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
sma# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
#else
newSmallArray n e = SmallMutableArray `liftM` newArray n e
#endif
{-# INLINE newSmallArray #-}

-- | Read the element at a given index in a mutable array.
--
-- /Note:/ this function does not do bounds checking.
readSmallArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ array
  -> Int                               -- ^ index
  -> m a
#if HAVE_SMALL_ARRAY
readSmallArray :: SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (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 ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ SmallMutableArray# (PrimState m) a
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i#
#else
readSmallArray (SmallMutableArray a) = readArray a
#endif
{-# INLINE readSmallArray #-}

-- | Write an element at the given idex in a mutable array.
--
-- /Note:/ this function does not do bounds checking.
writeSmallArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ array
  -> Int                               -- ^ index
  -> a                                 -- ^ new element
  -> m ()
#if HAVE_SMALL_ARRAY
writeSmallArray :: SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) a
x =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState m) -> State# (PrimState m)) -> m ())
-> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray# (PrimState m) a
-> Int# -> a -> State# (PrimState m) -> State# (PrimState m)
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i# a
x
#else
writeSmallArray (SmallMutableArray a) = writeArray a
#endif
{-# INLINE writeSmallArray #-}

-- | Look up an element in an immutable array.
--
-- The purpose of returning a result using a monad is to allow the caller to
-- avoid retaining references to the array. Evaluating the return value will
-- cause the array lookup to be performed, even though it may not require the
-- element of the array to be evaluated (which could throw an exception). For
-- instance:
--
-- > data Box a = Box a
-- > ...
-- >
-- > f sa = case indexSmallArrayM sa 0 of
-- >   Box x -> ...
--
-- 'x' is not a closure that references 'sa' as it would be if we instead
-- wrote:
--
-- > let x = indexSmallArray sa 0
--
-- And does not prevent 'sa' from being garbage collected.
--
-- Note that 'Identity' is not adequate for this use, as it is a newtype, and
-- cannot be evaluated without evaluating the element.
--
-- /Note:/ this function does not do bounds checking.
indexSmallArrayM
  :: Monad m
  => SmallArray a -- ^ array
  -> Int          -- ^ index
  -> m a
#if HAVE_SMALL_ARRAY
indexSmallArrayM :: SmallArray a -> Int -> m a
indexSmallArrayM (SmallArray SmallArray# a
sa#) (I# Int#
i#) =
  case SmallArray# a -> Int# -> (# a #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# a
sa# Int#
i# of
    (# a
x #) -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
#else
indexSmallArrayM (SmallArray a) = indexArrayM a
#endif
{-# INLINE indexSmallArrayM #-}

-- | Look up an element in an immutable array.
--
-- /Note:/ this function does not do bounds checking.
indexSmallArray
  :: SmallArray a -- ^ array
  -> Int          -- ^ index
  -> a
#if HAVE_SMALL_ARRAY
indexSmallArray :: SmallArray a -> Int -> a
indexSmallArray SmallArray a
sa Int
i = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ SmallArray a -> Int -> Identity a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
#else
indexSmallArray (SmallArray a) = indexArray a
#endif
{-# INLINE indexSmallArray #-}

-- | 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.
indexSmallArray## :: SmallArray a -> Int -> (# a #)
#if HAVE_SMALL_ARRAY
indexSmallArray## :: SmallArray a -> Int -> (# a #)
indexSmallArray## (SmallArray SmallArray# a
ary) (I# Int#
i) = SmallArray# a -> Int# -> (# a #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# a
ary Int#
i
#else
indexSmallArray## (SmallArray a) = indexArray## a
#endif
{-# INLINE indexSmallArray## #-}

-- | Create a copy of a slice of an immutable array.
--
-- /Note:/ The provided Array should contain the full subrange
-- specified by the two Ints, but this is not checked.
cloneSmallArray
  :: SmallArray a -- ^ source
  -> Int          -- ^ offset
  -> Int          -- ^ length
  -> SmallArray a
#if HAVE_SMALL_ARRAY
cloneSmallArray :: SmallArray a -> Int -> Int -> SmallArray a
cloneSmallArray (SmallArray SmallArray# a
sa#) (I# Int#
i#) (I# Int#
j#) =
  SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray (SmallArray# a -> Int# -> Int# -> SmallArray# a
forall a. SmallArray# a -> Int# -> Int# -> SmallArray# a
cloneSmallArray# SmallArray# a
sa# Int#
i# Int#
j#)
#else
cloneSmallArray (SmallArray a) i j = SmallArray $ cloneArray a i j
#endif
{-# INLINE cloneSmallArray #-}

-- | Create a copy of a slice of a mutable array.
--
-- /Note:/ The provided Array should contain the full subrange
-- specified by the two Ints, but this is not checked.
cloneSmallMutableArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ source
  -> Int                               -- ^ offset
  -> Int                               -- ^ length
  -> m (SmallMutableArray (PrimState m) a)
#if HAVE_SMALL_ARRAY
cloneSmallMutableArray :: SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
o#) (I# Int#
l#) =
  (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall d a.
SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
cloneSmallMutableArray# SmallMutableArray# (PrimState m) a
sma# Int#
o# Int#
l# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
smb# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
smb# #)
#else
cloneSmallMutableArray (SmallMutableArray ma) i j =
  SmallMutableArray `liftM` cloneMutableArray ma i j
#endif
{-# INLINE cloneSmallMutableArray #-}

-- | Create an immutable array corresponding to a slice of a mutable array.
--
-- This operation copies the portion of the array to be frozen.
freezeSmallArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ source
  -> Int                               -- ^ offset
  -> Int                               -- ^ length
  -> m (SmallArray a)
#if HAVE_SMALL_ARRAY
freezeSmallArray :: SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)
freezeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) (I# Int#
j#) =
  (State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
 -> m (SmallArray a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallArray# a #)
forall d a.
SmallMutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, SmallArray# a #)
freezeSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i# Int#
j# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallArray# a
sa# #) -> (# State# (PrimState m)
s', SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
sa# #)
#else
freezeSmallArray (SmallMutableArray ma) i j =
  SmallArray `liftM` freezeArray ma i j
#endif
{-# INLINE freezeSmallArray #-}

-- | Render a mutable array immutable.
--
-- This operation performs no copying, so care must be taken not to modify the
-- input array after freezing.
unsafeFreezeSmallArray
  :: PrimMonad m => SmallMutableArray (PrimState m) a -> m (SmallArray a)
#if HAVE_SMALL_ARRAY
unsafeFreezeSmallArray :: SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) =
  (State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
 -> m (SmallArray a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) a
-> State# (PrimState m)
-> (# State# (PrimState m), SmallArray# a #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# SmallMutableArray# (PrimState m) a
sma# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallArray# a
sa# #) -> (# State# (PrimState m)
s', SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
sa# #)
#else
unsafeFreezeSmallArray (SmallMutableArray ma) =
  SmallArray `liftM` unsafeFreezeArray ma
#endif
{-# INLINE unsafeFreezeSmallArray #-}

-- | Create a mutable array corresponding to a slice of an immutable array.
--
-- This operation copies the portion of the array to be thawed.
thawSmallArray
  :: PrimMonad m
  => SmallArray a -- ^ source
  -> Int          -- ^ offset
  -> Int          -- ^ length
  -> m (SmallMutableArray (PrimState m) a)
#if HAVE_SMALL_ARRAY
thawSmallArray :: SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray (SmallArray SmallArray# a
sa#) (I# Int#
o#) (I# Int#
l#) =
  (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallArray# a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall a d.
SmallArray# a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
thawSmallArray# SmallArray# a
sa# Int#
o# Int#
l# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
sma# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
#else
thawSmallArray (SmallArray a) off len =
  SmallMutableArray `liftM` thawArray a off len
#endif
{-# INLINE thawSmallArray #-}

-- | Render an immutable array mutable.
--
-- This operation performs no copying, so care must be taken with its use.
unsafeThawSmallArray
  :: PrimMonad m => SmallArray a -> m (SmallMutableArray (PrimState m) a)
#if HAVE_SMALL_ARRAY
unsafeThawSmallArray :: SmallArray a -> m (SmallMutableArray (PrimState m) a)
unsafeThawSmallArray (SmallArray SmallArray# a
sa#) =
  (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallArray# a
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall a d.
SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
unsafeThawSmallArray# SmallArray# a
sa# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
sma# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
#else
unsafeThawSmallArray (SmallArray a) = SmallMutableArray `liftM` unsafeThawArray a
#endif
{-# INLINE unsafeThawSmallArray #-}

-- | Copy a slice of an immutable array into a mutable array.
--
-- /Note:/ this function does not do bounds or overlap checking.
copySmallArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ destination
  -> Int                               -- ^ destination offset
  -> SmallArray a                      -- ^ source
  -> Int                               -- ^ source offset
  -> Int                               -- ^ length
  -> m ()
#if HAVE_SMALL_ARRAY
copySmallArray :: SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray
  (SmallMutableArray SmallMutableArray# (PrimState m) a
dst#) (I# Int#
do#) (SmallArray SmallArray# a
src#) (I# Int#
so#) (I# Int#
l#) =
    (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState m) -> State# (PrimState m)) -> m ())
-> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall a b. (a -> b) -> a -> b
$ SmallArray# a
-> Int#
-> SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall a d.
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# a
src# Int#
so# SmallMutableArray# (PrimState m) a
dst# Int#
do# Int#
l#
#else
copySmallArray (SmallMutableArray dst) i (SmallArray src) = copyArray dst i src
#endif
{-# INLINE copySmallArray #-}

-- | Copy a slice of one mutable array into another.
--
-- /Note:/ this function does not do bounds or overlap checking.
copySmallMutableArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ destination
  -> Int                               -- ^ destination offset
  -> SmallMutableArray (PrimState m) a -- ^ source
  -> Int                               -- ^ source offset
  -> Int                               -- ^ length
  -> m ()
#if HAVE_SMALL_ARRAY
copySmallMutableArray :: SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray
  (SmallMutableArray SmallMutableArray# (PrimState m) a
dst#) (I# Int#
do#)
  (SmallMutableArray SmallMutableArray# (PrimState m) a
src#) (I# Int#
so#)
  (I# Int#
l#) =
    (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState m) -> State# (PrimState m)) -> m ())
-> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray# (PrimState m) a
-> Int#
-> SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d a.
SmallMutableArray# d a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallMutableArray# SmallMutableArray# (PrimState m) a
src# Int#
so# SmallMutableArray# (PrimState m) a
dst# Int#
do# Int#
l#
#else
copySmallMutableArray (SmallMutableArray dst) i (SmallMutableArray src) =
  copyMutableArray dst i src
#endif
{-# INLINE copySmallMutableArray #-}

sizeofSmallArray :: SmallArray a -> Int
#if HAVE_SMALL_ARRAY
sizeofSmallArray :: SmallArray a -> Int
sizeofSmallArray (SmallArray SmallArray# a
sa#) = Int# -> Int
I# (SmallArray# a -> Int#
forall a. SmallArray# a -> Int#
sizeofSmallArray# SmallArray# a
sa#)
#else
sizeofSmallArray (SmallArray a) = sizeofArray a
#endif
{-# INLINE sizeofSmallArray #-}

sizeofSmallMutableArray :: SmallMutableArray s a -> Int
#if HAVE_SMALL_ARRAY
sizeofSmallMutableArray :: SmallMutableArray s a -> Int
sizeofSmallMutableArray (SmallMutableArray SmallMutableArray# s a
sa#) =
  Int# -> Int
I# (SmallMutableArray# s a -> Int#
forall d a. SmallMutableArray# d a -> Int#
sizeofSmallMutableArray# SmallMutableArray# s a
sa#)
#else
sizeofSmallMutableArray (SmallMutableArray ma) = sizeofMutableArray ma
#endif
{-# INLINE sizeofSmallMutableArray #-}

-- | 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.
traverseSmallArrayP
  :: PrimMonad m
  => (a -> m b)
  -> SmallArray a
  -> m (SmallArray b)
#if HAVE_SMALL_ARRAY
traverseSmallArrayP :: (a -> m b) -> SmallArray a -> m (SmallArray b)
traverseSmallArrayP a -> m b
f = \ !SmallArray a
ary ->
  let
    !sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
ary
    go :: Int -> SmallMutableArray (PrimState m) b -> m (SmallArray b)
go !Int
i !SmallMutableArray (PrimState m) b
mary
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz
      = SmallMutableArray (PrimState m) b -> m (SmallArray b)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray (PrimState m) b
mary
      | Bool
otherwise
      = do
          a
a <- SmallArray a -> Int -> m a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
ary Int
i
          b
b <- a -> m b
f a
a
          SmallMutableArray (PrimState m) b -> Int -> b -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray (PrimState m) b
mary Int
i b
b
          Int -> SmallMutableArray (PrimState m) b -> m (SmallArray b)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SmallMutableArray (PrimState m) b
mary
  in do
    SmallMutableArray (PrimState m) b
mary <- Int -> b -> m (SmallMutableArray (PrimState m) b)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
sz b
forall a. a
badTraverseValue
    Int -> SmallMutableArray (PrimState m) b -> m (SmallArray b)
go Int
0 SmallMutableArray (PrimState m) b
mary
#else
traverseSmallArrayP f (SmallArray ar) = SmallArray `liftM` traverseArrayP f ar
#endif
{-# INLINE traverseSmallArrayP #-}

-- | Strict map over the elements of the array.
mapSmallArray' :: (a -> b) -> SmallArray a -> SmallArray b
#if HAVE_SMALL_ARRAY
mapSmallArray' :: (a -> b) -> SmallArray a -> SmallArray b
mapSmallArray' a -> b
f SmallArray a
sa = Int
-> b
-> (forall s. SmallMutableArray s b -> ST s ())
-> SmallArray b
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) (String -> String -> b
forall a. String -> String -> a
die String
"mapSmallArray'" String
"impossible") ((forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b)
-> (forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s b
smb ->
  ((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ()
forall a. (a -> a) -> a
fix (((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ())
-> Int -> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
? Int
0 (((Int -> ST s ()) -> Int -> ST s ()) -> ST s ())
-> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int -> ST s ()
go 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
< SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
      a
x <- SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
      let !y :: b
y = a -> b
f a
x
      SmallMutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s b
SmallMutableArray (PrimState (ST s)) b
smb Int
i b
y ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
#else
mapSmallArray' f (SmallArray ar) = SmallArray (mapArray' f ar)
#endif
{-# INLINE mapSmallArray' #-}

#ifndef HAVE_SMALL_ARRAY
runSmallArray
  :: (forall s. ST s (SmallMutableArray s a))
  -> SmallArray a
runSmallArray m = SmallArray $ runArray $
  m >>= \(SmallMutableArray mary) -> return mary

#elif !MIN_VERSION_base(4,9,0)
runSmallArray
  :: (forall s. ST s (SmallMutableArray s a))
  -> SmallArray a
runSmallArray m = runST $ m >>= unsafeFreezeSmallArray

#else
-- 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.
runSmallArray
  :: (forall s. ST s (SmallMutableArray s a))
  -> SmallArray a
runSmallArray :: (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray forall s. ST s (SmallMutableArray s a)
m = SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray ((forall s. ST s (SmallMutableArray s a)) -> SmallArray# a
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray# a
runSmallArray# forall s. ST s (SmallMutableArray s a)
m)

runSmallArray#
  :: (forall s. ST s (SmallMutableArray s a))
  -> SmallArray# a
runSmallArray# :: (forall s. ST s (SmallMutableArray s a)) -> SmallArray# a
runSmallArray# forall s. ST s (SmallMutableArray s a)
m = case (State# RealWorld -> (# State# RealWorld, SmallArray# a #))
-> (# State# RealWorld, SmallArray# a #)
forall o. (State# RealWorld -> o) -> o
runRW# ((State# RealWorld -> (# State# RealWorld, SmallArray# a #))
 -> (# State# RealWorld, SmallArray# a #))
-> (State# RealWorld -> (# State# RealWorld, SmallArray# a #))
-> (# State# RealWorld, SmallArray# a #)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case ST RealWorld (SmallMutableArray RealWorld a)
-> State# RealWorld
-> (# State# RealWorld, SmallMutableArray RealWorld a #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST ST RealWorld (SmallMutableArray RealWorld a)
forall s. ST s (SmallMutableArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', SmallMutableArray SmallMutableArray# RealWorld a
mary# #) ->
  SmallMutableArray# RealWorld a
-> State# RealWorld -> (# State# RealWorld, SmallArray# a #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# SmallMutableArray# RealWorld a
mary# State# RealWorld
s'} of (# State# RealWorld
_, SmallArray# a
ary# #) -> SmallArray# 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

#endif

#if HAVE_SMALL_ARRAY
-- See the comment on runSmallArray for why we use emptySmallArray#.
createSmallArray
  :: Int
  -> a
  -> (forall s. SmallMutableArray s a -> ST s ())
  -> SmallArray a
createSmallArray :: Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
0 a
_ forall s. SmallMutableArray s a -> ST s ()
_ = SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray ((# #) -> SmallArray# a
forall a. (# #) -> SmallArray# a
emptySmallArray# (# #))
createSmallArray Int
n a
x forall s. SmallMutableArray s a -> ST s ()
f = (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray ((forall s. ST s (SmallMutableArray s a)) -> SmallArray a)
-> (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ do
  SmallMutableArray s a
mary <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n a
x
  SmallMutableArray s a -> ST s ()
forall s. SmallMutableArray s a -> ST s ()
f SmallMutableArray s a
mary
  SmallMutableArray s a -> ST s (SmallMutableArray s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallMutableArray s a
mary

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

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.SmallArray." 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

emptySmallArray :: SmallArray a
emptySmallArray :: SmallArray a
emptySmallArray =
  (forall s. ST s (SmallArray a)) -> SmallArray a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SmallArray a)) -> SmallArray a)
-> (forall s. ST s (SmallArray a)) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
0 (String -> String -> a
forall a. String -> String -> a
die String
"emptySmallArray" String
"impossible")
            ST s (SmallMutableArray s a)
-> (SmallMutableArray s a -> ST s (SmallArray a))
-> ST s (SmallArray a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SmallMutableArray s a -> ST s (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray
{-# NOINLINE emptySmallArray #-}


infixl 1 ?
(?) :: (a -> b -> c) -> (b -> a -> c)
? :: (a -> b -> c) -> b -> a -> c
(?) = (a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE (?) #-}

noOp :: a -> ST s ()
noOp :: a -> ST s ()
noOp = ST s () -> a -> ST s ()
forall a b. a -> b -> a
const (ST s () -> a -> ST s ()) -> ST s () -> a -> ST s ()
forall a b. (a -> b) -> a -> b
$ () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

smallArrayLiftEq :: (a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq :: (a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq a -> b -> Bool
p SmallArray a
sa1 SmallArray b
sa2 = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
sa2 Bool -> Bool -> Bool
&& Int -> Bool
loop (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa1 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
x #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
sa1 Int
i
    , (# b
y #) <- SmallArray b -> Int -> (# b #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray b
sa2 Int
i
    = a -> b -> Bool
p a
x b
y Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

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

instance Eq a => Eq (SmallArray a) where
  SmallArray a
sa1 == :: SmallArray a -> SmallArray a -> Bool
== SmallArray a
sa2 = (a -> a -> Bool) -> SmallArray a -> SmallArray a -> Bool
forall a b.
(a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) SmallArray a
sa1 SmallArray a
sa2

instance Eq (SmallMutableArray s a) where
  SmallMutableArray SmallMutableArray# s a
sma1# == :: SmallMutableArray s a -> SmallMutableArray s a -> Bool
== SmallMutableArray SmallMutableArray# s a
sma2# =
    Int# -> Bool
isTrue# (SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
forall d a.
SmallMutableArray# d a -> SmallMutableArray# d a -> Int#
sameSmallMutableArray# SmallMutableArray# s a
sma1# SmallMutableArray# s a
sma2#)

smallArrayLiftCompare :: (a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare :: (a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare a -> b -> Ordering
elemCompare SmallArray a
a1 SmallArray b
a2 = Int -> Ordering
loop Int
0
  where
  mn :: Int
mn = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
a1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
a2
  loop :: Int -> Ordering
loop Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mn
    , (# a
x1 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
a1 Int
i
    , (# b
x2 #) <- SmallArray b -> Int -> (# b #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
a1) (SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
a2)

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

-- | Lexicographic ordering. Subject to change between major versions.
instance Ord a => Ord (SmallArray a) where
  compare :: SmallArray a -> SmallArray a -> Ordering
compare SmallArray a
sa1 SmallArray a
sa2 = (a -> a -> Ordering) -> SmallArray a -> SmallArray a -> Ordering
forall a b.
(a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SmallArray a
sa1 SmallArray a
sa2

instance Foldable SmallArray 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 -> SmallArray a -> b
foldr a -> b -> b
f = \b
z !SmallArray a
ary ->
    let
      !sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray 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 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 -> SmallArray a -> b
foldl b -> a -> b
f = \b
z !SmallArray 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 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 (SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  {-# INLINE foldl #-}
  foldr1 :: (a -> a -> a) -> SmallArray a -> a
foldr1 a -> a -> a
f = \ !SmallArray a
ary ->
    let
      !sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      go :: Int -> a
go Int
i =
        case SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 SmallArray"
       else Int -> a
go Int
0
  {-# INLINE foldr1 #-}
  foldl1 :: (a -> a -> a) -> SmallArray a -> a
foldl1 a -> a -> a
f = \ !SmallArray a
ary ->
    let
      !sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      go :: Int -> a
go Int
i =
        case SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 SmallArray"
       else Int -> a
go Int
sz
  {-# INLINE foldl1 #-}
  foldr' :: (a -> b -> b) -> b -> SmallArray a -> b
foldr' a -> b -> b
f = \b
z !SmallArray 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 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 (SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b
z
  {-# INLINE foldr' #-}
  foldl' :: (b -> a -> b) -> b -> SmallArray a -> b
foldl' b -> a -> b
f = \b
z !SmallArray a
ary ->
    let
      !sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray 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 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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' #-}
  null :: SmallArray a -> Bool
null SmallArray a
a = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  {-# INLINE null #-}
  length :: SmallArray a -> Int
length = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray
  {-# INLINE length #-}
  maximum :: SmallArray a -> a
maximum SmallArray 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 SmallArray"
              | (# a
frst #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
ary Int
0
              = Int -> a -> a
go Int
1 a
frst
   where
     sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray 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 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 :: SmallArray a -> a
minimum SmallArray 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 SmallArray"
              | (# a
frst #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
ary Int
0
              = Int -> a -> a
go Int
1 a
frst
   where sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray 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 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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 :: SmallArray a -> a
sum = (a -> a -> a) -> a -> SmallArray 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 :: SmallArray a -> a
product = (a -> a -> a) -> a -> SmallArray 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 #-}

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

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

newSmallArray_ :: Int -> ST s (SmallMutableArray s a)
newSmallArray_ :: Int -> ST s (SmallMutableArray s a)
newSmallArray_ !Int
n = Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray 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 SmallArray where
  traverse :: (a -> f b) -> SmallArray a -> f (SmallArray b)
traverse a -> f b
f = (a -> f b) -> SmallArray a -> f (SmallArray b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SmallArray a -> f (SmallArray b)
traverseSmallArray a -> f b
f
  {-# INLINE traverse #-}

traverseSmallArray
  :: Applicative f
  => (a -> f b) -> SmallArray a -> f (SmallArray b)
traverseSmallArray :: (a -> f b) -> SmallArray a -> f (SmallArray b)
traverseSmallArray a -> f b
f = \ !SmallArray a
ary ->
  let
    !len :: Int
len = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray 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. SmallMutableArray# s b -> ST s (SmallArray b)) -> STA b
forall a.
(forall s. SmallMutableArray# s a -> ST s (SmallArray a)) -> STA a
STA ((forall s. SmallMutableArray# s b -> ST s (SmallArray b))
 -> STA b)
-> (forall s. SmallMutableArray# s b -> ST s (SmallArray b))
-> STA b
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary -> SmallMutableArray (PrimState (ST s)) b -> ST s (SmallArray b)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray (SmallMutableArray# s b -> SmallMutableArray s b
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# s b
mary)
      | (# a
x #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray 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. SmallMutableArray# s b -> ST s (SmallArray b)
m) -> (forall s. SmallMutableArray# s b -> ST s (SmallArray b)) -> STA b
forall a.
(forall s. SmallMutableArray# s a -> ST s (SmallArray a)) -> STA a
STA ((forall s. SmallMutableArray# s b -> ST s (SmallArray b))
 -> STA b)
-> (forall s. SmallMutableArray# s b -> ST s (SmallArray b))
-> STA b
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary ->
                  SmallMutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray (SmallMutableArray# s b -> SmallMutableArray s b
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# s b
mary) Int
i b
b ST s () -> ST s (SmallArray b) -> ST s (SmallArray b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SmallMutableArray# s b -> ST s (SmallArray b)
forall s. SmallMutableArray# s b -> ST s (SmallArray b)
m SmallMutableArray# 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 SmallArray b -> f (SmallArray b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallArray b
forall a. SmallArray a
emptySmallArray
     else Int -> STA b -> SmallArray b
forall a. Int -> STA a -> SmallArray a
runSTA Int
len (STA b -> SmallArray b) -> f (STA b) -> f (SmallArray b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f (STA b)
go Int
0
{-# INLINE [1] traverseSmallArray #-}

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


instance Functor SmallArray where
  fmap :: (a -> b) -> SmallArray a -> SmallArray b
fmap a -> b
f SmallArray a
sa = Int
-> b
-> (forall s. SmallMutableArray s b -> ST s ())
-> SmallArray b
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) (String -> String -> b
forall a. String -> String -> a
die String
"fmap" String
"impossible") ((forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b)
-> (forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s b
smb ->
    ((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ()
forall a. (a -> a) -> a
fix (((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ())
-> Int -> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
? Int
0 (((Int -> ST s ()) -> Int -> ST s ()) -> ST s ())
-> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int -> ST s ()
go 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
< SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
        a
x <- SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
        SmallMutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s b
SmallMutableArray (PrimState (ST s)) b
smb Int
i (a -> b
f a
x) ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  {-# INLINE fmap #-}

  a
x <$ :: a -> SmallArray b -> SmallArray a
<$ SmallArray b
sa = Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
sa) a
x forall s. SmallMutableArray s a -> ST s ()
forall a s. a -> ST s ()
noOp

instance Applicative SmallArray where
  pure :: a -> SmallArray a
pure a
x = Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
1 a
x forall s. SmallMutableArray s a -> ST s ()
forall a s. a -> ST s ()
noOp

  SmallArray a
sa *> :: SmallArray a -> SmallArray b -> SmallArray b
*> SmallArray b
sb = Int
-> b
-> (forall s. SmallMutableArray s b -> ST s ())
-> SmallArray b
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (Int
laInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lb) (String -> String -> b
forall a. String -> String -> a
die String
"*>" String
"impossible") ((forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b)
-> (forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s b
smb ->
    ((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ()
forall a. (a -> a) -> a
fix (((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ())
-> Int -> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
? Int
0 (((Int -> ST s ()) -> Int -> ST s ()) -> ST s ())
-> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int -> ST s ()
go 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
la) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
        SmallMutableArray (PrimState (ST s)) b
-> Int -> SmallArray b -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s b
SmallMutableArray (PrimState (ST s)) b
smb Int
0 SmallArray b
sb Int
0 Int
lb ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
   where
   la :: Int
la = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa ; lb :: Int
lb = SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
sb

  SmallArray a
a <* :: SmallArray a -> SmallArray b -> SmallArray a
<* SmallArray b
b = Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (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. SmallMutableArray s a -> ST s ()) -> SmallArray a)
-> (forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s a
ma ->
    let fill :: Int -> Int -> a -> ST s ()
fill Int
off Int
i a
e = 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
szb) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
                         SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (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
        go :: Int -> ST s ()
go 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
sza) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
                 a
x <- SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray 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
                 Int -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
     in Int -> ST s ()
go Int
0
   where sza :: Int
sza = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
a ; szb :: Int
szb = SmallArray b -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray b
b

  SmallArray (a -> b)
ab <*> :: SmallArray (a -> b) -> SmallArray a -> SmallArray b
<*> SmallArray a
a = Int
-> b
-> (forall s. SmallMutableArray s b -> ST s ())
-> SmallArray b
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (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. SmallMutableArray s b -> ST s ()) -> SmallArray b)
-> (forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray 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 <- SmallArray (a -> b) -> Int -> ST s (a -> b)
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray (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 <- SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
a Int
j
              SmallMutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s b
SmallMutableArray (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 = SmallArray (a -> b) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (a -> b)
ab ; sza :: Int
sza = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
a

instance Alternative SmallArray where
  empty :: SmallArray a
empty = SmallArray a
forall a. SmallArray a
emptySmallArray

  SmallArray a
sl <|> :: SmallArray a -> SmallArray a -> SmallArray a
<|> SmallArray a
sr =
    Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sr) (String -> String -> a
forall a. String -> String -> a
die String
"<|>" String
"impossible") ((forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a)
-> (forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s a
sma ->
      SmallMutableArray (PrimState (ST s)) a
-> Int -> SmallArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
sma Int
0 SmallArray a
sl Int
0 (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sl)
        ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SmallMutableArray (PrimState (ST s)) a
-> Int -> SmallArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
sma (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sl) SmallArray a
sr Int
0 (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sr)

  many :: SmallArray a -> SmallArray [a]
many SmallArray a
sa | SmallArray a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null SmallArray a
sa   = [a] -> SmallArray [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          | Bool
otherwise = String -> String -> SmallArray [a]
forall a. String -> String -> a
die String
"many" String
"infinite arrays are not well defined"

  some :: SmallArray a -> SmallArray [a]
some SmallArray a
sa | SmallArray a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null SmallArray a
sa   = SmallArray [a]
forall a. SmallArray a
emptySmallArray
          | Bool
otherwise = String -> String -> SmallArray [a]
forall a. String -> String -> a
die String
"some" String
"infinite arrays are not well defined"

data ArrayStack a
  = PushArray !(SmallArray a) !(ArrayStack a)
  | EmptyStack
-- TODO: This isn't terribly efficient. It would be better to wrap
-- ArrayStack with a type like
--
-- data NES s a = NES !Int !(SmallMutableArray s a) !(ArrayStack a)
--
-- We'd copy incoming arrays into the mutable array until we would
-- overflow it. Then we'd freeze it, push it on the stack, and continue.
-- Any sufficiently large incoming arrays would go straight on the stack.
-- Such a scheme would make the stack much more compact in the case
-- of many small arrays.

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

  SmallArray a
sa >>= :: SmallArray a -> (a -> SmallArray b) -> SmallArray b
>>= a -> SmallArray b
f = Int -> ArrayStack b -> Int -> SmallArray 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 = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa
   collect :: Int -> ArrayStack b -> Int -> SmallArray 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. SmallMutableArray s b -> ST s ())
-> SmallArray b
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
sz (String -> String -> b
forall a. String -> String -> a
die String
">>=" String
"impossible") ((forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b)
-> (forall s. SmallMutableArray s b -> ST s ()) -> SmallArray b
forall a b. (a -> b) -> a -> b
$ Int
-> ArrayStack b
-> SmallMutableArray (PrimState (ST s)) b
-> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
Int -> ArrayStack a -> SmallMutableArray (PrimState m) a -> m ()
fill Int
0 ArrayStack b
stk
     | (# a
x #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
sa Int
i
     , let sb :: SmallArray b
sb = a -> SmallArray b
f a
x
           lsb :: Int
lsb = SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray 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 -> SmallArray b
collect Int
sz ArrayStack b
stk (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
       else Int -> ArrayStack b -> Int -> SmallArray b
collect (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lsb) (SmallArray b -> ArrayStack b -> ArrayStack b
forall a. SmallArray a -> ArrayStack a -> ArrayStack a
PushArray SmallArray b
sb ArrayStack b
stk) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

   fill :: Int -> ArrayStack a -> SmallMutableArray (PrimState m) a -> m ()
fill Int
_ ArrayStack a
EmptyStack SmallMutableArray (PrimState m) a
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   fill Int
off (PushArray SmallArray a
sb ArrayStack a
sbs) SmallMutableArray (PrimState m) a
smb =
     SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray (PrimState m) a
smb Int
off SmallArray a
sb Int
0 (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sb)
       m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ArrayStack a -> SmallMutableArray (PrimState m) a -> m ()
fill (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sb) ArrayStack a
sbs SmallMutableArray (PrimState m) a
smb

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

instance Fail.MonadFail SmallArray where
  fail :: String -> SmallArray a
fail String
_ = SmallArray a
forall a. SmallArray a
emptySmallArray

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

zipW :: String -> (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
zipW :: String
-> (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
zipW String
nm = \a -> b -> c
f SmallArray a
sa SmallArray b
sb -> let mn :: Int
mn = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
sb in
  Int
-> c
-> (forall s. SmallMutableArray s c -> ST s ())
-> SmallArray c
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
mn (String -> String -> c
forall a. String -> String -> a
die String
nm String
"impossible") ((forall s. SmallMutableArray s c -> ST s ()) -> SmallArray c)
-> (forall s. SmallMutableArray s c -> ST s ()) -> SmallArray c
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s c
mc ->
    ((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ()
forall a. (a -> a) -> a
fix (((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ())
-> Int -> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
? Int
0 (((Int -> ST s ()) -> Int -> ST s ()) -> ST s ())
-> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int -> ST s ()
go 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
mn) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
      a
x <- SmallArray a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
      b
y <- SmallArray b -> Int -> ST s b
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray b
sb Int
i
      SmallMutableArray (PrimState (ST s)) c -> Int -> c -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s c
SmallMutableArray (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)
{-# INLINE zipW #-}

instance MonadZip SmallArray where
  mzip :: SmallArray a -> SmallArray b -> SmallArray (a, b)
mzip = String
-> (a -> b -> (a, b))
-> SmallArray a
-> SmallArray b
-> SmallArray (a, b)
forall a b c.
String
-> (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
zipW String
"mzip" (,)
  mzipWith :: (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
mzipWith = String
-> (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
forall a b c.
String
-> (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c
zipW String
"mzipWith"
  {-# INLINE mzipWith #-}
  munzip :: SmallArray (a, b) -> (SmallArray a, SmallArray b)
munzip SmallArray (a, b)
sab = (forall s. ST s (SmallArray a, SmallArray b))
-> (SmallArray a, SmallArray b)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (SmallArray a, SmallArray b))
 -> (SmallArray a, SmallArray b))
-> (forall s. ST s (SmallArray a, SmallArray b))
-> (SmallArray a, SmallArray b)
forall a b. (a -> b) -> a -> b
$ do
    let sz :: Int
sz = SmallArray (a, b) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray (a, b)
sab
    SmallMutableArray s a
sma <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
sz (a -> ST s (SmallMutableArray (PrimState (ST s)) a))
-> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall a b. (a -> b) -> a -> b
$ String -> String -> a
forall a. String -> String -> a
die String
"munzip" String
"impossible"
    SmallMutableArray s b
smb <- Int -> b -> ST s (SmallMutableArray (PrimState (ST s)) b)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
sz (b -> ST s (SmallMutableArray (PrimState (ST s)) b))
-> b -> ST s (SmallMutableArray (PrimState (ST s)) b)
forall a b. (a -> b) -> a -> b
$ String -> String -> b
forall a. String -> String -> a
die String
"munzip" String
"impossible"
    ((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ()
forall a. (a -> a) -> a
fix (((Int -> ST s ()) -> Int -> ST s ()) -> Int -> ST s ())
-> Int -> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
? Int
0 (((Int -> ST s ()) -> Int -> ST s ()) -> ST s ())
-> ((Int -> ST s ()) -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int -> ST s ()
go 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
sz) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ case SmallArray (a, b) -> Int -> (a, b)
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (a, b)
sab Int
i of
        (a
x, b
y) -> do SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
sma Int
i a
x
                     SmallMutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s b
SmallMutableArray (PrimState (ST s)) b
smb Int
i b
y
                     Int -> ST s ()
go (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
    (,) (SmallArray a -> SmallArray b -> (SmallArray a, SmallArray b))
-> ST s (SmallArray a)
-> ST s (SmallArray b -> (SmallArray a, SmallArray b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SmallMutableArray (PrimState (ST s)) a -> ST s (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
sma
        ST s (SmallArray b -> (SmallArray a, SmallArray b))
-> ST s (SmallArray b) -> ST s (SmallArray a, SmallArray b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SmallMutableArray (PrimState (ST s)) b -> ST s (SmallArray b)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s b
SmallMutableArray (PrimState (ST s)) b
smb

instance MonadFix SmallArray where
  mfix :: (a -> SmallArray a) -> SmallArray a
mfix a -> SmallArray a
f = Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray (a -> SmallArray a
f a
forall a. a
err))
                            (String -> String -> a
forall a. String -> String -> a
die String
"mfix" String
"impossible") ((forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a)
-> (forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ (((Int -> SmallMutableArray s a -> ST s ())
  -> Int -> SmallMutableArray s a -> ST s ())
 -> Int -> SmallMutableArray s a -> ST s ())
-> Int
-> ((Int -> SmallMutableArray s a -> ST s ())
    -> Int -> SmallMutableArray s a -> ST s ())
-> SmallMutableArray s a
-> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> SmallMutableArray s a -> ST s ())
 -> Int -> SmallMutableArray s a -> ST s ())
-> Int -> SmallMutableArray s a -> ST s ()
forall a. (a -> a) -> a
fix Int
0 (((Int -> SmallMutableArray s a -> ST s ())
  -> Int -> SmallMutableArray s a -> ST s ())
 -> SmallMutableArray s a -> ST s ())
-> ((Int -> SmallMutableArray s a -> ST s ())
    -> Int -> SmallMutableArray s a -> ST s ())
-> SmallMutableArray s a
-> ST s ()
forall a b. (a -> b) -> a -> b
$
    \Int -> SmallMutableArray s a -> ST s ()
r !Int
i !SmallMutableArray 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
                      SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
mary Int
i ((a -> a) -> a
forall a. (a -> a) -> a
fix (\a
xi -> a -> SmallArray a
f a
xi SmallArray a -> Int -> a
forall a. SmallArray a -> Int -> a
`indexSmallArray` Int
i))
                      Int -> SmallMutableArray s a -> ST s ()
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SmallMutableArray s a
mary
    where
      sz :: Int
sz = SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray (a -> SmallArray a
f a
forall a. a
err)
      err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"mfix for Data.Primitive.SmallArray applied to strict function."

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

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

instance IsList (SmallArray a) where
  type Item (SmallArray a) = a
  fromListN :: Int -> [Item (SmallArray a)] -> SmallArray a
fromListN = Int -> [Item (SmallArray a)] -> SmallArray a
forall a. Int -> [a] -> SmallArray a
smallArrayFromListN
  fromList :: [Item (SmallArray a)] -> SmallArray a
fromList = [Item (SmallArray a)] -> SmallArray a
forall a. [a] -> SmallArray a
smallArrayFromList
  toList :: SmallArray a -> [Item (SmallArray a)]
toList = SmallArray a -> [Item (SmallArray a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

smallArrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS
smallArrayLiftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> SmallArray a
-> String
-> String
smallArrayLiftShowsPrec Int -> a -> String -> String
elemShowsPrec [a] -> String -> String
elemListShowsPrec Int
p SmallArray a
sa = 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 (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) (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 (SmallArray a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SmallArray a
sa)

-- 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 (SmallArray a) where
  showsPrec :: Int -> SmallArray a -> String -> String
showsPrec Int
p SmallArray a
sa = (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> SmallArray a
-> String
-> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> SmallArray a
-> String
-> String
smallArrayLiftShowsPrec 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 SmallArray a
sa

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

smallArrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
smallArrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
smallArrayLiftReadsPrec Int -> ReadS a
_ ReadS [a]
listReadsPrec Int
p = Bool -> ReadS (SmallArray a) -> ReadS (SmallArray a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (SmallArray a) -> ReadS (SmallArray a))
-> (ReadP (SmallArray a) -> ReadS (SmallArray a))
-> ReadP (SmallArray a)
-> ReadS (SmallArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP (SmallArray a) -> ReadS (SmallArray a)
forall a. ReadP a -> ReadS a
readP_to_S (ReadP (SmallArray a) -> ReadS (SmallArray a))
-> ReadP (SmallArray a) -> ReadS (SmallArray a)
forall a b. (a -> b) -> a -> b
$ do
  () () -> ReadP String -> ReadP ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
string String
"fromListN"
  ReadP ()
skipSpaces
  Int
n <- ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads
  ReadP ()
skipSpaces
  [a]
l <- ReadS [a] -> ReadP [a]
forall a. ReadS a -> ReadP a
readS_to_P ReadS [a]
listReadsPrec
  SmallArray a -> ReadP (SmallArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SmallArray a -> ReadP (SmallArray a))
-> SmallArray a -> ReadP (SmallArray a)
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> SmallArray a
forall a. Int -> [a] -> SmallArray a
smallArrayFromListN Int
n [a]
l

instance Read a => Read (SmallArray a) where
  readsPrec :: Int -> ReadS (SmallArray a)
readsPrec = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
smallArrayLiftReadsPrec Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
-- | @since 0.6.4.0
instance Read1 SmallArray where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
liftReadsPrec = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
smallArrayLiftReadsPrec
#else
  readsPrec1 = smallArrayLiftReadsPrec readsPrec readList
#endif
#endif



smallArrayDataType :: DataType
smallArrayDataType :: DataType
smallArrayDataType =
  String -> [Constr] -> DataType
mkDataType String
"Data.Primitive.SmallArray.SmallArray" [Constr
fromListConstr]

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

instance Data a => Data (SmallArray a) where
  toConstr :: SmallArray a -> Constr
toConstr SmallArray a
_ = Constr
fromListConstr
  dataTypeOf :: SmallArray a -> DataType
dataTypeOf SmallArray a
_ = DataType
smallArrayDataType
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SmallArray 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] -> SmallArray a) -> c (SmallArray a)
forall b r. Data b => c (b -> r) -> c r
k (([a] -> SmallArray a) -> c ([a] -> SmallArray a)
forall r. r -> c r
z [a] -> SmallArray a
forall l. IsList l => [Item l] -> l
fromList)
    Int
_ -> String -> String -> c (SmallArray a)
forall a. String -> String -> a
die String
"gunfold" String
"SmallArray"
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SmallArray a -> c (SmallArray a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z SmallArray a
m = ([a] -> SmallArray a) -> c ([a] -> SmallArray a)
forall g. g -> c g
z [a] -> SmallArray a
forall l. IsList l => [Item l] -> l
fromList c ([a] -> SmallArray a) -> [a] -> c (SmallArray a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` SmallArray a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SmallArray a
m

instance (Typeable s, Typeable a) => Data (SmallMutableArray s a) where
  toConstr :: SmallMutableArray s a -> Constr
toConstr SmallMutableArray s a
_ = String -> String -> Constr
forall a. String -> String -> a
die String
"toConstr" String
"SmallMutableArray"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SmallMutableArray s a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = String -> String -> Constr -> c (SmallMutableArray s a)
forall a. String -> String -> a
die String
"gunfold" String
"SmallMutableArray"
  dataTypeOf :: SmallMutableArray s a -> DataType
dataTypeOf SmallMutableArray s a
_ = String -> DataType
mkNoRepType String
"Data.Primitive.SmallArray.SmallMutableArray"
#endif

-- | Create a 'SmallArray' from a list of a known length. If the length
--   of the list does not match the given length, this throws an exception.
smallArrayFromListN :: Int -> [a] -> SmallArray a
#if HAVE_SMALL_ARRAY
smallArrayFromListN :: Int -> [a] -> SmallArray a
smallArrayFromListN Int
n [a]
l =
  Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
n
      (String -> String -> a
forall a. String -> String -> a
die String
"smallArrayFromListN" String
"uninitialized element") ((forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a)
-> (forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray 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
"smallArrayFromListN" 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
          SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (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
"smallArrayFromListN" String
"list length greater than specified size"
  in Int -> [a] -> ST s ()
go Int
0 [a]
l
#else
smallArrayFromListN n l = SmallArray (Array.fromListN n l)
#endif

-- | Create a 'SmallArray' from a list.
smallArrayFromList :: [a] -> SmallArray a
smallArrayFromList :: [a] -> SmallArray a
smallArrayFromList [a]
l = Int -> [a] -> SmallArray a
forall a. Int -> [a] -> SmallArray a
smallArrayFromListN ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) [a]
l

#if MIN_VERSION_base(4,14,0)
-- | Shrink the mutable array in place. The size given must be equal to
-- or less than the current size of the array. This is not checked.
shrinkSmallMutableArray :: PrimMonad m
  => SmallMutableArray (PrimState m) a
  -> Int
  -> m ()
{-# inline shrinkSmallMutableArray #-}
shrinkSmallMutableArray :: SmallMutableArray (PrimState m) a -> Int -> m ()
shrinkSmallMutableArray (SmallMutableArray SmallMutableArray# (PrimState m) a
x) (I# Int#
n) = (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
  (\State# (PrimState m)
s0 -> case SmallMutableArray# (PrimState m) a
-> Int# -> State# (PrimState m) -> State# (PrimState m)
forall d a. SmallMutableArray# d a -> Int# -> State# d -> State# d
GHC.Exts.shrinkSmallMutableArray# SmallMutableArray# (PrimState m) a
x Int#
n State# (PrimState m)
s0 of
    State# (PrimState m)
s1 -> (# State# (PrimState m)
s1, () #)
  )
#endif