module Streamly.Internal.Data.RingArray
( RingArray (..)
, Ring
, showRing
, createOfLast
, castMutArray
, castMutArrayWith
, unsafeCastMutArray
, unsafeCastMutArrayWith
, moveForward
, moveReverse
, moveBy
, insert
, replace
, replace_
, putIndex
, modifyIndex
, getIndex
, unsafeGetIndex
, unsafeGetHead
, toList
, toMutArray
, read
, readRev
, reader
, readerRev
, length
, byteLength
, cast
, unsafeCast
, asBytes
, asMutArray
, asMutArray_
, foldlM'
, fold
, ringsOf
, scanRingsOf
, scanCustomFoldRingsBy
, scanFoldRingsBy
, eqArray
, eqArrayN
, unsafeFoldRing
, unsafeFoldRingM
, unsafeFoldRingNM
, unsafeFoldRingFullM
, slidingWindow
, slidingWindowWith
) where
#include "ArrayMacros.h"
#include "inline.hs"
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Proxy (Proxy(..))
import Data.Word (Word8)
import Fusion.Plugin.Types (Fuse(..))
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Array.Type (Array)
import Streamly.Internal.Data.MutArray.Type (MutArray(..))
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)
import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap)
import Streamly.Internal.Data.Scanl.Type (Scanl(..))
import Streamly.Internal.Data.Stream.Step (Step(..))
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.Tuple.Strict (Tuple3Fused'(..))
import Streamly.Internal.Data.Unbox (Unbox(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import qualified Streamly.Internal.Data.Array.Type as Array
import qualified Streamly.Internal.Data.Fold.Type as Fold
import qualified Streamly.Internal.Data.MutArray.Type as MutArray
import qualified Streamly.Internal.Data.MutByteArray.Type as MutByteArray
import qualified Streamly.Internal.Data.Scanl.Type as Scanl
import qualified Streamly.Internal.Data.Stream.Transform as Stream
import qualified Streamly.Internal.Data.Stream.Type as Stream
import Prelude hiding (length, concat, read)
data RingArray a = RingArray
{ forall a. RingArray a -> MutByteArray
ringContents :: {-# UNPACK #-} !MutByteArray
, forall a. RingArray a -> Int
ringSize :: {-# UNPACK #-} !Int
, forall a. RingArray a -> Int
ringHead :: {-# UNPACK #-} !Int
}
{-# DEPRECATED Ring "Please use RingArray instead." #-}
type Ring = RingArray
{-# INLINE unsafeChangeHeadByOffset #-}
unsafeChangeHeadByOffset :: Int -> Int -> Int -> Int
unsafeChangeHeadByOffset :: Int -> Int -> Int -> Int
unsafeChangeHeadByOffset Int
rh Int
rs Int
i =
let i1 :: Int
i1 = Int
rh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
in if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rs
then Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rs
else if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs
else Int
i1
{-# INLINE changeHeadByOffset #-}
changeHeadByOffset :: Int -> Int -> Int -> Int
changeHeadByOffset :: Int -> Int -> Int -> Int
changeHeadByOffset Int
rh Int
rs Int
i =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rs Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> -Int
rs
then Int -> Int -> Int -> Int
unsafeChangeHeadByOffset Int
rh Int
rs Int
i
else [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"changeHeadByOffset: absolute value of offset must be less "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"than the ring size"
{-# INLINE moveBy #-}
moveBy :: forall a. Unbox a => Int -> RingArray a -> RingArray a
moveBy :: forall a. Unbox a => Int -> RingArray a -> RingArray a
moveBy Int
n RingArray a
rb =
let i :: Int
i = Int -> Int -> Int -> Int
changeHeadByOffset (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
in RingArray a
rb {ringHead :: Int
ringHead = Int
i}
{-# INLINE incrHeadByOffset #-}
incrHeadByOffset :: Int -> Int -> Int -> Int
incrHeadByOffset :: Int -> Int -> Int -> Int
incrHeadByOffset Int
rh Int
rs Int
n =
let rh1 :: Int
rh1 = Int
rh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
in if Int
rh1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rs
then Int
0
else Int
rh1
{-# INLINE moveForward #-}
moveForward :: forall a. Unbox a => RingArray a -> RingArray a
moveForward :: forall a. Unbox a => RingArray a -> RingArray a
moveForward rb :: RingArray a
rb@RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} =
RingArray a
rb { ringHead :: Int
ringHead = Int -> Int -> Int -> Int
incrHeadByOffset Int
ringHead Int
ringSize (SIZE_OF(a)) }
{-# INLINE decrHeadByOffset #-}
decrHeadByOffset :: Int -> Int -> Int -> Int
decrHeadByOffset :: Int -> Int -> Int -> Int
decrHeadByOffset Int
rh Int
rs Int
n =
if Int
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
then (if Int
rh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
rs else Int
rh) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
else Int
0
{-# INLINE moveReverse #-}
moveReverse :: forall a. Unbox a => RingArray a -> RingArray a
moveReverse :: forall a. Unbox a => RingArray a -> RingArray a
moveReverse rb :: RingArray a
rb@RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} =
RingArray a
rb { ringHead :: Int
ringHead = Int -> Int -> Int -> Int
decrHeadByOffset Int
ringHead Int
ringSize (SIZE_OF(a)) }
{-# INLINE unsafeCastMutArrayWith #-}
unsafeCastMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith Int
i MutArray a
arr =
RingArray
{ ringContents :: MutByteArray
ringContents = MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr
, ringSize :: Int
ringSize = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
arr
, ringHead :: Int
ringHead = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)
}
{-# INLINE unsafeCastMutArray #-}
unsafeCastMutArray :: forall a. Unbox a => MutArray a -> RingArray a
unsafeCastMutArray :: forall a. Unbox a => MutArray a -> RingArray a
unsafeCastMutArray = Int -> MutArray a -> RingArray a
forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith Int
0
{-# INLINE castMutArrayWith #-}
castMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)
castMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)
castMutArrayWith Int
i MutArray a
arr
| 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
>= MutArray a -> Int
forall a. Unbox a => MutArray a -> Int
MutArray.length MutArray a
arr
= [Char] -> Maybe (RingArray a)
forall a. HasCallStack => [Char] -> a
error [Char]
"castMutArray: index must not be negative or >= array size"
| MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
= RingArray a -> Maybe (RingArray a)
forall a. a -> Maybe a
Just (RingArray a -> Maybe (RingArray a))
-> RingArray a -> Maybe (RingArray a)
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> RingArray a
forall a. Unbox a => Int -> MutArray a -> RingArray a
unsafeCastMutArrayWith Int
i MutArray a
arr
| Bool
otherwise = Maybe (RingArray a)
forall a. Maybe a
Nothing
{-# INLINE castMutArray #-}
castMutArray :: forall a. Unbox a => MutArray a -> Maybe (RingArray a)
castMutArray :: forall a. Unbox a => MutArray a -> Maybe (RingArray a)
castMutArray = Int -> MutArray a -> Maybe (RingArray a)
forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)
castMutArrayWith Int
0
modifyIndex ::
Int -> RingArray a -> (a -> (a, b)) -> m b
modifyIndex :: forall a b (m :: * -> *).
Int -> RingArray a -> (a -> (a, b)) -> m b
modifyIndex = Int -> RingArray a -> (a -> (a, b)) -> m b
forall a. HasCallStack => a
undefined
{-# INLINE putIndex #-}
putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> a -> m ()
putIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> a -> m ()
putIndex Int
i RingArray a
ring a
x =
let j :: Int
j = Int -> Int -> Int -> Int
changeHeadByOffset (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
ring) (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
ring) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
in IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
j (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
ring) a
x
{-# INLINE insert #-}
insert ::
RingArray a -> a -> m (RingArray a)
insert :: forall a (m :: * -> *). RingArray a -> a -> m (RingArray a)
insert = RingArray a -> a -> m (RingArray a)
forall a. HasCallStack => a
undefined
{-# INLINE replace_ #-}
replace_ :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a)
replace_ :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a)
replace_ RingArray a
rb a
newVal = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb) a
newVal
RingArray a -> m (RingArray a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RingArray a -> m (RingArray a)) -> RingArray a -> m (RingArray a)
forall a b. (a -> b) -> a -> b
$ RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveForward RingArray a
rb
{-# INLINE unsafeGetRawIndex #-}
unsafeGetRawIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a
unsafeGetRawIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
i RingArray a
ring = IO a -> m a
forall 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
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
i (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
ring)
{-# INLINE replace #-}
replace :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a, a)
replace :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a, a)
replace RingArray a
rb a
newVal = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb Int -> Int -> Bool
forall a. Eq 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]
"insert: cannot insert in 0 sized ring"
a
old <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) RingArray a
rb
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb) (RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb) a
newVal
(RingArray a, a) -> m (RingArray a, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveForward RingArray a
rb, a
old)
{-# INLINE unsafeGetIndex #-}
unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a
unsafeGetIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetIndex Int
i RingArray a
ring =
let rs :: Int
rs = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
ring
j :: Int
j = Int -> Int -> Int -> Int
unsafeChangeHeadByOffset (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
ring) Int
rs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
in Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
j RingArray a
ring
{-# INLINE getIndex #-}
getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m (Maybe a)
getIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m (Maybe a)
getIndex Int
i RingArray a
ring =
let rs :: Int
rs = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
ring
in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rs Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> -Int
rs
then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetIndex Int
i RingArray a
ring
else Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
{-# INLINE unsafeGetHead #-}
unsafeGetHead :: (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead :: forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead RingArray a
ring = Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex (RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
ring) RingArray a
ring
{-# INLINE byteLength #-}
byteLength :: RingArray a -> Int
byteLength :: forall a. RingArray a -> Int
byteLength = RingArray a -> Int
forall a. RingArray a -> Int
ringSize
{-# INLINE length #-}
length :: forall a. Unbox a => RingArray a -> Int
length :: forall a. Unbox a => RingArray a -> Int
length RingArray a
rb = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` SIZE_OF(a)
{-# INLINE_NORMAL reader #-}
reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a
reader :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
reader = ((RingArray a, Int) -> m (Step (RingArray a, Int) a))
-> (RingArray a -> m (RingArray a, Int))
-> Unfold m (RingArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (RingArray a, Int) -> m (Step (RingArray a, Int) a)
forall {m :: * -> *} {a}.
(MonadIO m, Unbox a) =>
(RingArray a, Int) -> m (Step (RingArray a, Int) a)
step RingArray a -> m (RingArray a, Int)
forall {m :: * -> *} {a}.
Monad m =>
RingArray a -> m (RingArray a, Int)
inject
where
inject :: RingArray a -> m (RingArray a, Int)
inject RingArray a
rb = (RingArray a, Int) -> m (RingArray a, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RingArray a
rb, RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb)
step :: (RingArray a, Int) -> m (Step (RingArray a, Int) a)
step (RingArray a
rb, Int
n) = do
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (RingArray a, Int) a
forall s a. Step s a
Stop
else do
a
x <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead RingArray a
rb
Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a))
-> Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a b. (a -> b) -> a -> b
$ a -> (RingArray a, Int) -> Step (RingArray a, Int) a
forall s a. a -> s -> Step s a
Yield a
x (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveForward RingArray a
rb, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a))
{-# INLINE_NORMAL readerRev #-}
readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a
readerRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
readerRev = ((RingArray a, Int) -> m (Step (RingArray a, Int) a))
-> (RingArray a -> m (RingArray a, Int))
-> Unfold m (RingArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold (RingArray a, Int) -> m (Step (RingArray a, Int) a)
forall {m :: * -> *} {a}.
(MonadIO m, Unbox a) =>
(RingArray a, Int) -> m (Step (RingArray a, Int) a)
step RingArray a -> m (RingArray a, Int)
forall {m :: * -> *} {a}.
(Monad m, Unbox a) =>
RingArray a -> m (RingArray a, Int)
inject
where
inject :: RingArray a -> m (RingArray a, Int)
inject RingArray a
rb = (RingArray a, Int) -> m (RingArray a, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveReverse RingArray a
rb, RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb)
step :: (RingArray a, Int) -> m (Step (RingArray a, Int) a)
step (RingArray a
rb, Int
n) = do
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (RingArray a, Int) a
forall s a. Step s a
Stop
else do
a
x <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
unsafeGetHead RingArray a
rb
Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a))
-> Step (RingArray a, Int) a -> m (Step (RingArray a, Int) a)
forall a b. (a -> b) -> a -> b
$ a -> (RingArray a, Int) -> Step (RingArray a, Int) a
forall s a. a -> s -> Step s a
Yield a
x (RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
moveReverse RingArray a
rb, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a))
{-# INLINE_NORMAL read #-}
read :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a
read :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
read = Unfold m (RingArray a) a -> RingArray a -> Stream m a
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
Stream.unfold Unfold m (RingArray a) a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
reader
{-# INLINE_NORMAL readRev #-}
readRev :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a
readRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
readRev = Unfold m (RingArray a) a -> RingArray a -> Stream m a
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
Stream.unfold Unfold m (RingArray a) a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (RingArray a) a
readerRev
{-# INLINE scanRingsOf #-}
scanRingsOf :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m a (RingArray a)
scanRingsOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf Int
n = (Tuple3Fused' MutByteArray Int Int
-> a -> m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a)))
-> m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a))
-> (Tuple3Fused' MutByteArray Int Int -> m (RingArray a))
-> (Tuple3Fused' MutByteArray Int Int -> m (RingArray a))
-> Scanl m a (RingArray a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b
Scanl Tuple3Fused' MutByteArray Int Int
-> a -> m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a))
forall {m :: * -> *} {a} {b}.
(MonadIO m, Unbox a) =>
Tuple3Fused' MutByteArray Int Int
-> a -> m (Step (Tuple3Fused' MutByteArray Int Int) b)
step m (Step (Tuple3Fused' MutByteArray Int Int) (RingArray a))
forall {b}. m (Step (Tuple3Fused' MutByteArray Int Int) b)
initial Tuple3Fused' MutByteArray Int Int -> m (RingArray a)
forall {f :: * -> *} {a}.
Applicative f =>
Tuple3Fused' MutByteArray Int Int -> f (RingArray a)
extract Tuple3Fused' MutByteArray Int Int -> m (RingArray a)
forall {f :: * -> *} {a}.
Applicative f =>
Tuple3Fused' MutByteArray Int Int -> f (RingArray a)
extract
where
rSize :: Int
rSize = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)
initial :: m (Step (Tuple3Fused' MutByteArray Int Int) b)
initial =
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then [Char] -> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a. HasCallStack => [Char] -> a
error [Char]
"scanRingsOf: window size must be > 0"
else do
MutByteArray
mba <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
MutByteArray.new Int
rSize
Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b))
-> Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall s b. s -> Step s b
Partial (Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b)
-> Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> Tuple3Fused' MutByteArray Int Int
forall a b c. a -> b -> c -> Tuple3Fused' a b c
Tuple3Fused' MutByteArray
mba Int
0 Int
0
step :: Tuple3Fused' MutByteArray Int Int
-> a -> m (Step (Tuple3Fused' MutByteArray Int Int) b)
step (Tuple3Fused' MutByteArray
mba Int
rh Int
offset) a
a = do
RingArray MutByteArray
_ Int
_ Int
rh1 <- RingArray a -> a -> m (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a)
replace_ (MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba Int
rSize Int
rh) a
a
let offset1 :: Int
offset1 = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)
Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b))
-> Step (Tuple3Fused' MutByteArray Int Int) b
-> m (Step (Tuple3Fused' MutByteArray Int Int) b)
forall a b. (a -> b) -> a -> b
$ Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall s b. s -> Step s b
Partial (Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b)
-> Tuple3Fused' MutByteArray Int Int
-> Step (Tuple3Fused' MutByteArray Int Int) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> Tuple3Fused' MutByteArray Int Int
forall a b c. a -> b -> c -> Tuple3Fused' a b c
Tuple3Fused' MutByteArray
mba Int
rh1 Int
offset1
{-# INLINE extract #-}
extract :: Tuple3Fused' MutByteArray Int Int -> f (RingArray a)
extract (Tuple3Fused' MutByteArray
mba Int
rh Int
offset) =
let rs :: Int
rs = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
offset Int
rSize
rh1 :: Int
rh1 = if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rSize then Int
0 else Int
rh
in RingArray a -> f (RingArray a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RingArray a -> f (RingArray a)) -> RingArray a -> f (RingArray a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba Int
rs Int
rh1
{-# INLINE_NORMAL ringsOf #-}
ringsOf :: forall m a. (MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (RingArray a)
ringsOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (RingArray a)
ringsOf Int
n = Scanl m a (RingArray a) -> Stream m a -> Stream m (RingArray a)
forall (m :: * -> *) a b.
Monad m =>
Scanl m a b -> Stream m a -> Stream m b
Stream.postscanl (Int -> Scanl m a (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf Int
n)
{-# INLINE_NORMAL scanCustomFoldRingsBy #-}
scanCustomFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) =>
(RingArray a -> m b) -> Int -> Scanl m a b
scanCustomFoldRingsBy :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(RingArray a -> m b) -> Int -> Scanl m a b
scanCustomFoldRingsBy RingArray a -> m b
f = (RingArray a -> m b) -> Scanl m a (RingArray a) -> Scanl m a b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Scanl m a b -> Scanl m a c
Scanl.rmapM RingArray a -> m b
f (Scanl m a (RingArray a) -> Scanl m a b)
-> (Int -> Scanl m a (RingArray a)) -> Int -> Scanl m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scanl m a (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf
{-# INLINE scanFoldRingsBy #-}
scanFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) =>
Fold m a b -> Int -> Scanl m a b
scanFoldRingsBy :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> Int -> Scanl m a b
scanFoldRingsBy Fold m a b
f = (RingArray a -> m b) -> Int -> Scanl m a b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(RingArray a -> m b) -> Int -> Scanl m a b
scanCustomFoldRingsBy (Fold m a b -> RingArray a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> RingArray a -> m b
fold Fold m a b
f)
{-# INLINE createOfLast #-}
createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (RingArray a)
createOfLast :: forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
Int -> Fold m a (RingArray a)
createOfLast Int
n = Scanl m a (RingArray a) -> Fold m a (RingArray a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
Fold.fromScanl (Scanl m a (RingArray a) -> Fold m a (RingArray a))
-> Scanl m a (RingArray a) -> Fold m a (RingArray a)
forall a b. (a -> b) -> a -> b
$ Int -> Scanl m a (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Scanl m a (RingArray a)
scanRingsOf Int
n
{-# INLINE unsafeCast #-}
unsafeCast :: RingArray a -> RingArray b
unsafeCast :: forall a b. RingArray a -> RingArray b
unsafeCast RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} =
RingArray
{ ringContents :: MutByteArray
ringContents = MutByteArray
ringContents
, ringHead :: Int
ringHead = Int
ringHead
, ringSize :: Int
ringSize = Int
ringSize
}
asBytes :: RingArray a -> RingArray Word8
asBytes :: forall a. RingArray a -> RingArray Word8
asBytes = RingArray a -> RingArray Word8
forall a b. RingArray a -> RingArray b
unsafeCast
{-# INLINE cast #-}
cast :: forall a b. (Unbox b) => RingArray a -> Maybe (RingArray b)
cast :: forall a b. Unbox b => RingArray a -> Maybe (RingArray b)
cast RingArray a
ring =
let len :: Int
len = RingArray a -> Int
forall a. RingArray a -> Int
byteLength RingArray a
ring
r :: Int
r = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` SIZE_OF(b)
in if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
then Maybe (RingArray b)
forall a. Maybe a
Nothing
else RingArray b -> Maybe (RingArray b)
forall a. a -> Maybe a
Just (RingArray b -> Maybe (RingArray b))
-> RingArray b -> Maybe (RingArray b)
forall a b. (a -> b) -> a -> b
$ RingArray a -> RingArray b
forall a b. RingArray a -> RingArray b
unsafeCast RingArray a
ring
{-# INLINE eqArrayN #-}
eqArrayN :: RingArray a -> Array a -> Int -> IO Bool
eqArrayN :: forall a. RingArray a -> Array a -> Int -> IO Bool
eqArrayN RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} Array.Array{Int
MutByteArray
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrContents :: forall a. Array a -> MutByteArray
arrStart :: forall a. Array a -> Int
arrEnd :: forall a. Array a -> Int
..} Int
nBytes
| Int
nBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: n should be >= 0"
| Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nBytes = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: array is shorter than n"
| Int
ringSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nBytes = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: ring is shorter than n"
| Int
nBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Int
nBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p1Len = do
Int
part1 <-
MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
MutByteArray
arrContents Int
0 MutByteArray
ringContents Int
ringHead Int
nBytes
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
part1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
| Bool
otherwise = do
Int
part1 <-
MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
MutByteArray
arrContents Int
0 MutByteArray
ringContents Int
ringHead Int
p1Len
Int
part2 <-
MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp MutByteArray
arrContents Int
p1Len MutByteArray
ringContents Int
0 Int
p2Len
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
part1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
part2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
where
p1Len :: Int
p1Len = Int
ringSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ringHead
p2Len :: Int
p2Len = Int
nBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p1Len
{-# INLINE eqArray #-}
eqArray :: RingArray a -> Array a -> IO Bool
eqArray :: forall a. RingArray a -> Array a -> IO Bool
eqArray RingArray{Int
MutByteArray
ringContents :: forall a. RingArray a -> MutByteArray
ringSize :: forall a. RingArray a -> Int
ringHead :: forall a. RingArray a -> Int
ringContents :: MutByteArray
ringSize :: Int
ringHead :: Int
..} Array.Array{Int
MutByteArray
arrContents :: forall a. Array a -> MutByteArray
arrStart :: forall a. Array a -> Int
arrEnd :: forall a. Array a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
..}
| Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ringSize = [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqArrayN: array is shorter than ring"
| Bool
otherwise = do
Int
part1 <-
MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
MutByteArray
arrContents Int
0 MutByteArray
ringContents Int
ringHead Int
p1Len
Int
part2 <-
MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int
MutByteArray.unsafeByteCmp
MutByteArray
arrContents Int
p1Len MutByteArray
ringContents Int
0 Int
p2Len
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int
part1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
part2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
where
p1Len :: Int
p1Len = Int
ringSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ringHead
p2Len :: Int
p2Len = Int
ringHead
{-# INLINE_NORMAL fold #-}
fold :: forall m a b. (MonadIO m, Unbox a)
=> Fold m a b -> RingArray a -> m b
fold :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> RingArray a -> m b
fold (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
_ s -> m b
final) RingArray a
rb = do
Step s b
res <- m (Step s b)
initial
case Step s b
res of
Fold.Partial s
fs -> SPEC -> Int -> s -> m b
go SPEC
SPEC Int
rh s
fs
Fold.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
where
rh :: Int
rh = RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb
{-# INLINE go #-}
go :: SPEC -> Int -> s -> m b
go !SPEC
_ Int
index !s
fs = do
a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
Step s b
r <- s -> a -> m (Step s b)
step s
fs a
x
case Step s b
r of
Fold.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
Fold.Partial s
s -> do
let next :: Int
next = Int -> Int -> Int -> Int
incrHeadByOffset Int
index (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb) (SIZE_OF(a))
if Int
next Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rh
then s -> m b
final s
s
else SPEC -> Int -> s -> m b
go SPEC
SPEC Int
next s
s
{-# DEPRECATED unsafeFoldRing "This function will be removed in future." #-}
{-# INLINE unsafeFoldRing #-}
unsafeFoldRing :: forall a b. Unbox a
=> Int -> (b -> a -> b) -> b -> RingArray a -> IO b
unsafeFoldRing :: forall a b.
Unbox a =>
Int -> (b -> a -> b) -> b -> RingArray a -> IO b
unsafeFoldRing !Int
len b -> a -> b
f b
z RingArray a
rb = b -> Int -> IO b
forall {m :: * -> *}. MonadIO m => b -> Int -> m b
go b
z Int
0
where
go :: b -> Int -> m b
go !b
acc !Int
index
| Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
| Bool
otherwise = do
a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
b -> Int -> m b
go (b -> a -> b
f b
acc a
x) (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a))
{-# DEPRECATED unsafeFoldRingM "This function will be removed in future." #-}
{-# INLINE unsafeFoldRingM #-}
unsafeFoldRingM :: forall m a b. (MonadIO m, Unbox a)
=> Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingM :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingM !Int
len b -> a -> m b
f b
z RingArray a
rb = b -> Int -> m b
go b
z Int
0
where
go :: b -> Int -> m b
go !b
acc !Int
index
| Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
| Bool
otherwise = do
a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
b
acc1 <- b -> a -> m b
f b
acc a
x
b -> Int -> m b
go b
acc1 (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a))
{-# INLINE foldlM' #-}
foldlM' :: forall m a b. (MonadIO m, Unbox a)
=> (b -> a -> m b) -> b -> RingArray a -> m b
foldlM' :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(b -> a -> m b) -> b -> RingArray a -> m b
foldlM' b -> a -> m b
f b
z = Fold m a b -> RingArray a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Fold m a b -> RingArray a -> m b
fold ((b -> a -> m b) -> m b -> Fold m a b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
Fold.foldlM' b -> a -> m b
f (b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
z))
{-# DEPRECATED unsafeFoldRingFullM "This function will be removed in future." #-}
{-# INLINE unsafeFoldRingFullM #-}
unsafeFoldRingFullM :: forall m a b. (MonadIO m, Unbox a)
=> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingFullM :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingFullM = (b -> a -> m b) -> b -> RingArray a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(b -> a -> m b) -> b -> RingArray a -> m b
foldlM'
{-# DEPRECATED unsafeFoldRingNM "This function will be removed in future." #-}
{-# INLINE unsafeFoldRingNM #-}
unsafeFoldRingNM :: forall m a b. (MonadIO m, Unbox a)
=> Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingNM :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> (b -> a -> m b) -> b -> RingArray a -> m b
unsafeFoldRingNM Int
count b -> a -> m b
f b
z RingArray a
rb = Int -> b -> Int -> m b
forall {t}. (Eq t, Num t) => t -> b -> Int -> m b
go Int
count b
z Int
rh
where
rh :: Int
rh = RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb
go :: t -> b -> Int -> m b
go t
0 b
acc Int
_ = b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc
go !t
n !b
acc !Int
index = do
a
x <- Int -> RingArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> RingArray a -> m a
unsafeGetRawIndex Int
index RingArray a
rb
b
acc' <- b -> a -> m b
f b
acc a
x
let next :: Int
next = Int -> Int -> Int -> Int
unsafeChangeHeadByOffset Int
index (RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb) (SIZE_OF(a))
if Int
next Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rh Bool -> Bool -> Bool
|| t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
then b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc'
else t -> b -> Int -> m b
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) b
acc' Int
next
{-# INLINE asMutArray #-}
asMutArray :: RingArray a -> (MutArray a, Int)
asMutArray :: forall a. RingArray a -> (MutArray a, Int)
asMutArray RingArray a
rb =
( MutArray
{ arrContents :: MutByteArray
arrContents = RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb
, arrStart :: Int
arrStart = Int
0
, arrEnd :: Int
arrEnd = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
, arrBound :: Int
arrBound = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
}
, RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb
)
{-# INLINE asMutArray_ #-}
asMutArray_ :: RingArray a -> MutArray a
asMutArray_ :: forall a. RingArray a -> MutArray a
asMutArray_ RingArray a
rb =
MutArray
{ arrContents :: MutByteArray
arrContents = RingArray a -> MutByteArray
forall a. RingArray a -> MutByteArray
ringContents RingArray a
rb
, arrStart :: Int
arrStart = Int
0
, arrEnd :: Int
arrEnd = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
, arrBound :: Int
arrBound = RingArray a -> Int
forall a. RingArray a -> Int
ringSize RingArray a
rb
}
{-# INLINE toMutArray #-}
toMutArray :: (MonadIO m, Unbox a) => RingArray a -> m (MutArray a)
toMutArray :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m (MutArray a)
toMutArray RingArray a
rb = Int -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> m (MutArray a)
MutArray.fromStreamN (RingArray a -> Int
forall a. Unbox a => RingArray a -> Int
length RingArray a
rb) (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ RingArray a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
read RingArray a
rb
{-# INLINE toList #-}
toList :: (MonadIO m, Unbox a) => RingArray a -> m [a]
toList :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m [a]
toList = Stream m a -> m [a]
forall (m :: * -> *) a. Monad m => Stream m a -> m [a]
Stream.toList (Stream m a -> m [a])
-> (RingArray a -> Stream m a) -> RingArray a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RingArray a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> Stream m a
read
showRing :: (Unbox a, Show a) => RingArray a -> IO String
showRing :: forall a. (Unbox a, Show a) => RingArray a -> IO [Char]
showRing RingArray a
rb = [a] -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> [Char]) -> IO [a] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RingArray a -> IO [a]
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m [a]
toList RingArray a
rb
{-# ANN type SlidingWindow Fuse #-}
data SlidingWindow a s = SWArray !a !Int !s !Int | SWRing !a !Int !s
{-# DEPRECATED slidingWindowWith "Please use Scanl.incrScanWith instead." #-}
{-# INLINE slidingWindowWith #-}
slidingWindowWith :: forall m a b. (MonadIO m, Unbox a)
=> Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
slidingWindowWith :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
slidingWindowWith Int
n (Fold s -> ((a, Maybe a), m (MutArray a)) -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) =
(SlidingWindow MutByteArray s
-> a -> m (Step (SlidingWindow MutByteArray s) b))
-> m (Step (SlidingWindow MutByteArray s) b)
-> (SlidingWindow MutByteArray s -> m b)
-> (SlidingWindow MutByteArray s -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold SlidingWindow MutByteArray s
-> a -> m (Step (SlidingWindow MutByteArray s) b)
step m (Step (SlidingWindow MutByteArray s) b)
initial SlidingWindow MutByteArray s -> m b
forall {a}. SlidingWindow a s -> m b
extract SlidingWindow MutByteArray s -> m b
forall {a}. SlidingWindow a s -> m b
final
where
initial :: m (Step (SlidingWindow MutByteArray s) b)
initial = do
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then [Char] -> m (Step (SlidingWindow MutByteArray s) b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Window size must be > 0"
else do
Step s b
r <- m (Step s b)
initial1
MutArray a
arr :: MutArray.MutArray a <- IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m 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, Unbox a) =>
Int -> m (MutArray a)
MutArray.emptyOf Int
n
Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b))
-> Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a b. (a -> b) -> a -> b
$
case Step s b
r of
Partial s
s -> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial
(SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> Int -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> Int -> SlidingWindow a s
SWArray (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
MutArray.arrContents MutArray a
arr) Int
0 s
s (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Done b
b -> b -> Step (SlidingWindow MutByteArray s) b
forall s b. b -> Step s b
Done b
b
step :: SlidingWindow MutByteArray s
-> a -> m (Step (SlidingWindow MutByteArray s) b)
step (SWArray MutByteArray
mba Int
rh s
st Int
i) a
a = do
RingArray MutByteArray
_ Int
_ Int
rh1 <- RingArray a -> a -> m (RingArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a)
replace_ (MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)) rh) a
let size :: Int
size = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)
Step s b
r <- s -> ((a, Maybe a), m (MutArray a)) -> m (Step s b)
step1 s
st ((a
a, Maybe a
forall a. Maybe a
Nothing), MutArray a -> m (MutArray a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
mba Int
0 Int
size Int
size))
Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b))
-> Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a b. (a -> b) -> a -> b
$
case Step s b
r of
Partial s
s ->
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial (SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> Int -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> Int -> SlidingWindow a s
SWArray MutByteArray
mba Int
rh1 s
s (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial (SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> SlidingWindow a s
SWRing MutByteArray
mba Int
rh1 s
s
Done b
b -> b -> Step (SlidingWindow MutByteArray s) b
forall s b. b -> Step s b
Done b
b
step (SWRing MutByteArray
mba Int
rh s
st) a
a = do
(rb1 :: RingArray a
rb1@(RingArray MutByteArray
_ Int
_ Int
rh1), a
old) <-
RingArray a -> a -> m (RingArray a, a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a, a)
replace (MutByteArray -> Int -> Int -> RingArray a
forall a. MutByteArray -> Int -> Int -> RingArray a
RingArray MutByteArray
mba (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)) rh) a
Step s b
r <- s -> ((a, Maybe a), m (MutArray a)) -> m (Step s b)
step1 s
st ((a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
old), RingArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> m (MutArray a)
toMutArray RingArray a
rb1)
Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b))
-> Step (SlidingWindow MutByteArray s) b
-> m (Step (SlidingWindow MutByteArray s) b)
forall a b. (a -> b) -> a -> b
$
case Step s b
r of
Partial s
s -> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall s b. s -> Step s b
Partial (SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b)
-> SlidingWindow MutByteArray s
-> Step (SlidingWindow MutByteArray s) b
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> s -> SlidingWindow MutByteArray s
forall a s. a -> Int -> s -> SlidingWindow a s
SWRing MutByteArray
mba Int
rh1 s
s
Done b
b -> b -> Step (SlidingWindow MutByteArray s) b
forall s b. b -> Step s b
Done b
b
extract :: SlidingWindow a s -> m b
extract (SWArray a
_ Int
_ s
st Int
_) = s -> m b
extract1 s
st
extract (SWRing a
_ Int
_ s
st) = s -> m b
extract1 s
st
final :: SlidingWindow a s -> m b
final (SWArray a
_ Int
_ s
st Int
_) = s -> m b
final1 s
st
final (SWRing a
_ Int
_ s
st) = s -> m b
final1 s
st
{-# DEPRECATED slidingWindow "Please use Scanl.incrScan instead." #-}
{-# INLINE slidingWindow #-}
slidingWindow :: forall m a b. (MonadIO m, Unbox a)
=> Int -> Fold m (a, Maybe a) b -> Fold m a b
slidingWindow :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> Fold m (a, Maybe a) b -> Fold m a b
slidingWindow Int
n Fold m (a, Maybe a) b
f = Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b
slidingWindowWith Int
n ((((a, Maybe a), m (MutArray a)) -> (a, Maybe a))
-> Fold m (a, Maybe a) b -> Fold m ((a, Maybe a), m (MutArray a)) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap ((a, Maybe a), m (MutArray a)) -> (a, Maybe a)
forall a b. (a, b) -> a
fst Fold m (a, Maybe a) b
f)