{-# LANGUAGE CPP #-}
{-# LANGUAGE UnboxedTuples #-}
module Streamly.Internal.Data.Array.Generic.Mut.Type
(
MutArray (..)
, nil
, new
, writeNUnsafe
, writeN
, writeWith
, write
, putIndex
, putIndexUnsafe
, putIndices
, modifyIndexUnsafe
, modifyIndex
, realloc
, uninit
, snocWith
, snoc
, snocUnsafe
, reader
, producerWith
, producer
, toStreamD
, readRev
, toStreamK
, toList
, getIndex
, getIndexUnsafe
, length
, strip
, cmp
, eq
, getSliceUnsafe
, getSlice
, putSliceUnsafe
, clone
)
where
#include "inline.hs"
#include "assert.hs"
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import GHC.Base
( MutableArray#
, RealWorld
, copyMutableArray#
, newArray#
, readArray#
, writeArray#
)
import GHC.IO (IO(..))
import GHC.Int (Int(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Producer.Type (Producer (..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Producer as Producer
import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
import Prelude hiding (read, length)
#include "DocTestDataMutArrayGeneric.hs"
data MutArray a =
MutArray
{ MutArray a -> MutableArray# RealWorld a
arrContents# :: MutableArray# RealWorld a
, MutArray a -> Int
arrStart :: {-# UNPACK #-}!Int
, MutArray a -> Int
arrLen :: {-# UNPACK #-}!Int
, MutArray a -> Int
arrTrueLen :: {-# UNPACK #-}!Int
}
{-# INLINE bottomElement #-}
bottomElement :: a
bottomElement :: a
bottomElement =
[Char] -> a
forall a. HasCallStack => [Char] -> a
error
([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
[ [Char]
funcName
, [Char]
"This is the bottom element of the array."
, [Char]
"This is a place holder and should never be reached!"
]
where
funcName :: [Char]
funcName = [Char]
"Streamly.Internal.Data.Array.Generic.Mut.Type.bottomElement:"
{-# INLINE new #-}
new :: MonadIO m => Int -> m (MutArray a)
new :: Int -> m (MutArray a)
new n :: Int
n@(I# Int#
n#) =
IO (MutArray a) -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
((State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a))
-> (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
case Int#
-> a
-> State# RealWorld
-> (# State# RealWorld, MutableArray# RealWorld a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
n# a
forall a. a
bottomElement State# RealWorld
s# of
(# State# RealWorld
s1#, MutableArray# RealWorld a
arr# #) ->
let ma :: MutArray a
ma = MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
forall a.
MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
MutArray MutableArray# RealWorld a
arr# Int
0 Int
0 Int
n
in (# State# RealWorld
s1#, MutArray a
ma #)
{-# INLINE nil #-}
nil :: MonadIO m => m (MutArray a)
nil :: m (MutArray a)
nil = Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
0
{-# INLINE putIndexUnsafe #-}
putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()
putIndexUnsafe :: Int -> MutArray a -> a -> m ()
putIndexUnsafe Int
i MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} a
x =
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrLen)
(IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
case Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrStart of
I# Int#
n# ->
let s1# :: State# RealWorld
s1# = MutableArray# RealWorld a
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# MutableArray# RealWorld a
arrContents# Int#
n# a
x State# RealWorld
s#
in (# State# RealWorld
s1#, () #))
invalidIndex :: String -> Int -> a
invalidIndex :: [Char] -> Int -> a
invalidIndex [Char]
label Int
i =
[Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
label [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": invalid array index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
{-# INLINE putIndex #-}
putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()
putIndex :: Int -> MutArray a -> a -> m ()
putIndex Int
i arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} a
x =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrLen
then Int -> MutArray a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> a -> m ()
putIndexUnsafe Int
i MutArray a
arr a
x
else [Char] -> Int -> m ()
forall a. [Char] -> Int -> a
invalidIndex [Char]
"putIndex" Int
i
{-# INLINE putIndices #-}
putIndices :: MonadIO m
=> MutArray a -> Fold m (Int, a) ()
putIndices :: MutArray a -> Fold m (Int, a) ()
putIndices MutArray a
arr = (() -> (Int, a) -> m ()) -> m () -> Fold m (Int, a) ()
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' () -> (Int, a) -> m ()
forall (m :: * -> *). MonadIO m => () -> (Int, a) -> m ()
step (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
where
step :: () -> (Int, a) -> m ()
step () (Int
i, a
x) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> MutArray a -> a -> IO ()
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> a -> m ()
putIndex Int
i MutArray a
arr a
x)
modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndexUnsafe :: Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndexUnsafe Int
i MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} a -> (a, b)
f = do
IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
((State# RealWorld -> (# State# RealWorld, b #)) -> IO b)
-> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
case Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrStart of
I# Int#
n# ->
case MutableArray# RealWorld a
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# MutableArray# RealWorld a
arrContents# Int#
n# State# RealWorld
s# of
(# State# RealWorld
s1#, a
a #) ->
let (a
a1, b
b) = a -> (a, b)
f a
a
s2# :: State# RealWorld
s2# = MutableArray# RealWorld a
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# MutableArray# RealWorld a
arrContents# Int#
n# a
a1 State# RealWorld
s1#
in (# State# RealWorld
s2#, b
b #)
modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndex :: Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndex Int
i arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} a -> (a, b)
f = do
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrLen
then Int -> MutArray a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndexUnsafe Int
i MutArray a
arr a -> (a, b)
f
else [Char] -> Int -> m b
forall a. [Char] -> Int -> a
invalidIndex [Char]
"modifyIndex" Int
i
realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)
realloc :: Int -> MutArray a -> m (MutArray a)
realloc Int
n MutArray a
arr = do
MutArray a
arr1 <- Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
n
let !newLen :: Int
newLen@(I# Int#
newLen#) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
arr)
!(I# Int#
arrS#) = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr
!(I# Int#
arr1S#) = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr1
arrC# :: MutableArray# RealWorld a
arrC# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
arr
arr1C# :: MutableArray# RealWorld a
arr1C# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
arr1
IO (MutArray a) -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
((State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a))
-> (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
let s1# :: State# RealWorld
s1# = MutableArray# RealWorld a
-> Int#
-> MutableArray# RealWorld a
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray# MutableArray# RealWorld a
arrC# Int#
arrS# MutableArray# RealWorld a
arr1C# Int#
arr1S# Int#
newLen# State# RealWorld
s#
in (# State# RealWorld
s1#, MutArray a
arr1 {arrLen :: Int
arrLen = Int
newLen, arrTrueLen :: Int
arrTrueLen = Int
n} #)
reallocWith ::
MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith :: [Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
label Int -> Int
sizer Int
reqSize MutArray a
arr = do
let oldSize :: Int
oldSize = MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
arr
newSize :: Int
newSize = Int -> Int
sizer Int
oldSize
safeSize :: Int
safeSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
newSize (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
reqSize)
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
newSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
reqSize Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
badSize) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (MutArray a)
realloc Int
safeSize MutArray a
arr
where
badSize :: [Char]
badSize = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Char]
label
, [Char]
": new array size is less than required size "
, Int -> [Char]
forall a. Show a => a -> [Char]
show Int
reqSize
, [Char]
". Please check the sizing function passed."
]
{-# INLINE snocUnsafe #-}
snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)
snocUnsafe :: MutArray a -> a -> m (MutArray a)
snocUnsafe arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} a
a = do
Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrTrueLen) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
let arr1 :: MutArray a
arr1 = MutArray a
arr {arrLen :: Int
arrLen = Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
Int -> MutArray a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> a -> m ()
putIndexUnsafe Int
arrLen MutArray a
arr1 a
a
MutArray a -> m (MutArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr1
{-# NOINLINE snocWithRealloc #-}
snocWithRealloc :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWithRealloc :: (Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWithRealloc Int -> Int
sizer MutArray a
arr a
x = do
MutArray a
arr1 <- [Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
"snocWithRealloc" Int -> Int
sizer Int
1 MutArray a
arr
MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
snocUnsafe MutArray a
arr1 a
x
{-# INLINE snocWith #-}
snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith :: (Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith Int -> Int
sizer arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} a
x = do
if Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrTrueLen
then MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
snocUnsafe MutArray a
arr a
x
else (Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWithRealloc Int -> Int
sizer MutArray a
arr a
x
{-# INLINE snoc #-}
snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)
snoc :: MutArray a -> a -> m (MutArray a)
snoc = (Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
{-# INLINE uninit #-}
uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)
uninit :: MutArray a -> Int -> m (MutArray a)
uninit arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} Int
len =
if Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrTrueLen
then MutArray a -> m (MutArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray a
arr {arrLen :: Int
arrLen = Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len}
else Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (MutArray a)
realloc (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) MutArray a
arr
{-# INLINE_NORMAL getIndexUnsafe #-}
getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe :: Int -> MutArray a -> m a
getIndexUnsafe Int
n MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} =
IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
let !(I# Int#
i#) = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
in MutableArray# RealWorld a
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# MutableArray# RealWorld a
arrContents# Int#
i# State# RealWorld
s#
{-# INLINE getIndex #-}
getIndex :: MonadIO m => Int -> MutArray a -> m a
getIndex :: Int -> MutArray a -> m a
getIndex Int
i arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrLen
then Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
arr
else [Char] -> Int -> m a
forall a. [Char] -> Int -> a
invalidIndex [Char]
"getIndex" Int
i
{-# INLINE getSliceUnsafe #-}
getSliceUnsafe
:: Int
-> Int
-> MutArray a
-> MutArray a
getSliceUnsafe :: Int -> Int -> MutArray a -> MutArray a
getSliceUnsafe Int
index Int
len arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} =
Bool -> MutArray a -> MutArray a
forall a. HasCallStack => Bool -> a -> a
assert (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrLen)
(MutArray a -> MutArray a) -> MutArray a -> MutArray a
forall a b. (a -> b) -> a -> b
$ MutArray a
arr {arrStart :: Int
arrStart = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index, arrLen :: Int
arrLen = Int
len}
{-# INLINE getSlice #-}
getSlice
:: Int
-> Int
-> MutArray a
-> MutArray a
getSlice :: Int -> Int -> MutArray a -> MutArray a
getSlice Int
index Int
len arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} =
if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrLen
then MutArray a
arr {arrStart :: Int
arrStart = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index, arrLen :: Int
arrLen = Int
len}
else [Char] -> MutArray a
forall a. HasCallStack => [Char] -> a
error
([Char] -> MutArray a) -> [Char] -> MutArray a
forall a b. (a -> b) -> a -> b
$ [Char]
"getSlice: invalid slice, index "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
index [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
len
{-# INLINE toList #-}
toList :: MonadIO m => MutArray a -> m [a]
toList :: MutArray a -> m [a]
toList arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} = (Int -> m a) -> [Int] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
`getIndexUnsafe` MutArray a
arr) [Int
0 .. (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
{-# INLINE_NORMAL toStreamD #-}
toStreamD :: MonadIO m => MutArray a -> D.Stream m a
toStreamD :: MutArray a -> Stream m a
toStreamD arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} =
(Int -> m a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stream m a -> Stream m b
D.mapM (Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
`getIndexUnsafe` MutArray a
arr) (Stream m Int -> Stream m a) -> Stream m Int -> Stream m a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Stream m Int
forall (m :: * -> *) a.
(Monad m, Integral a) =>
a -> a -> Stream m a
D.enumerateFromToIntegral Int
0 (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE toStreamK #-}
toStreamK :: MonadIO m => MutArray a -> K.StreamK m a
toStreamK :: MutArray a -> StreamK m a
toStreamK arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} = (Int -> m (Maybe (a, Int))) -> Int -> StreamK m a
forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> StreamK m a
K.unfoldrM Int -> m (Maybe (a, Int))
forall (m :: * -> *). MonadIO m => Int -> m (Maybe (a, Int))
step Int
0
where
step :: Int -> m (Maybe (a, Int))
step Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arrLen = Maybe (a, Int) -> m (Maybe (a, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, Int)
forall a. Maybe a
Nothing
| Bool
otherwise = do
a
x <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
arr
Maybe (a, Int) -> m (Maybe (a, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, Int) -> m (Maybe (a, Int)))
-> Maybe (a, Int) -> m (Maybe (a, Int))
forall a b. (a -> b) -> a -> b
$ (a, Int) -> Maybe (a, Int)
forall a. a -> Maybe a
Just (a
x, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE_NORMAL readRev #-}
readRev :: MonadIO m => MutArray a -> D.Stream m a
readRev :: MutArray a -> Stream m a
readRev arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrTrueLen :: Int
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrTrueLen :: forall a. MutArray a -> Int
arrLen :: forall a. MutArray a -> Int
arrStart :: forall a. MutArray a -> Int
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
..} =
(Int -> m a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stream m a -> Stream m b
D.mapM (Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
`getIndexUnsafe` MutArray a
arr)
(Stream m Int -> Stream m a) -> Stream m Int -> Stream m a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Stream m Int
forall (m :: * -> *) a.
(Monad m, Integral a) =>
a -> a -> a -> Stream m a
D.enumerateFromThenToIntegral (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
0
arrayChunkSize :: Int
arrayChunkSize :: Int
arrayChunkSize = Int
1024
{-# INLINE_NORMAL writeNUnsafe #-}
writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)
writeNUnsafe :: Int -> Fold m a (MutArray a)
writeNUnsafe Int
n = (MutArray a -> a -> m (Step (MutArray a) (MutArray a)))
-> m (Step (MutArray a) (MutArray a))
-> (MutArray a -> m (MutArray a))
-> Fold m a (MutArray a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold MutArray a -> a -> m (Step (MutArray a) (MutArray a))
forall (f :: * -> *) a b.
MonadIO f =>
MutArray a -> a -> f (Step (MutArray a) b)
step m (Step (MutArray a) (MutArray a))
forall a b. m (Step (MutArray a) b)
initial MutArray a -> m (MutArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return
where
initial :: m (Step (MutArray a) b)
initial = MutArray a -> Step (MutArray a) b
forall s b. s -> Step s b
FL.Partial (MutArray a -> Step (MutArray a) b)
-> m (MutArray a) -> m (Step (MutArray a) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0)
step :: MutArray a -> a -> f (Step (MutArray a) b)
step MutArray a
arr a
x = MutArray a -> Step (MutArray a) b
forall s b. s -> Step s b
FL.Partial (MutArray a -> Step (MutArray a) b)
-> f (MutArray a) -> f (Step (MutArray a) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutArray a -> a -> f (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
snocUnsafe MutArray a
arr a
x
{-# INLINE_NORMAL writeN #-}
writeN :: MonadIO m => Int -> Fold m a (MutArray a)
writeN :: Int -> Fold m a (MutArray a)
writeN Int
n = Int -> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
FL.take Int
n (Fold m a (MutArray a) -> Fold m a (MutArray a))
-> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall a b. (a -> b) -> a -> b
$ Int -> Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
writeNUnsafe Int
n
{-# INLINE_NORMAL writeWith #-}
writeWith :: MonadIO m => Int -> Fold m a (MutArray a)
writeWith :: Int -> Fold m a (MutArray a)
writeWith Int
elemCount = (MutArray a -> m (MutArray a))
-> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
FL.rmapM MutArray a -> m (MutArray a)
forall a. a -> m a
extract (Fold m a (MutArray a) -> Fold m a (MutArray a))
-> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall a b. (a -> b) -> a -> b
$ (MutArray a -> a -> m (MutArray a))
-> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
step m (MutArray a)
forall a. m (MutArray a)
initial
where
initial :: m (MutArray a)
initial = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
elemCount 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]
"writeWith: elemCount is negative"
IO (MutArray a) -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
elemCount
step :: MutArray a -> a -> m (MutArray a)
step arr :: MutArray a
arr@(MutArray MutableArray# RealWorld a
_ Int
start Int
end Int
bound) a
x
| Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bound = do
let oldSize :: Int
oldSize = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
newSize :: Int
newSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int
1
MutArray a
arr1 <- IO (MutArray a) -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> IO (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (MutArray a)
realloc Int
newSize MutArray a
arr
MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
snocUnsafe MutArray a
arr1 a
x
step MutArray a
arr a
x = MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
snocUnsafe MutArray a
arr a
x
extract :: a -> m a
extract = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE write #-}
write :: MonadIO m => Fold m a (MutArray a)
write :: Fold m a (MutArray a)
write = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
writeWith Int
arrayChunkSize
{-# INLINE_NORMAL producerWith #-}
producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith :: (forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith forall b. IO b -> m b
liftio = ((MutArray a, Int) -> m (Step (MutArray a, Int) a))
-> (MutArray a -> m (MutArray a, Int))
-> ((MutArray a, Int) -> m (MutArray a))
-> Producer m (MutArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> (s -> m a) -> Producer m a b
Producer (MutArray a, Int) -> m (Step (MutArray a, Int) a)
forall a. (MutArray a, Int) -> m (Step (MutArray a, Int) a)
step MutArray a -> m (MutArray a, Int)
forall (m :: * -> *) b a. (Monad m, Num b) => a -> m (a, b)
inject (MutArray a, Int) -> m (MutArray a)
forall (m :: * -> *) a.
Monad m =>
(MutArray a, Int) -> m (MutArray a)
extract
where
{-# INLINE inject #-}
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)
{-# INLINE extract #-}
extract :: (MutArray a, Int) -> m (MutArray a)
extract (MutArray a
arr, Int
i) =
MutArray a -> m (MutArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray a
arr {arrStart :: Int
arrStart = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i, arrLen :: Int
arrLen = MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i}
{-# INLINE_LATE step #-}
step :: (MutArray a, Int) -> m (Step (MutArray a, Int) a)
step (MutArray a
arr, Int
i)
| Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
arr) = Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (MutArray a, Int) a
forall s a. Step s a
D.Stop
step (MutArray a
arr, Int
i) = do
a
x <- IO a -> m a
forall b. IO b -> m b
liftio (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> IO a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
arr
Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a))
-> Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a)
forall a b. (a -> b) -> a -> b
$ a -> (MutArray a, Int) -> Step (MutArray a, Int) a
forall s a. a -> s -> Step s a
D.Yield a
x (MutArray a
arr, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE_NORMAL producer #-}
producer :: MonadIO m => Producer m (MutArray a) a
producer :: Producer m (MutArray a) a
producer = (forall b. IO b -> m b) -> Producer m (MutArray a) a
forall (m :: * -> *) a.
Monad m =>
(forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# INLINE_NORMAL reader #-}
reader :: MonadIO m => Unfold m (MutArray a) a
reader :: Unfold m (MutArray a) a
reader = Producer m (MutArray a) a -> Unfold m (MutArray a) a
forall (m :: * -> *) a b. Producer m a b -> Unfold m a b
Producer.simplify Producer m (MutArray a) a
forall (m :: * -> *) a. MonadIO m => Producer m (MutArray a) a
producer
{-# INLINE putSliceUnsafe #-}
putSliceUnsafe :: MonadIO m =>
MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
putSliceUnsafe :: MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
putSliceUnsafe MutArray a
src Int
srcStart MutArray a
dst Int
dstStart Int
len = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
assertM(Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
dst)
assertM(Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
src)
let !(I# Int#
srcStart#) = Int
srcStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
src
!(I# Int#
dstStart#) = Int
dstStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
dst
!(I# Int#
len#) = Int
len
let arrS# :: MutableArray# RealWorld a
arrS# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
src
arrD# :: MutableArray# RealWorld a
arrD# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
dst
(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> (# MutableArray# RealWorld a
-> Int#
-> MutableArray# RealWorld a
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray#
MutableArray# RealWorld a
arrS# Int#
srcStart# MutableArray# RealWorld a
arrD# Int#
dstStart# Int#
len# State# RealWorld
s#
, () #)
{-# INLINE clone #-}
clone :: MonadIO m => MutArray a -> m (MutArray a)
clone :: MutArray a -> m (MutArray a)
clone MutArray a
src = IO (MutArray a) -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ do
let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
arrLen MutArray a
src
MutArray a
dst <- Int -> IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
len
MutArray a -> Int -> MutArray a -> Int -> Int -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
putSliceUnsafe MutArray a
src Int
0 MutArray a
dst Int
0 Int
len
MutArray a -> IO (MutArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
dst
{-# INLINE length #-}
length :: MutArray a -> Int
length :: MutArray a -> Int
length = MutArray a -> Int
forall a. MutArray a -> Int
arrLen
{-# INLINE cmp #-}
cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering
cmp :: MutArray a -> MutArray a -> m Ordering
cmp MutArray a
a1 MutArray a
a2 =
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lenA1 Int
lenA2 of
Ordering
EQ -> Int -> m Ordering
forall (m :: * -> *). MonadIO m => Int -> m Ordering
loop (Int
lenA1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Ordering
x -> Ordering -> m Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
x
where
lenA1 :: Int
lenA1 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a1
lenA2 :: Int
lenA2 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a2
loop :: Int -> m Ordering
loop Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Ordering -> m Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
| Bool
otherwise = do
a
v1 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
a1
a
v2 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
a2
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
v1 a
v2 of
Ordering
EQ -> Int -> m Ordering
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Ordering
x -> Ordering -> m Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
x
{-# INLINE eq #-}
eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool
eq :: MutArray a -> MutArray a -> m Bool
eq MutArray a
a1 MutArray a
a2 =
if Int
lenA1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenA2
then Int -> m Bool
forall (m :: * -> *). MonadIO m => Int -> m Bool
loop (Int
lenA1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where
lenA1 :: Int
lenA1 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a1
lenA2 :: Int
lenA2 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a2
loop :: Int -> m Bool
loop Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = do
a
v1 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
a1
a
v2 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
a2
if a
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v2
then Int -> m Bool
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINE strip #-}
strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)
strip :: (a -> Bool) -> MutArray a -> m (MutArray a)
strip a -> Bool
p MutArray a
arr = IO (MutArray a) -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ do
let lastIndex :: Int
lastIndex = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Int
indexR <- Int -> IO Int
forall (m :: * -> *). MonadIO m => Int -> m Int
getIndexR Int
lastIndex
if Int
indexR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => m (MutArray a)
nil
else do
Int
indexL <- Int -> IO Int
forall (m :: * -> *). MonadIO m => Int -> m Int
getIndexL Int
0
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 MutArray a -> IO (MutArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr
else
let newLen :: Int
newLen = 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
in MutArray a -> IO (MutArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> IO (MutArray a)) -> MutArray a -> IO (MutArray a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MutArray a -> MutArray a
forall a. Int -> Int -> MutArray a -> MutArray a
getSliceUnsafe Int
indexL Int
newLen MutArray a
arr
where
getIndexR :: Int -> m Int
getIndexR Int
idx
| Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
| Bool
otherwise = do
a
r <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
idx MutArray a
arr
if a -> Bool
p a
r
then Int -> m Int
getIndexR (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
getIndexL :: Int -> m Int
getIndexL Int
idx = do
a
r <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
getIndexUnsafe Int
idx MutArray a
arr
if a -> Bool
p a
r
then Int -> m Int
getIndexL (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx