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

-- |
-- 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 'Data.Primitive.Array.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,
-- 'Data.Primitive.Array.Array' would likely be superior.

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

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

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
import Data.Primitive.Internal.Read (Tag(..),lexTag)
import Text.Read (Read (..), parens, prec)
import qualified GHC.ST as GHCST
import Data.Semigroup
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec (ReadPrec)
import qualified Text.ParserCombinators.ReadPrec as RdPrc
#if !MIN_VERSION_base(4,10,0)
import GHC.Base (runRW#)
#endif

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

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

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

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

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

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

-- | 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)
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.
--
-- /Note:/ this function does not do bounds checking.
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.
--
-- /Note:/ this function does not do bounds checking.
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 an applicative 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
--
-- It also 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
  :: Applicative m
  => SmallArray a -- ^ array
  -> Int          -- ^ index
  -> m a
indexSmallArrayM :: forall (m :: * -> *) a. Applicative 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.
--
-- /Note:/ this function does not do bounds checking.
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. Applicative 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.
--
-- /Note:/ this function does not do bounds checking.
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.
--
-- /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
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.
--
-- /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)
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.
--
-- /Note:/ The provided array should contain the full subrange
-- specified by the two Ints, but this is not checked.
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.
--
-- /Note:/ The provided array should contain the full subrange
-- specified by the two Ints, but this is not checked.
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.
--
-- /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 ()
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.
--
-- /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 ()
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 #-}

-- | The number of elements in an immutable array.
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 #-}

-- | Get the number of elements in a mutable array. Unlike
-- 'sizeofSmallMutableArray', this function will be sure to produce the correct
-- result if 'SmallMutableArray' has been shrunk in place. Consider the following:
--
-- @
-- do
--   sa <- 'newSmallArray' 10 x
--   print $ 'sizeofSmallMutableArray' sa
--   'shrinkSmallMutableArray' sa 5
--   print $ sizeofSmallMutableArray sa
-- @
--
-- The compiler is well within its rights to eliminate the second size check
-- and print @10@ twice. However, 'getSizeofSmallMutableArray' will check
-- the size each time it's /executed/ (not /evaluated/), so it won't have this
-- problem:
--
-- @
-- do
--   sa <- 'newSmallArray' 10 x
--   print =<< getSizeofSmallMutableArray sa
--   'shrinkSmallMutableArray' sa 5
--   print =<< getSizeofSmallMutableArray sa
-- @
--
-- will certainly print @10@ and then @5@.
getSizeofSmallMutableArray
  :: PrimMonad m
  => SmallMutableArray (PrimState m) a
  -> m Int
#if MIN_VERSION_base(4,14,0)
getSizeofSmallMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m Int
getSizeofSmallMutableArray (SmallMutableArray SmallMutableArray# (PrimState m) 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 d a.
SmallMutableArray# d a -> State# d -> (# State# d, Int# #)
getSizeofSmallMutableArray# SmallMutableArray# (PrimState m) a
sa# State# (PrimState m)
s of
    (# State# (PrimState m)
s', Int#
sz# #) -> (# State# (PrimState m)
s', Int# -> Int
I# Int#
sz# #)
#else
getSizeofSmallMutableArray sa = pure $! sizeofSmallMutableArray sa
#endif
{-# INLINE getSizeofSmallMutableArray #-}

-- | The number of elements in a mutable array. This should only be used
-- for arrays that are not shrunk in place.
--
-- This is deprecated and will be removed in a future release. Use
-- 'getSizeofSmallMutableArray' instead.
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#)
{-# DEPRECATED sizeofSmallMutableArray "use getSizeofSmallMutableArray instead" #-}
{-# 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. Applicative 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. Applicative 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
i forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE mapSmallArray' #-}

-- | Execute the monadic action and freeze the resulting array.
--
-- > runSmallArray m = runST $ m >>= unsafeFreezeSmallArray
runSmallArray
  :: (forall s. ST s (SmallMutableArray s a))
  -> SmallArray a
-- This low-level business is designed to work with GHC's worker-wrapper
-- transformation. A lot of the time, we don't actually need an Array
-- constructor. By putting it on the outside, and being careful about
-- how we special-case the empty array, we can make GHC smarter about this.
-- The only downside is that separately created 0-length arrays won't share
-- their Array constructors, although they'll share their underlying
-- Array#s.
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

-- | Create an array of the given size with a default value,
-- apply the monadic function and freeze the result. If the
-- size is 0, return 'emptySmallArray' (rather than a new copy thereof).
--
-- > createSmallArray 0 _ _ = emptySmallArray
-- > createSmallArray n x f = runSmallArray $ do
-- >   mary <- newSmallArray n x
-- >   f mary
-- >   pure mary
createSmallArray
  :: Int
  -> a
  -> (forall s. SmallMutableArray s a -> ST s ())
  -> SmallArray a
-- See the comment on runSmallArray for why we use emptySmallArray#.
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

-- | The empty 'SmallArray'.
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
i forall a. Num a => a -> a -> a
- Int
1)

-- | @since 0.6.4.0
instance Eq1 SmallArray where
  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

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
i forall 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)

-- | @since 0.6.4.0
instance Ord1 SmallArray where
  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

-- | 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 = forall a b.
(a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare 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 :: 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
i forall a. Num a => a -> a -> a
+ Int
1))
    in Int -> b
go Int
0
  {-# INLINE foldr #-}
  foldl :: forall b a. (b -> a -> b) -> b -> 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
i forall 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
i forall a. Num a => a -> a -> a
+ Int
1))
    in if Int
sz forall a. Ord a => a -> a -> Bool
< Int
0
       then forall a. String -> String -> a
die String
"foldr1" String
"Empty 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
i forall a. Num a => a -> a -> a
- Int
1) (a -> b -> b
f a
x b
acc)
    in Int -> b -> b
go (forall a. 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
i forall a. Num a => a -> a -> a
+ Int
1) (b -> a -> b
f b
acc a
x)
    in Int -> b -> b
go Int
0 b
z
  {-# INLINE foldl' #-}
  null :: forall a. 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
i forall a. Num a => a -> a -> a
+ Int
1) (forall a. Ord a => a -> a -> a
max a
e a
x)
  {-# INLINE maximum #-}
  minimum :: forall a. Ord a => 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
i forall a. Num a => a -> a -> a
+ Int
1) (forall a. Ord a => a -> a -> a
min a
e a
x)
  {-# INLINE minimum #-}
  sum :: forall a. Num a => 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. Applicative 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
i forall 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
la forall 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
i forall a. Num a => a -> a -> a
* Int
lb) SmallArray b
sb Int
0 Int
lb forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
   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
sza forall a. Num a => a -> a -> a
* Int
szb) (forall a. String -> String -> a
die String
"<*" String
"impossible") forall a b. (a -> b) -> a -> b
$ \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
off forall a. Num a => a -> a -> a
+ Int
i) a
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> a -> ST s ()
fill Int
off (Int
i forall a. Num a => a -> a -> a
+ Int
1) a
e
        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. Applicative m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
a Int
i
                 Int -> Int -> a -> ST s ()
fill (Int
i forall a. Num a => a -> a -> a
* Int
szb) Int
0 a
x
                 Int -> ST s ()
go (Int
i forall 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
szab forall a. Num a => a -> a -> a
* Int
sza) (forall a. String -> String -> a
die String
"<*>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \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. Applicative m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray (a -> b)
ab Int
i
              Int -> (a -> b) -> Int -> ST s ()
go2 (Int
i forall a. Num a => a -> a -> a
* Int
sza) a -> b
f Int
0
              Int -> ST s ()
go1 (Int
i forall a. Num a => a -> a -> a
+ Int
1)
        go2 :: Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f Int
j = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j forall a. Ord a => a -> a -> Bool
< Int
sza) forall a b. (a -> b) -> a -> b
$
            do
              a
x <- forall (m :: * -> *) a. Applicative m => 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
la forall 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
i forall 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
i 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
_ = 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))
  fail = Fail.fail
#endif

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

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. Applicative m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
      b
y <- forall (m :: * -> *) a. Applicative 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
i forall 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 (Int
i forall 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. (a -> a) -> a
fix forall a b c. (a -> b -> c) -> b -> a -> c
? 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."

-- | @since 0.6.3.0
instance 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
  stimes :: forall b. Integral b => b -> SmallArray a -> SmallArray a
stimes b
n SmallArray a
arr = case forall a. Ord a => a -> a -> Ordering
compare b
n b
0 of
    Ordering
LT -> forall a. String -> String -> a
die String
"stimes" String
"negative multiplier"
    Ordering
EQ -> forall (f :: * -> *) a. Alternative f => f a
empty
    Ordering
GT -> forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (Int
n' forall a. Num a => a -> a -> a
* forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
arr) (forall a. String -> String -> a
die String
"stimes" String
"impossible") forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s a
sma ->
      let go :: Int -> ST s ()
go Int
i = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
n') forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
sma (Int
i forall a. Num a => a -> a -> a
* forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
arr) SmallArray a
arr Int
0 (forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
arr)
            Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
      in Int -> ST s ()
go Int
0
    where n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n :: Int

instance Monoid (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> Int
length [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
_ SmallArray a
sa =
  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 Int
p SmallArray a
sa = 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 Int
p SmallArray a
sa

-- | @since 0.6.4.0
instance Show1 SmallArray where
  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

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

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

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

#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 :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m ()
shrinkSmallMutableArray (SmallMutableArray SmallMutableArray# (PrimState m) a
x) (I# Int#
n) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
  (\State# (PrimState m)
s0 -> case 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, () #)
  )

-- | Resize a mutable array to new specified size. The returned
-- 'SmallMutableArray' is either the original 'SmallMutableArray'
-- resized in-place or, if not possible, a newly allocated
-- 'SmallMutableArray' with the original content copied over.
--
-- To avoid undefined behaviour, the original 'SmallMutableArray'
-- shall not be accessed anymore after a 'resizeSmallMutableArray' has
-- been performed. Moreover, no reference to the old one should be
-- kept in order to allow garbage collection of the original
-- 'SmallMutableArray' in case a new 'SmallMutableArray' had to be
-- allocated.
resizeSmallMutableArray :: PrimMonad m
  => SmallMutableArray (PrimState m) a
  -> Int -- ^ New size
  -> a   -- ^ Newly created slots initialized to this element. Only used when array is grown.
  -> m (SmallMutableArray (PrimState m) a)
resizeSmallMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> a -> m (SmallMutableArray (PrimState m) a)
resizeSmallMutableArray (SmallMutableArray SmallMutableArray# (PrimState m) a
arr) (I# Int#
n) a
x = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
  (\State# (PrimState m)
s0 -> case forall s a.
SmallMutableArray# s a
-> Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
GHC.Exts.resizeSmallMutableArray# SmallMutableArray# (PrimState m) a
arr Int#
n a
x State# (PrimState m)
s0 of
    (# State# (PrimState m)
s1, SmallMutableArray# (PrimState m) a
arr' #) -> (# State# (PrimState m)
s1, forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
arr' #)
  )
{-# INLINE resizeSmallMutableArray #-}
#endif