{-# LANGUAGE UnboxedTuples #-}

-- |
-- Module : Data.Primitive.SmallArray
-- Copyright: (c) 2015 Dan Doel
-- License: BSD3
--
-- Maintainer  : streamly@composewell.com
-- 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 Streamly.Internal.Data.SmallArray.Type
  ( SmallArray(..)
  , SmallMutableArray(..)
  , newSmallArray
  , readSmallArray
  , writeSmallArray
  , copySmallArray
  , copySmallMutableArray
  , indexSmallArray
  , indexSmallArrayM
  , indexSmallArray##
  , cloneSmallArray
  , cloneSmallMutableArray
  , freezeSmallArray
  , unsafeFreezeSmallArray
  , thawSmallArray
  , runSmallArray
  , unsafeThawSmallArray
  , sizeofSmallArray
  , sizeofSmallMutableArray
  , smallArrayFromList
  , smallArrayFromListN
  , mapSmallArray'
  , traverseSmallArrayP
  ) where

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

import Control.Applicative
import Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
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,9,0) && !MIN_VERSION_base(4,10,0)
import GHC.Base (runRW#)
#endif

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

data SmallArray a = SmallArray (SmallArray# a)
  deriving Typeable

data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)
  deriving Typeable

-- | Create a new small mutable array.
newSmallArray
  :: PrimMonad m
  => Int -- ^ size
  -> a   -- ^ initial contents
  -> m (SmallMutableArray (PrimState m) a)
newSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (I# Int#
i#) a
x = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s ->
  case forall a d.
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', forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
{-# INLINE newSmallArray #-}

-- | Read the element at a given index in a mutable array.
readSmallArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ array
  -> Int                               -- ^ index
  -> m a
readSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i#
{-# INLINE readSmallArray #-}

-- | Write an element at the given idex in a mutable array.
writeSmallArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ array
  -> Int                               -- ^ index
  -> a                                 -- ^ new element
  -> m ()
writeSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) a
x =
  forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ forall a b. (a -> b) -> a -> b
$ forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i# a
x
{-# 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.
indexSmallArrayM
  :: Monad m
  => SmallArray a -- ^ array
  -> Int          -- ^ index
  -> m a
indexSmallArrayM :: forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM (SmallArray SmallArray# a
sa#) (I# Int#
i#) =
  case forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# a
sa# Int#
i# of
    (# a
x #) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE indexSmallArrayM #-}

-- | Look up an element in an immutable array.
indexSmallArray
  :: SmallArray a -- ^ array
  -> Int          -- ^ index
  -> a
indexSmallArray :: forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
sa Int
i = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
{-# 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 #)
indexSmallArray## :: forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## (SmallArray SmallArray# a
ary) (I# Int#
i) = forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# a
ary Int#
i
{-# INLINE indexSmallArray## #-}

-- | Create a copy of a slice of an immutable array.
cloneSmallArray
  :: SmallArray a -- ^ source
  -> Int          -- ^ offset
  -> Int          -- ^ length
  -> SmallArray a
cloneSmallArray :: forall a. SmallArray a -> Int -> Int -> SmallArray a
cloneSmallArray (SmallArray SmallArray# a
sa#) (I# Int#
i#) (I# Int#
j#) =
  forall a. SmallArray# a -> SmallArray a
SmallArray (forall a. SmallArray# a -> Int# -> Int# -> SmallArray# a
cloneSmallArray# SmallArray# a
sa# Int#
i# Int#
j#)
{-# INLINE cloneSmallArray #-}

-- | Create a copy of a slice of a mutable array.
cloneSmallMutableArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ source
  -> Int                               -- ^ offset
  -> Int                               -- ^ length
  -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
o#) (I# Int#
l#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall d a.
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', forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
smb# #)
{-# 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)
freezeSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)
freezeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) (I# Int#
j#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall d a.
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', forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
sa# #)
{-# 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)
unsafeFreezeSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall d a.
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', forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
sa# #)
{-# 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)
thawSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray (SmallArray SmallArray# a
sa#) (I# Int#
o#) (I# Int#
l#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall a d.
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', forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
{-# 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)
unsafeThawSmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> m (SmallMutableArray (PrimState m) a)
unsafeThawSmallArray (SmallArray SmallArray# a
sa#) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case forall a d.
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', forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
{-# INLINE unsafeThawSmallArray #-}

-- | Copy a slice of an immutable array into a mutable array.
copySmallArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ destination
  -> Int                               -- ^ destination offset
  -> SmallArray a                      -- ^ source
  -> Int                               -- ^ source offset
  -> Int                               -- ^ length
  -> m ()
copySmallArray :: forall (m :: * -> *) a.
PrimMonad m =>
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#) =
    forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ forall a b. (a -> b) -> a -> b
$ 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#
{-# INLINE copySmallArray #-}

-- | Copy a slice of one mutable array into another.
copySmallMutableArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a -- ^ destination
  -> Int                               -- ^ destination offset
  -> SmallMutableArray (PrimState m) a -- ^ source
  -> Int                               -- ^ source offset
  -> Int                               -- ^ length
  -> m ()
copySmallMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
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#) =
    forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ forall a b. (a -> b) -> a -> b
$ 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#
{-# INLINE copySmallMutableArray #-}

sizeofSmallArray :: SmallArray a -> Int
sizeofSmallArray :: forall a. SmallArray a -> Int
sizeofSmallArray (SmallArray SmallArray# a
sa#) = Int# -> Int
I# (forall a. SmallArray# a -> Int#
sizeofSmallArray# SmallArray# a
sa#)
{-# INLINE sizeofSmallArray #-}

sizeofSmallMutableArray :: SmallMutableArray s a -> Int
sizeofSmallMutableArray :: forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray (SmallMutableArray SmallMutableArray# s a
sa#) =
  Int# -> Int
I# (forall d a. SmallMutableArray# d a -> Int#
sizeofSmallMutableArray# SmallMutableArray# s a
sa#)
{-# 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)
traverseSmallArrayP :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> m b) -> SmallArray a -> m (SmallArray b)
traverseSmallArrayP a -> m b
f !SmallArray a
ary =
  let
    !sz :: Int
sz = 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 forall a. Eq a => a -> a -> Bool
== Int
sz
      = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray (PrimState m) b
mary
      | Bool
otherwise
      = do
          a
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
          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 forall a. Num a => a -> a -> a
+ Int
1) SmallMutableArray (PrimState m) b
mary
  in do
    SmallMutableArray (PrimState m) b
mary <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
sz forall a. a
badTraverseValue
    Int -> SmallMutableArray (PrimState m) b -> m (SmallArray b)
go Int
0 SmallMutableArray (PrimState m) b
mary
{-# INLINE traverseSmallArrayP #-}

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

#if !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 a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray forall s. ST s (SmallMutableArray s a)
m = forall a. SmallArray# a -> SmallArray a
SmallArray (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 a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray# a
runSmallArray# forall s. ST s (SmallMutableArray s a)
m = case forall o. (State# RealWorld -> o) -> o
runRW# forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case forall s a. ST s a -> State# s -> (# State# s, a #)
unST forall s. ST s (SmallMutableArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', SmallMutableArray SmallMutableArray# RealWorld a
mary# #) ->
  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 :: forall s a. ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST STRep s a
f) = STRep s a
f

#endif

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

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

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

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


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

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

smallArrayLiftEq :: (a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq :: forall a b.
(a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq a -> b -> Bool
p SmallArray a
sa1 SmallArray b
sa2 = forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
sa2 Bool -> Bool -> Bool
&& Int -> Bool
loop (forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa1 forall a. Num a => a -> a -> a
- Int
1)
  where
  loop :: Int -> Bool
loop Int
i
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
0
    = Bool
True
    | (# a
x #) <- forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
sa1 Int
i
    , (# b
y #) <- 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
iforall 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 :: forall a b.
(a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
liftEq = 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 = forall a b.
(a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq 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# (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 :: forall a b.
(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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
a1 forall a. Ord a => a -> a -> a
`min` forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
a2
  loop :: Int -> Ordering
loop Int
i
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
mn
    , (# a
x1 #) <- forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
a1 Int
i
    , (# b
x2 #) <- forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray b
a2 Int
i
    = a -> b -> Ordering
elemCompare a
x1 b
x2 forall a. Monoid a => a -> a -> a
`mappend` Int -> Ordering
loop (Int
iforall a. Num a => a -> a -> a
+Int
1)
    | Bool
otherwise = forall a. Ord a => a -> a -> Ordering
compare (forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
a1) (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 :: forall a b.
(a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
liftCompare = 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 = forall a b.
(a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare forall a. Ord a => a -> a -> Ordering
compare

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

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

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

newSmallArray_ :: Int -> ST s (SmallMutableArray s a)
newSmallArray_ :: forall s a. Int -> ST s (SmallMutableArray s a)
newSmallArray_ !Int
n = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n forall a. a
badTraverseValue

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

instance Traversable SmallArray where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SmallArray a -> f (SmallArray b)
traverse a -> f b
f = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SmallArray a -> f (SmallArray b)
traverseSmallArray a -> f b
f = \ !SmallArray a
ary ->
  let
    !len :: Int
len = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
ary
    go :: Int -> f (STA b)
go !Int
i
      | Int
i forall a. Eq a => a -> a -> Bool
== Int
len
      = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
(forall s. SmallMutableArray# s a -> ST s (SmallArray a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary -> forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray (forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# s b
mary)
      | (# a
x #) <- forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
ary Int
i
      = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\b
b (STA forall s. SmallMutableArray# s b -> ST s (SmallArray b)
m) -> forall a.
(forall s. SmallMutableArray# s a -> ST s (SmallArray a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary ->
                  forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray (forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# s b
mary) Int
i b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m 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 forall a. Num a => a -> a -> a
+ Int
1))
  in if Int
len forall a. Eq a => a -> a -> Bool
== Int
0
     then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. SmallArray a
emptySmallArray
     else forall a. Int -> STA a -> SmallArray a
runSTA Int
len forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f (STA b)
go Int
0
{-# INLINE [1] 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 :: forall a b. (a -> b) -> SmallArray a -> SmallArray b
fmap a -> b
f SmallArray a
sa = forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) (forall a. String -> String -> a
die String
"fmap" String
"impossible") forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s b
smb ->
    forall a. (a -> a) -> a
fix forall a b c. (a -> b -> c) -> b -> a -> c
? Int
0 forall a b. (a -> b) -> a -> b
$ \Int -> ST s ()
go Int
i ->
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) forall a b. (a -> b) -> a -> b
$ do
        a
x <- forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
        forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s b
smb Int
i (a -> b
f a
x) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
  {-# INLINE fmap #-}

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

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

  SmallArray a
sa *> :: forall a b. SmallArray a -> SmallArray b -> SmallArray b
*> SmallArray b
sb = forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (Int
laforall a. Num a => a -> a -> a
*Int
lb) (forall a. String -> String -> a
die String
"*>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s b
smb ->
    forall a. (a -> a) -> a
fix forall a b c. (a -> b -> c) -> b -> a -> c
? Int
0 forall a b. (a -> b) -> a -> b
$ \Int -> ST s ()
go Int
i ->
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
la) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s b
smb Int
0 SmallArray b
sb Int
0 Int
lb forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
   where
   la :: Int
la = forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa ; lb :: Int
lb = forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
sb

  SmallArray a
a <* :: forall a b. SmallArray a -> SmallArray b -> SmallArray a
<* SmallArray b
b = forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (Int
szaforall a. Num a => a -> a -> a
*Int
szb) (forall a. String -> String -> a
die String
"<*" String
"impossible") 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
szb) forall a b. (a -> b) -> a -> b
$
                         forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
ma (Int
offforall a. Num a => a -> a -> a
+Int
i) a
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> a -> ST s ()
fill Int
off (Int
iforall a. Num a => a -> a -> a
+Int
1) a
e
        go :: Int -> ST s ()
go Int
i = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
sza) forall a b. (a -> b) -> a -> b
$ do
                 a
x <- forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
a Int
i
                 Int -> Int -> a -> ST s ()
fill (Int
iforall a. Num a => a -> a -> a
*Int
szb) Int
0 a
x
                 Int -> ST s ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
     in Int -> ST s ()
go Int
0
   where sza :: Int
sza = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
a ; szb :: Int
szb = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray b
b

  SmallArray (a -> b)
ab <*> :: forall a b. SmallArray (a -> b) -> SmallArray a -> SmallArray b
<*> SmallArray a
a = forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (Int
szabforall a. Num a => a -> a -> a
*Int
sza) (forall a. String -> String -> a
die String
"<*>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s b
mb ->
    let go1 :: Int -> ST s ()
go1 Int
i = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
szab) forall a b. (a -> b) -> a -> b
$
            do
              a -> b
f <- forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray (a -> b)
ab Int
i
              Int -> (a -> b) -> Int -> ST s ()
go2 (Int
iforall a. Num a => a -> a -> a
*Int
sza) a -> b
f Int
0
              Int -> ST s ()
go1 (Int
iforall a. Num a => a -> a -> a
+Int
1)
        go2 :: Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f Int
j = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j forall a. Ord a => a -> a -> Bool
< Int
sza) forall a b. (a -> b) -> a -> b
$
            do
              a
x <- forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
a Int
j
              forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s b
mb (Int
off forall a. Num a => a -> a -> a
+ Int
j) (a -> b
f a
x)
              Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f (Int
j forall a. Num a => a -> a -> a
+ Int
1)
    in Int -> ST s ()
go1 Int
0
   where szab :: Int
szab = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (a -> b)
ab ; sza :: Int
sza = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
a

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

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

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

  some :: forall a. SmallArray a -> SmallArray [a]
some SmallArray a
sa | forall (t :: * -> *) a. Foldable t => t a -> Bool
null SmallArray a
sa   = forall a. SmallArray a
emptySmallArray
          | Bool
otherwise = 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 :: forall a. a -> SmallArray a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >> :: forall a b. SmallArray a -> SmallArray b -> SmallArray b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

  SmallArray a
sa >>= :: forall a b. SmallArray a -> (a -> SmallArray b) -> SmallArray b
>>= a -> SmallArray b
f = Int -> ArrayStack b -> Int -> SmallArray b
collect Int
0 forall a. ArrayStack a
EmptyStack (Int
laforall a. Num a => a -> a -> a
-Int
1)
   where
   la :: Int
la = 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 forall a. Ord a => a -> a -> Bool
< Int
0 = forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
sz (forall a. String -> String -> a
die String
">>=" String
"impossible") forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a}.
PrimMonad m =>
Int -> ArrayStack a -> SmallMutableArray (PrimState m) a -> m ()
fill Int
0 ArrayStack b
stk
     | (# a
x #) <- 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 = 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 forall a. Eq a => a -> a -> Bool
== Int
0
       then Int -> ArrayStack b -> Int -> SmallArray b
collect Int
sz ArrayStack b
stk (Int
iforall a. Num a => a -> a -> a
-Int
1)
       else Int -> ArrayStack b -> Int -> SmallArray b
collect (Int
sz forall a. Num a => a -> a -> a
+ Int
lsb) (forall a. SmallArray a -> ArrayStack a -> ArrayStack a
PushArray SmallArray b
sb ArrayStack b
stk) (Int
iforall 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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
   fill Int
off (PushArray SmallArray a
sb ArrayStack a
sbs) SmallMutableArray (PrimState m) a
smb =
     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 (forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sb)
       forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ArrayStack a -> SmallMutableArray (PrimState m) a -> m ()
fill (Int
off forall a. Num a => a -> a -> a
+ 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)) && MIN_VERSION_base(4,9,0)
  fail = Fail.fail
#endif

#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail SmallArray where
  fail :: forall a. String -> SmallArray a
fail String
_ = forall a. SmallArray a
emptySmallArray
#endif

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

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

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

instance MonadFix SmallArray where
  mfix :: forall a. (a -> SmallArray a) -> SmallArray a
mfix a -> SmallArray a
f = forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (forall a. SmallArray a -> Int
sizeofSmallArray (a -> SmallArray a
f forall a. a
err))
                            (forall a. String -> String -> a
die String
"mfix" String
"impossible") forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix Int
0 forall a b. (a -> b) -> a -> b
$
    \Int -> SmallMutableArray s a -> ST s ()
r !Int
i !SmallMutableArray s a
mary -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
sz) forall a b. (a -> b) -> a -> b
$ do
                      forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
mary Int
i (forall a. (a -> a) -> a
fix (\a
xi -> a -> SmallArray a
f a
xi forall a. SmallArray a -> Int -> a
`indexSmallArray` Int
i))
                      Int -> SmallMutableArray s a -> ST s ()
r (Int
i forall a. Num a => a -> a -> a
+ Int
1) SmallMutableArray s a
mary
    where
      sz :: Int
sz = forall a. SmallArray a -> Int
sizeofSmallArray (a -> SmallArray a
f forall a. a
err)
      err :: a
err = 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
(<>) = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  sconcat :: NonEmpty (SmallArray a) -> SmallArray a
sconcat = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
#endif

instance Monoid (SmallArray a) where
  mempty :: SmallArray a
mempty = 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 = forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
n (forall a. String -> String -> a
die String
"mconcat" String
"impossible") forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s a
ma ->
    let go :: Int -> [SmallArray a] -> ST s ()
go !Int
_  [    ] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go Int
off (SmallArray a
a:[SmallArray a]
as) =
          forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
ma Int
off SmallArray a
a Int
0 (forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
a) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [SmallArray a] -> ST s ()
go (Int
off forall a. Num a => a -> a -> a
+ 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> Int
length 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 = forall a. Int -> [a] -> SmallArray a
smallArrayFromListN
  fromList :: [Item (SmallArray a)] -> SmallArray a
fromList = forall a. [a] -> SmallArray a
smallArrayFromList
  toList :: SmallArray a -> [Item (SmallArray a)]
toList = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

smallArrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS
smallArrayLiftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS
smallArrayLiftShowsPrec Int -> a -> ShowS
elemShowsPrec [a] -> ShowS
elemListShowsPrec Int
p SmallArray a
sa = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
  String -> ShowS
showString String
"fromListN " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec Int -> a -> ShowS
elemShowsPrec [a] -> ShowS
elemListShowsPrec Int
11 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SmallArray a
sa)

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

instance Show a => Show (SmallArray a) where
  showsPrec :: Int -> SmallArray a -> ShowS
showsPrec = forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS
smallArrayLiftShowsPrec forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

#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 :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS
liftShowsPrec = forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS
smallArrayLiftShowsPrec
#else
  showsPrec1 = smallArrayLiftShowsPrec showsPrec showList
#endif
#endif

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

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

instance (Typeable s, Typeable a) => Data (SmallMutableArray s a) where
  toConstr :: SmallMutableArray s a -> Constr
toConstr SmallMutableArray s a
_ = forall a. String -> String -> a
die String
"toConstr" String
"SmallMutableArray"
  gunfold :: forall (c :: * -> *).
(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
_ = 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"

-- | 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
smallArrayFromListN :: forall a. Int -> [a] -> SmallArray a
smallArrayFromListN Int
n [a]
l =
  forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
n
      (forall a. String -> String -> a
die String
"smallArrayFromListN" String
"uninitialized element") forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s a
sma ->
  let go :: Int -> [a] -> ST s ()
go !Int
ix [] = if Int
ix forall a. Eq a => a -> a -> Bool
== Int
n
        then forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else forall a. String -> String -> a
die String
"smallArrayFromListN" String
"list length less than specified size"
      go !Int
ix (a
x : [a]
xs) = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
n
        then do
          forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
sma Int
ix a
x
          Int -> [a] -> ST s ()
go (Int
ixforall a. Num a => a -> a -> a
+Int
1) [a]
xs
        else forall a. String -> String -> a
die String
"smallArrayFromListN" String
"list length greater than specified size"
  in Int -> [a] -> ST s ()
go Int
0 [a]
l

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