{-# 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
  , sizeofSmallMutableArray
#if MIN_VERSION_base(4,14,0)
  , shrinkSmallMutableArray
#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
#if !(MIN_VERSION_base(4,10,0))
import Data.Monoid
#endif
import qualified GHC.ST as GHCST
import qualified Data.Semigroup as Sem
import Text.ParserCombinators.ReadP
#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 :: (a -> ()) -> SmallArray a -> ()
liftRnf a -> ()
r = (() -> a -> ()) -> () -> SmallArray a -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\()
_ -> a -> ()
r) ()
#endif

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

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 :: SmallArray a -> Q (TExp (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 = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
ary
      lst :: [a]
lst = SmallArray a -> [a]
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' :: Int -> a -> [a] -> SmallArray a
unsafeSmallArrayFromListN' Int
n a
y [a]
ys =
  Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
n a
y ((forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a)
-> (forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s a
sma ->
    let go :: Int -> [a] -> ST s ()
go !Int
_ix [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go !Int
ix (!a
x : [a]
xs) = do
            SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
sma Int
ix a
x
            Int -> [a] -> ST s ()
go (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
xs
    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 :: Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray (I# Int#
i#) a
x = (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s ->
  case Int#
-> a
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
i# a
x State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
sma# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
{-# 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 :: SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) =
  (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a b. (a -> b) -> a -> b
$ SmallMutableArray# (PrimState m) a
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i#
{-# 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 :: SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) a
x =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState m) -> State# (PrimState m)) -> m ())
-> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray# (PrimState m) a
-> Int# -> a -> State# (PrimState m) -> State# (PrimState m)
forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i# a
x
{-# 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
--
-- 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
  :: Monad m
  => SmallArray a -- ^ array
  -> Int          -- ^ index
  -> m a
indexSmallArrayM :: SmallArray a -> Int -> m a
indexSmallArrayM (SmallArray SmallArray# a
sa#) (I# Int#
i#) =
  case SmallArray# a -> Int# -> (# a #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# a
sa# Int#
i# of
    (# a
x #) -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# 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 :: SmallArray a -> Int -> a
indexSmallArray SmallArray a
sa Int
i = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ SmallArray a -> Int -> Identity a
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM SmallArray a
sa Int
i
{-# 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## :: SmallArray a -> Int -> (# a #)
indexSmallArray## (SmallArray SmallArray# a
ary) (I# Int#
i) = SmallArray# a -> Int# -> (# a #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# SmallArray# a
ary Int#
i
{-# 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 :: SmallArray a -> Int -> Int -> SmallArray a
cloneSmallArray (SmallArray SmallArray# a
sa#) (I# Int#
i#) (I# Int#
j#) =
  SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray (SmallArray# a -> Int# -> Int# -> SmallArray# a
forall a. SmallArray# a -> Int# -> Int# -> SmallArray# a
cloneSmallArray# SmallArray# a
sa# Int#
i# Int#
j#)
{-# 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 :: SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
o#) (I# Int#
l#) =
  (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall d a.
SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
cloneSmallMutableArray# SmallMutableArray# (PrimState m) a
sma# Int#
o# Int#
l# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
smb# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
smb# #)
{-# 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 :: SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)
freezeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) (I# Int#
i#) (I# Int#
j#) =
  (State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
 -> m (SmallArray a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallArray# a #)
forall d a.
SmallMutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, SmallArray# a #)
freezeSmallArray# SmallMutableArray# (PrimState m) a
sma# Int#
i# Int#
j# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallArray# a
sa# #) -> (# State# (PrimState m)
s', SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
sa# #)
{-# 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 :: SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray (SmallMutableArray SmallMutableArray# (PrimState m) a
sma#) =
  (State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), SmallArray a #))
 -> m (SmallArray a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallArray a #))
-> m (SmallArray a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallMutableArray# (PrimState m) a
-> State# (PrimState m)
-> (# State# (PrimState m), SmallArray# a #)
forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# SmallMutableArray# (PrimState m) a
sma# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallArray# a
sa# #) -> (# State# (PrimState m)
s', SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray SmallArray# a
sa# #)
{-# 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 :: SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray (SmallArray SmallArray# a
sa#) (I# Int#
o#) (I# Int#
l#) =
  (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallArray# a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall a d.
SmallArray# a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
thawSmallArray# SmallArray# a
sa# Int#
o# Int#
l# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
sma# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
{-# 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 :: SmallArray a -> m (SmallMutableArray (PrimState m) a)
unsafeThawSmallArray (SmallArray SmallArray# a
sa#) =
  (State# (PrimState m)
 -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
  -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
 -> m (SmallMutableArray (PrimState m) a))
-> (State# (PrimState m)
    -> (# State# (PrimState m), SmallMutableArray (PrimState m) a #))
-> m (SmallMutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case SmallArray# a
-> State# (PrimState m)
-> (# State# (PrimState m), SmallMutableArray# (PrimState m) a #)
forall a d.
SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
unsafeThawSmallArray# SmallArray# a
sa# State# (PrimState m)
s of
    (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
sma# #) -> (# State# (PrimState m)
s', SmallMutableArray# (PrimState m) a
-> SmallMutableArray (PrimState m) a
forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray SmallMutableArray# (PrimState m) a
sma# #)
{-# 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 :: SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray
  (SmallMutableArray SmallMutableArray# (PrimState m) a
dst#) (I# Int#
do#) (SmallArray SmallArray# a
src#) (I# Int#
so#) (I# Int#
l#) =
    (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState m) -> State# (PrimState m)) -> m ())
-> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall a b. (a -> b) -> a -> b
$ SmallArray# a
-> Int#
-> SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall a d.
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# SmallArray# a
src# Int#
so# SmallMutableArray# (PrimState m) a
dst# Int#
do# Int#
l#
{-# 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 :: SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray
  (SmallMutableArray SmallMutableArray# (PrimState m) a
dst#) (I# Int#
do#)
  (SmallMutableArray SmallMutableArray# (PrimState m) a
src#) (I# Int#
so#)
  (I# Int#
l#) =
    (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState m) -> State# (PrimState m)) -> m ())
-> (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray# (PrimState m) a
-> Int#
-> SmallMutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d a.
SmallMutableArray# d a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallMutableArray# SmallMutableArray# (PrimState m) a
src# Int#
so# SmallMutableArray# (PrimState m) a
dst# Int#
do# Int#
l#
{-# INLINE copySmallMutableArray #-}

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

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

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

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

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

-- | 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 :: Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray Int
0 a
_ forall s. SmallMutableArray s a -> ST s ()
_ = SmallArray# a -> SmallArray a
forall a. SmallArray# a -> SmallArray a
SmallArray ((# #) -> SmallArray# a
forall a. (# #) -> SmallArray# a
emptySmallArray# (# #))
createSmallArray Int
n a
x forall s. SmallMutableArray s a -> ST s ()
f = (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray ((forall s. ST s (SmallMutableArray s a)) -> SmallArray a)
-> (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ do
  SmallMutableArray s a
mary <- Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n a
x
  SmallMutableArray s a -> ST s ()
forall s. SmallMutableArray s a -> ST s ()
f SmallMutableArray s a
mary
  SmallMutableArray s a -> ST s (SmallMutableArray s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallMutableArray s a
mary

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

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

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


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

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

smallArrayLiftEq :: (a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq :: (a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool
smallArrayLiftEq a -> b -> Bool
p SmallArray a
sa1 SmallArray b
sa2 = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
sa2 Bool -> Bool -> Bool
&& Int -> Bool
loop (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
sa1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
  loop :: Int -> Bool
loop Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    = Bool
True
    | (# a
x #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
sa1 Int
i
    , (# b
y #) <- SmallArray b -> Int -> (# b #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray b
sa2 Int
i
    = a -> b -> Bool
p a
x b
y Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

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

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

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

smallArrayLiftCompare :: (a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare :: (a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering
smallArrayLiftCompare a -> b -> Ordering
elemCompare SmallArray a
a1 SmallArray b
a2 = Int -> Ordering
loop Int
0
  where
  mn :: Int
mn = SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
a1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
a2
  loop :: Int -> Ordering
loop Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mn
    , (# a
x1 #) <- SmallArray a -> Int -> (# a #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
a1 Int
i
    , (# b
x2 #) <- SmallArray b -> Int -> (# b #)
forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray b
a2 Int
i
    = a -> b -> Ordering
elemCompare a
x1 b
x2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Int -> Ordering
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Bool
otherwise = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SmallArray a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray a
a1) (SmallArray b -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SmallArray b
a2)

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | @since 0.6.3.0
instance Sem.Semigroup (SmallArray a) where
  <> :: SmallArray a -> SmallArray a -> SmallArray a
(<>) = SmallArray a -> SmallArray a -> SmallArray a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  sconcat :: NonEmpty (SmallArray a) -> SmallArray a
sconcat = [SmallArray a] -> SmallArray a
forall a. Monoid a => [a] -> a
mconcat ([SmallArray a] -> SmallArray a)
-> (NonEmpty (SmallArray a) -> [SmallArray a])
-> NonEmpty (SmallArray a)
-> SmallArray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (SmallArray a) -> [SmallArray a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  stimes :: b -> SmallArray a -> SmallArray a
stimes b
n SmallArray a
arr = case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
n b
0 of
    Ordering
LT -> String -> String -> SmallArray a
forall a. String -> String -> a
die String
"stimes" String
"negative multiplier"
    Ordering
EQ -> SmallArray a
forall (f :: * -> *) a. Alternative f => f a
empty
    Ordering
GT -> Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
forall a.
Int
-> a
-> (forall s. SmallMutableArray s a -> ST s ())
-> SmallArray a
createSmallArray (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
* SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
arr) (String -> String -> a
forall a. String -> String -> a
die String
"stimes" String
"impossible") ((forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a)
-> (forall s. SmallMutableArray s a -> ST s ()) -> SmallArray a
forall a b. (a -> b) -> a -> b
$ \SmallMutableArray s a
sma ->
      let go :: Int -> ST s ()
go Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n'
            then do
              SmallMutableArray (PrimState (ST s)) a
-> Int -> SmallArray a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
sma (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
arr) SmallArray a
arr Int
0 (SmallArray a -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
arr)
              Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      in Int -> ST s ()
go Int
0
    where n' :: Int
n' = b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n :: Int

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

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

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

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

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

-- | @since 0.6.4.0
instance Show1 SmallArray where
  liftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> SmallArray a
-> String
-> String
liftShowsPrec = (Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> SmallArray a
-> String
-> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String)
-> Int
-> SmallArray a
-> String
-> String
smallArrayLiftShowsPrec

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

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

-- | @since 0.6.4.0
instance Read1 SmallArray where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
liftReadsPrec = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)
smallArrayLiftReadsPrec



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

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

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

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

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

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

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