{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UnboxedTuples #-}
#include "inline.hs"
module Streamly.Internal.Data.Array
( Array(..)
, nil
, writeN
, write
, writeLastN
, fromStreamDN
, fromStreamD
, fromStreamN
, fromStream
, fromListN
, fromList
, length
, read
, toStreamD
, toStreamDRev
, toStream
, toStreamRev
, foldl'
, foldr
, streamFold
, fold
, getIndexUnsafe
, strip
)
where
#if !MIN_VERSION_primitive(0,7,1)
import Control.DeepSeq (NFData(..))
#endif
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Functor.Identity (runIdentity)
import Data.IORef
import GHC.Base (Int(..))
import GHC.IO (unsafePerformIO)
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Stream.Serial (SerialT(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import qualified GHC.Exts as Exts
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Ring as RB
import qualified Streamly.Internal.Data.Stream.StreamD as D
import Data.Primitive.Array hiding (fromList, fromListN)
import Prelude hiding (foldr, length, read)
{-# NOINLINE bottomElement #-}
bottomElement :: a
bottomElement :: a
bottomElement = a
forall a. HasCallStack => a
undefined
{-# NOINLINE nil #-}
nil :: Array a
nil :: Array a
nil = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ do
MutableArray RealWorld a
marr <- IO (MutableArray RealWorld a) -> IO (MutableArray RealWorld a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutableArray RealWorld a) -> IO (MutableArray RealWorld a))
-> IO (MutableArray RealWorld a) -> IO (MutableArray RealWorld a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> IO (MutableArray (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 a
forall a. a
bottomElement
IO (Array a) -> IO (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> IO (Array a)) -> IO (Array a) -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> Int -> IO (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
0 Int
0
{-# INLINE_NORMAL writeN #-}
writeN :: MonadIO m => Int -> Fold m a (Array a)
writeN :: Int -> Fold m a (Array a)
writeN Int
len = (Tuple' (MutableArray RealWorld a) Int
-> a -> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a)))
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
-> (Tuple' (MutableArray RealWorld a) Int -> m (Array a))
-> Fold m a (Array a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple' (MutableArray RealWorld a) Int
-> a -> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall (m :: * -> *) a.
MonadIO m =>
Tuple' (MutableArray RealWorld a) Int
-> a -> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
step m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall a.
m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
initial Tuple' (MutableArray RealWorld a) Int -> m (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Tuple' (MutableArray RealWorld a) Int -> m (Array a)
extract
where
{-# INLINE next #-}
next :: MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
next MutableArray RealWorld a
marr Int
i = do
let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
st :: Tuple' (MutableArray RealWorld a) Int
st = MutableArray RealWorld a
-> Int -> Tuple' (MutableArray RealWorld a) Int
forall a b. a -> b -> Tuple' a b
Tuple' MutableArray RealWorld a
marr Int
i1
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i1
then Step (Tuple' (MutableArray RealWorld a) Int) (Array a)
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' (MutableArray RealWorld a) Int) (Array a)
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a)))
-> Step (Tuple' (MutableArray RealWorld a) Int) (Array a)
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall a b. (a -> b) -> a -> b
$ Tuple' (MutableArray RealWorld a) Int
-> Step (Tuple' (MutableArray RealWorld a) Int) (Array a)
forall s b. s -> Step s b
FL.Partial Tuple' (MutableArray RealWorld a) Int
st
else (Array a -> Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
-> m (Array a)
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array a -> Step (Tuple' (MutableArray RealWorld a) Int) (Array a)
forall s b. b -> Step s b
FL.Done (m (Array a)
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a)))
-> m (Array a)
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall a b. (a -> b) -> a -> b
$ Tuple' (MutableArray RealWorld a) Int -> m (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Tuple' (MutableArray RealWorld a) Int -> m (Array a)
extract Tuple' (MutableArray RealWorld a) Int
st
initial :: m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
initial = do
MutableArray RealWorld a
marr <- IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a))
-> IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> IO (MutableArray (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
len a
forall a. a
bottomElement
MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall (m :: * -> *) a.
MonadIO m =>
MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
next MutableArray RealWorld a
marr (-Int
1)
step :: Tuple' (MutableArray RealWorld a) Int
-> a -> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
step (Tuple' MutableArray RealWorld a
marr Int
i) a
x = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
i a
x
MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
forall (m :: * -> *) a.
MonadIO m =>
MutableArray RealWorld a
-> Int
-> m (Step (Tuple' (MutableArray RealWorld a) Int) (Array a))
next MutableArray RealWorld a
marr Int
i
extract :: Tuple' (MutableArray RealWorld a) Int -> m (Array a)
extract (Tuple' MutableArray RealWorld a
marr Int
l) = IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> Int -> IO (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
0 Int
l
{-# INLINE_NORMAL write #-}
write :: MonadIO m => Fold m a (Array a)
write :: Fold m a (Array a)
write = (Tuple3' (MutableArray RealWorld a) Int Int
-> a
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) (Array a)))
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) (Array a))
-> (Tuple3' (MutableArray RealWorld a) Int Int -> m (Array a))
-> Fold m a (Array a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple3' (MutableArray RealWorld a) Int Int
-> a
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) (Array a))
forall (m :: * -> *) a b.
MonadIO m =>
Tuple3' (MutableArray RealWorld a) Int Int
-> a -> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
step m (Step (Tuple3' (MutableArray RealWorld a) Int Int) (Array a))
forall a b. m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
initial Tuple3' (MutableArray RealWorld a) Int Int -> m (Array a)
forall (m :: * -> *) a c.
MonadIO m =>
Tuple3' (MutableArray RealWorld a) Int c -> m (Array a)
extract
where
initial :: m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
initial = do
MutableArray RealWorld a
marr <- IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a))
-> IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> IO (MutableArray (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 a
forall a. a
bottomElement
Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b))
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple3' (MutableArray RealWorld a) Int Int
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
forall s b. s -> Step s b
FL.Partial (MutableArray RealWorld a
-> Int -> Int -> Tuple3' (MutableArray RealWorld a) Int Int
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' MutableArray RealWorld a
marr Int
0 Int
0)
step :: Tuple3' (MutableArray RealWorld a) Int Int
-> a -> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
step (Tuple3' MutableArray RealWorld a
marr Int
i Int
capacity) a
x
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
capacity =
let newCapacity :: Int
newCapacity = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
capacity Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int
1
in do MutableArray RealWorld a
newMarr <- IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a))
-> IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> IO (MutableArray (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
newCapacity a
forall a. a
bottomElement
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a
-> Int -> MutableArray (PrimState IO) a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
MutableArray (PrimState IO) a
newMarr Int
0 MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
0 Int
i
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
newMarr Int
i a
x
Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b))
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple3' (MutableArray RealWorld a) Int Int
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
forall s b. s -> Step s b
FL.Partial (Tuple3' (MutableArray RealWorld a) Int Int
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
-> Tuple3' (MutableArray RealWorld a) Int Int
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
forall a b. (a -> b) -> a -> b
$ MutableArray RealWorld a
-> Int -> Int -> Tuple3' (MutableArray RealWorld a) Int Int
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' MutableArray RealWorld a
newMarr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
newCapacity
| Bool
otherwise = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
i a
x
Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b))
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
-> m (Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple3' (MutableArray RealWorld a) Int Int
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
forall s b. s -> Step s b
FL.Partial (Tuple3' (MutableArray RealWorld a) Int Int
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b)
-> Tuple3' (MutableArray RealWorld a) Int Int
-> Step (Tuple3' (MutableArray RealWorld a) Int Int) b
forall a b. (a -> b) -> a -> b
$ MutableArray RealWorld a
-> Int -> Int -> Tuple3' (MutableArray RealWorld a) Int Int
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' MutableArray RealWorld a
marr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
capacity
extract :: Tuple3' (MutableArray RealWorld a) Int c -> m (Array a)
extract (Tuple3' MutableArray RealWorld a
marr Int
len c
_) = IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> Int -> IO (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
0 Int
len
{-# INLINE_NORMAL fromStreamDN #-}
fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (Array a)
fromStreamDN :: Int -> Stream m a -> m (Array a)
fromStreamDN Int
limit Stream m a
str = do
MutableArray RealWorld a
marr <- IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a))
-> IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> IO (MutableArray (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
limit Int
0) a
forall a. a
bottomElement
Int
i <-
(Int -> a -> m Int) -> m Int -> Stream m a -> m Int
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Stream m a -> m b
D.foldlM'
(\Int
i a
x -> Int
i Int -> m Int -> m Int
`seq` IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
i a
x IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
(Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0) (Stream m a -> m Int) -> Stream m a -> m Int
forall a b. (a -> b) -> a -> b
$
Int -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Applicative m =>
Int -> Stream m a -> Stream m a
D.take Int
limit Stream m a
str
IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> Int -> Int -> IO (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
0 Int
i
{-# INLINE fromStreamD #-}
fromStreamD :: MonadIO m => D.Stream m a -> m (Array a)
fromStreamD :: Stream m a -> m (Array a)
fromStreamD = Fold m a (Array a) -> Stream m a -> m (Array a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
write
{-# INLINE fromStreamN #-}
fromStreamN :: MonadIO m => Int -> SerialT m a -> m (Array a)
fromStreamN :: Int -> SerialT m a -> m (Array a)
fromStreamN Int
n (SerialT Stream m a
m) = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"fromStreamN: negative write count specified"
Int -> Stream m a -> m (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
n (Stream m a -> m (Array a)) -> Stream m a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Stream m a -> Stream m a
forall (m :: * -> *) a. Applicative m => Stream m a -> Stream m a
D.fromStreamK Stream m a
m
{-# INLINE fromStream #-}
fromStream :: MonadIO m => SerialT m a -> m (Array a)
fromStream :: SerialT m a -> m (Array a)
fromStream (SerialT Stream m a
m) = Stream m a -> m (Array a)
forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStreamD (Stream m a -> m (Array a)) -> Stream m a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Stream m a -> Stream m a
forall (m :: * -> *) a. Applicative m => Stream m a -> Stream m a
D.fromStreamK Stream m a
m
{-# INLINABLE fromListN #-}
fromListN :: Int -> [a] -> Array a
fromListN :: Int -> [a] -> Array a
fromListN Int
n [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> Stream IO a -> IO (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
n (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs
{-# INLINABLE fromList #-}
fromList :: [a] -> Array a
fromList :: [a] -> Array a
fromList [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Stream IO a -> IO (Array a)
forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStreamD (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs
{-# INLINE length #-}
length :: Array a -> Int
length :: Array a -> Int
length = Array a -> Int
forall a. Array a -> Int
sizeofArray
{-# INLINE_NORMAL read #-}
read :: Monad m => Unfold m (Array a) a
read :: Unfold m (Array a) a
read = ((Array a, Int) -> m (Step (Array a, Int) a))
-> (Array a -> m (Array a, Int)) -> Unfold m (Array a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (Array a, Int) -> m (Step (Array a, Int) a)
forall (m :: * -> *) a.
Monad m =>
(Array a, Int) -> m (Step (Array a, Int) a)
step Array a -> m (Array a, Int)
forall (m :: * -> *) b a. (Monad m, Num b) => a -> m (a, b)
inject
where
inject :: a -> m (a, b)
inject a
arr = (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
arr, b
0)
step :: (Array a, Int) -> m (Step (Array a, Int) a)
step (Array a
arr, Int
i)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array a -> Int
forall a. Array a -> Int
length Array a
arr = Step (Array a, Int) a -> m (Step (Array a, Int) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Array a, Int) a
forall s a. Step s a
D.Stop
step (Array a
arr, I# Int#
i) =
Step (Array a, Int) a -> m (Step (Array a, Int) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Array a, Int) a -> m (Step (Array a, Int) a))
-> Step (Array a, Int) a -> m (Step (Array a, Int) a)
forall a b. (a -> b) -> a -> b
$
case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
Exts.indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i of
(# a
x #) -> a -> (Array a, Int) -> Step (Array a, Int) a
forall s a. a -> s -> Step s a
D.Yield a
x (Array a
arr, Int# -> Int
I# Int#
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE_NORMAL toStreamD #-}
toStreamD :: Monad m => Array a -> D.Stream m a
toStreamD :: Array a -> Stream m a
toStreamD Array a
arr = (State Stream m a -> Int -> m (Step Int a)) -> Int -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a -> Int -> m (Step Int a)
forall (m :: * -> *) p. Monad m => p -> Int -> m (Step Int a)
step Int
0
where
{-# INLINE_LATE step #-}
step :: p -> Int -> m (Step Int a)
step p
_ Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array a -> Int
forall a. Array a -> Int
length Array a
arr = Step Int a -> m (Step Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step Int a
forall s a. Step s a
D.Stop
step p
_ (I# Int#
i) =
Step Int a -> m (Step Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Int a -> m (Step Int a)) -> Step Int a -> m (Step Int a)
forall a b. (a -> b) -> a -> b
$
case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
Exts.indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i of
(# a
x #) -> a -> Int -> Step Int a
forall s a. a -> s -> Step s a
D.Yield a
x (Int# -> Int
I# Int#
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE_NORMAL toStreamDRev #-}
toStreamDRev :: Monad m => Array a -> D.Stream m a
toStreamDRev :: Array a -> Stream m a
toStreamDRev Array a
arr = (State Stream m a -> Int -> m (Step Int a)) -> Int -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a -> Int -> m (Step Int a)
forall (m :: * -> *) p. Monad m => p -> Int -> m (Step Int a)
step (Array a -> Int
forall a. Array a -> Int
length Array a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
{-# INLINE_LATE step #-}
step :: p -> Int -> m (Step Int a)
step p
_ Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Step Int a -> m (Step Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step Int a
forall s a. Step s a
D.Stop
step p
_ (I# Int#
i) =
Step Int a -> m (Step Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Int a -> m (Step Int a)) -> Step Int a -> m (Step Int a)
forall a b. (a -> b) -> a -> b
$
case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
Exts.indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i of
(# a
x #) -> a -> Int -> Step Int a
forall s a. a -> s -> Step s a
D.Yield a
x (Int# -> Int
I# Int#
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE_EARLY toStream #-}
toStream :: Monad m => Array a -> SerialT m a
toStream :: Array a -> SerialT m a
toStream = Stream m a -> SerialT m a
forall (m :: * -> *) a. Stream m a -> SerialT m a
SerialT (Stream m a -> SerialT m a)
-> (Array a -> Stream m a) -> Array a -> SerialT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream m a -> Stream m a
forall (m :: * -> *) a. Monad m => Stream m a -> Stream m a
D.toStreamK (Stream m a -> Stream m a)
-> (Array a -> Stream m a) -> Array a -> Stream m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> Stream m a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD
{-# INLINE_EARLY toStreamRev #-}
toStreamRev :: Monad m => Array a -> SerialT m a
toStreamRev :: Array a -> SerialT m a
toStreamRev = Stream m a -> SerialT m a
forall (m :: * -> *) a. Stream m a -> SerialT m a
SerialT (Stream m a -> SerialT m a)
-> (Array a -> Stream m a) -> Array a -> SerialT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream m a -> Stream m a
forall (m :: * -> *) a. Monad m => Stream m a -> Stream m a
D.toStreamK (Stream m a -> Stream m a)
-> (Array a -> Stream m a) -> Array a -> Stream m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> Stream m a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamDRev
{-# INLINE_NORMAL foldl' #-}
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f b
z Array a
arr = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> Identity b -> b
forall a b. (a -> b) -> a -> b
$ (b -> a -> b) -> b -> Stream Identity a -> Identity b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
D.foldl' b -> a -> b
f b
z (Stream Identity a -> Identity b)
-> Stream Identity a -> Identity b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream Identity a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD Array a
arr
{-# INLINE_NORMAL foldr #-}
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f b
z Array a
arr = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> Identity b -> b
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> b -> Stream Identity a -> Identity b
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr a -> b -> b
f b
z (Stream Identity a -> Identity b)
-> Stream Identity a -> Identity b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream Identity a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD Array a
arr
#if !MIN_VERSION_primitive(0,7,1)
instance NFData a => NFData (Array a) where
{-# INLINE rnf #-}
rnf = foldl' (\_ x -> rnf x) ()
#endif
{-# INLINE fold #-}
fold :: Monad m => Fold m a b -> Array a -> m b
fold :: Fold m a b -> Array a -> m b
fold Fold m a b
f Array a
arr = Fold m a b -> Stream m a -> m b
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold Fold m a b
f (Array a -> Stream m a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
toStreamD Array a
arr)
{-# INLINE streamFold #-}
streamFold :: Monad m => (SerialT m a -> m b) -> Array a -> m b
streamFold :: (SerialT m a -> m b) -> Array a -> m b
streamFold SerialT m a -> m b
f Array a
arr = SerialT m a -> m b
f (Array a -> SerialT m a
forall (m :: * -> *) a. Monad m => Array a -> SerialT m a
toStream Array a
arr)
{-# INLINE getIndexUnsafe #-}
getIndexUnsafe :: Array a -> Int -> a
getIndexUnsafe :: Array a -> Int -> a
getIndexUnsafe = Array a -> Int -> a
forall a. Array a -> Int -> a
indexArray
{-# INLINE writeLastN #-}
writeLastN :: MonadIO m => Int -> Fold m a (Array a)
writeLastN :: Int -> Fold m a (Array a)
writeLastN Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (() -> Array a) -> Fold m a () -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Array a -> () -> Array a
forall a b. a -> b -> a
const Array a
forall a. Monoid a => a
mempty) Fold m a ()
forall (m :: * -> *) a. Monad m => Fold m a ()
FL.drain
| Bool
otherwise = (Tuple' (Ring a) Int
-> a -> m (Step (Tuple' (Ring a) Int) (Array a)))
-> m (Step (Tuple' (Ring a) Int) (Array a))
-> (Tuple' (Ring a) Int -> m (Array a))
-> Fold m a (Array a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple' (Ring a) Int
-> a -> m (Step (Tuple' (Ring a) Int) (Array a))
forall (m :: * -> *) a b.
MonadIO m =>
Tuple' (Ring a) Int -> a -> m (Step (Tuple' (Ring a) Int) b)
step m (Step (Tuple' (Ring a) Int) (Array a))
forall a b. m (Step (Tuple' (Ring a) Int) b)
initial Tuple' (Ring a) Int -> m (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Tuple' (Ring a) Int -> m (Array a)
done
where
initial :: m (Step (Tuple' (Ring a) Int) b)
initial = do
Ring a
rb <- IO (Ring a) -> m (Ring a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ring a) -> m (Ring a)) -> IO (Ring a) -> m (Ring a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ring a)
forall a. Int -> IO (Ring a)
RB.createRing Int
n
Step (Tuple' (Ring a) Int) b -> m (Step (Tuple' (Ring a) Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' (Ring a) Int) b -> m (Step (Tuple' (Ring a) Int) b))
-> Step (Tuple' (Ring a) Int) b -> m (Step (Tuple' (Ring a) Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple' (Ring a) Int -> Step (Tuple' (Ring a) Int) b
forall s b. s -> Step s b
FL.Partial (Tuple' (Ring a) Int -> Step (Tuple' (Ring a) Int) b)
-> Tuple' (Ring a) Int -> Step (Tuple' (Ring a) Int) b
forall a b. (a -> b) -> a -> b
$ Ring a -> Int -> Tuple' (Ring a) Int
forall a b. a -> b -> Tuple' a b
Tuple' Ring a
rb (Int
0 :: Int)
step :: Tuple' (Ring a) Int -> a -> m (Step (Tuple' (Ring a) Int) b)
step (Tuple' Ring a
rb Int
rh) a
x = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ring a -> Int -> a -> IO ()
forall a. Ring a -> Int -> a -> IO ()
RB.unsafeInsertRing Ring a
rb Int
rh a
x
Step (Tuple' (Ring a) Int) b -> m (Step (Tuple' (Ring a) Int) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' (Ring a) Int) b -> m (Step (Tuple' (Ring a) Int) b))
-> Step (Tuple' (Ring a) Int) b -> m (Step (Tuple' (Ring a) Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple' (Ring a) Int -> Step (Tuple' (Ring a) Int) b
forall s b. s -> Step s b
FL.Partial (Tuple' (Ring a) Int -> Step (Tuple' (Ring a) Int) b)
-> Tuple' (Ring a) Int -> Step (Tuple' (Ring a) Int) b
forall a b. (a -> b) -> a -> b
$ Ring a -> Int -> Tuple' (Ring a) Int
forall a b. a -> b -> Tuple' a b
Tuple' Ring a
rb (Int
rh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
done :: Tuple' (Ring a) Int -> m (Array a)
done (Tuple' Ring a
rb Int
rh) = do
MutableArray RealWorld a
arr' <- IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a))
-> IO (MutableArray RealWorld a) -> m (MutableArray RealWorld a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> IO (MutableArray (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
rh Int
n) (forall a. a
forall a. HasCallStack => a
undefined :: a)
Int
ref <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (IORef Int -> IO Int) -> IORef Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Ring a -> IORef Int
forall a. Ring a -> IORef Int
RB.ringHead Ring a
rb
if Int
rh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a
-> Int -> MutableArray (PrimState IO) a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
MutableArray (PrimState IO) a
arr' Int
0 (Ring a -> MutableArray (PrimState IO) a
forall a. Ring a -> MutableArray (PrimState IO) a
RB.arr Ring a
rb) Int
0 Int
ref
else do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a
-> Int -> MutableArray (PrimState IO) a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
MutableArray (PrimState IO) a
arr' Int
0 (Ring a -> MutableArray (PrimState IO) a
forall a. Ring a -> MutableArray (PrimState IO) a
RB.arr Ring a
rb) Int
ref (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ref)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a
-> Int -> MutableArray (PrimState IO) a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray MutableArray RealWorld a
MutableArray (PrimState IO) a
arr' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ref) (Ring a -> MutableArray (PrimState IO) a
forall a. Ring a -> MutableArray (PrimState IO) a
RB.arr Ring a
rb) Int
0 Int
ref
IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ MutableArray (PrimState IO) a -> IO (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
arr'
strip :: (a -> Bool) -> Array a -> Array a
strip :: (a -> Bool) -> Array a -> Array a
strip a -> Bool
p Array a
arr =
let lastIndex :: Int
lastIndex = Array a -> Int
forall a. Array a -> Int
length Array a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
indexR :: Int
indexR = Int -> Int
getIndexR Int
lastIndex
in if Int
indexR Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1
then Array a
forall a. Array a
nil
else
let indexL :: Int
indexL = Int -> Int
getIndexL Int
0
in if Int
indexL Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
indexR Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lastIndex
then Array a
arr
else Array a -> Int -> Int -> Array a
forall a. Array a -> Int -> Int -> Array a
cloneArray Array a
arr Int
indexL (Int
indexR Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
indexL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
getIndexR :: Int -> Int
getIndexR Int
idx
| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int
idx
| Bool
otherwise =
if a -> Bool
p (Array a -> Int -> a
forall a. Array a -> Int -> a
indexArray Array a
arr Int
idx) then Int -> Int
getIndexR (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else Int
idx
getIndexL :: Int -> Int
getIndexL Int
idx = if a -> Bool
p (Array a -> Int -> a
forall a. Array a -> Int -> a
indexArray Array a
arr Int
idx) then Int -> Int
getIndexL (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else Int
idx