module Streamly.Internal.Data.Array.Generic
( Array(..)
, nil
, writeN
, write
, writeWith
, writeLastN
, fromStreamN
, fromStream
, fromListN
, fromList
, length
, reader
, toList
, read
, readRev
, foldl'
, foldr
, streamFold
, fold
, getIndexUnsafe
, getSliceUnsafe
, strip
)
where
#include "inline.hs"
import Control.Monad (replicateM)
import Control.Monad.IO.Class (MonadIO)
import GHC.Base (MutableArray#, RealWorld)
import GHC.IO (unsafePerformIO)
import Text.Read (readPrec)
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Stream.StreamD.Type (Stream)
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.System.IO (unsafeInlineIO)
import qualified Streamly.Internal.Data.Array.Generic.Mut.Type as MArray
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Producer.Type as Producer
import qualified Streamly.Internal.Data.Producer as Producer
import qualified Streamly.Internal.Data.Ring as RB
import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
import Prelude hiding (foldr, length, read)
data Array a =
Array
{ Array a -> MutableArray# RealWorld a
arrContents# :: MutableArray# RealWorld a
, Array a -> Int
arrStart :: {-# UNPACK #-}!Int
, Array a -> Int
arrLen :: {-# UNPACK #-}!Int
}
unsafeFreeze :: MArray.MutArray a -> Array a
unsafeFreeze :: MutArray a -> Array a
unsafeFreeze (MArray.MutArray MutableArray# RealWorld a
cont# Int
arrS Int
arrL Int
_) = MutableArray# RealWorld a -> Int -> Int -> Array a
forall a. MutableArray# RealWorld a -> Int -> Int -> Array a
Array MutableArray# RealWorld a
cont# Int
arrS Int
arrL
unsafeThaw :: Array a -> MArray.MutArray a
unsafeThaw :: Array a -> MutArray a
unsafeThaw (Array MutableArray# RealWorld a
cont# Int
arrS Int
arrL) = MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
forall a.
MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
MArray.MutArray MutableArray# RealWorld a
cont# Int
arrS Int
arrL Int
arrL
{-# NOINLINE nil #-}
nil :: Array a
nil :: Array a
nil = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (MutArray a -> Array a) -> IO (MutArray a) -> IO (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => m (MutArray a)
MArray.nil
{-# INLINE_NORMAL writeN #-}
writeN :: MonadIO m => Int -> Fold m a (Array a)
writeN :: Int -> Fold m a (Array a)
writeN = (MutArray a -> Array a)
-> Fold m a (MutArray a) -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (Fold m a (MutArray a) -> Fold m a (Array a))
-> (Int -> Fold m a (MutArray a)) -> Int -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
MArray.writeN
{-# INLINE_NORMAL writeWith #-}
writeWith :: MonadIO m => Int -> Fold m a (Array a)
writeWith :: Int -> Fold m a (Array a)
writeWith Int
elemCount = MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (MutArray a -> Array a)
-> Fold m a (MutArray a) -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
MArray.writeWith Int
elemCount
{-# INLINE write #-}
write :: MonadIO m => Fold m a (Array a)
write :: Fold m a (Array a)
write = (MutArray a -> Array a)
-> Fold m a (MutArray a) -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Fold m a (MutArray a)
MArray.write
{-# INLINE fromStreamN #-}
fromStreamN :: MonadIO m => Int -> Stream m a -> m (Array a)
fromStreamN :: Int -> Stream m a -> m (Array a)
fromStreamN Int
n = Fold m a (Array a) -> Stream m a -> m (Array a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold (Int -> Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
writeN Int
n)
{-# INLINE fromStream #-}
fromStream :: MonadIO m => Stream m a -> m (Array a)
fromStream :: Stream m a -> m (Array a)
fromStream = Fold m a (Array a) -> Stream m a -> m (Array a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
write
{-# INLINABLE fromListN #-}
fromListN :: Int -> [a] -> Array a
fromListN :: Int -> [a] -> Array a
fromListN Int
n [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> Stream IO a -> IO (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (Array a)
fromStreamN Int
n (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs
{-# INLINABLE fromList #-}
fromList :: [a] -> Array a
fromList :: [a] -> Array a
fromList [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Stream IO a -> IO (Array a)
forall (m :: * -> *) a. MonadIO m => Stream m a -> m (Array a)
fromStream (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs
{-# INLINE length #-}
length :: Array a -> Int
length :: Array a -> Int
length = Array a -> Int
forall a. Array a -> Int
arrLen
{-# INLINE_NORMAL reader #-}
reader :: Monad m => Unfold m (Array a) a
reader :: Unfold m (Array a) a
reader =
Producer m (Array a) a -> Unfold m (Array a) a
forall (m :: * -> *) a b. Producer m a b -> Unfold m a b
Producer.simplify
(Producer m (Array a) a -> Unfold m (Array a) a)
-> Producer m (Array a) a -> Unfold m (Array a) a
forall a b. (a -> b) -> a -> b
$ (Array a -> MutArray a)
-> (MutArray a -> Array a)
-> Producer m (MutArray a) a
-> Producer m (Array a) a
forall (m :: * -> *) a c b.
Functor m =>
(a -> c) -> (c -> a) -> Producer m c b -> Producer m a b
Producer.translate Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze
(Producer m (MutArray a) a -> Producer m (Array a) a)
-> Producer m (MutArray a) a -> Producer m (Array a) a
forall a b. (a -> b) -> a -> b
$ (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
MArray.producerWith (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (IO b -> b) -> IO b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO b -> b
forall a. IO a -> a
unsafeInlineIO)
{-# INLINE_NORMAL toList #-}
toList :: Array a -> [a]
toList :: Array a -> [a]
toList Array a
arr = Int -> [a]
loop Int
0
where
len :: Int
len = Array a -> Int
forall a. Array a -> Int
length Array a
arr
loop :: Int -> [a]
loop Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = []
loop Int
i = Int -> Array a -> a
forall a. Int -> Array a -> a
getIndexUnsafe Int
i Array a
arr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE_NORMAL read #-}
read :: Monad m => Array a -> Stream m a
read :: Array a -> Stream m a
read arr :: Array a
arr@Array{Int
MutableArray# RealWorld a
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrLen :: forall a. Array a -> Int
arrStart :: forall a. Array a -> Int
arrContents# :: forall a. Array a -> MutableArray# RealWorld a
..} =
(Int -> a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
D.map (Int -> Array a -> a
forall a. Int -> Array a -> a
`getIndexUnsafe` Array 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_NORMAL readRev #-}
readRev :: Monad m => Array a -> Stream m a
readRev :: Array a -> Stream m a
readRev arr :: Array a
arr@Array{Int
MutableArray# RealWorld a
arrLen :: Int
arrStart :: Int
arrContents# :: MutableArray# RealWorld a
arrLen :: forall a. Array a -> Int
arrStart :: forall a. Array a -> Int
arrContents# :: forall a. Array a -> MutableArray# RealWorld a
..} =
(Int -> a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
D.map (Int -> Array a -> a
forall a. Int -> Array a -> a
`getIndexUnsafe` Array 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
{-# INLINE_NORMAL foldl' #-}
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f b
z Array a
arr = IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ (b -> a -> b) -> b -> Stream IO a -> IO b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
D.foldl' b -> a -> b
f b
z (Stream IO a -> IO b) -> Stream IO a -> IO b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream IO a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read Array a
arr
{-# INLINE_NORMAL foldr #-}
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f b
z Array a
arr = IO b -> b
forall a. IO a -> a
unsafePerformIO (IO b -> b) -> IO b -> b
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> b -> Stream IO a -> IO b
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr a -> b -> b
f b
z (Stream IO a -> IO b) -> Stream IO a -> IO b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream IO a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read Array a
arr
{-# INLINE fold #-}
fold :: Monad m => Fold m a b -> Array a -> m b
fold :: Fold m a b -> Array a -> m b
fold Fold m a b
f Array a
arr = Fold m a b -> Stream m a -> m b
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold Fold m a b
f (Array a -> Stream m a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read Array a
arr)
{-# INLINE streamFold #-}
streamFold :: Monad m => (Stream m a -> m b) -> Array a -> m b
streamFold :: (Stream m a -> m b) -> Array a -> m b
streamFold Stream m a -> m b
f Array a
arr = Stream m a -> m b
f (Array a -> Stream m a
forall (m :: * -> *) a. Monad m => Array a -> Stream m a
read Array a
arr)
{-# INLINE getIndexUnsafe #-}
getIndexUnsafe :: Int -> Array a -> a
getIndexUnsafe :: Int -> Array a -> a
getIndexUnsafe Int
i Array a
arr =
IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> IO a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
MArray.getIndexUnsafe Int
i (Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr)
{-# INLINE writeLastN #-}
writeLastN :: MonadIO m => Int -> Fold m a (Array a)
writeLastN :: Int -> Fold m a (Array a)
writeLastN Int
n = (Ring a -> m (Array a)) -> Fold m a (Ring a) -> Fold m a (Array a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
FL.rmapM Ring a -> m (Array a)
forall (m :: * -> *) a. MonadIO m => Ring a -> m (Array a)
f (Int -> Fold m a (Ring a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Ring a)
RB.writeLastN Int
n)
where
f :: Ring a -> m (Array a)
f Ring a
rb = do
MutArray a
arr <- Int -> Int -> Ring a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Int -> Ring a -> m (MutArray a)
RB.toMutArray Int
0 Int
n Ring a
rb
Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze MutArray a
arr
{-# INLINE getSliceUnsafe #-}
getSliceUnsafe :: Int -> Int -> Array a -> Array a
getSliceUnsafe :: Int -> Int -> Array a -> Array a
getSliceUnsafe Int
offset Int
len (Array MutableArray# RealWorld a
cont Int
off1 Int
_) = MutableArray# RealWorld a -> Int -> Int -> Array a
forall a. MutableArray# RealWorld a -> Int -> Int -> Array a
Array MutableArray# RealWorld a
cont (Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Int
len
{-# INLINE strip #-}
strip :: (a -> Bool) -> Array a -> Array a
strip :: (a -> Bool) -> Array a -> Array a
strip a -> Bool
p Array a
arr = MutArray a -> Array a
forall a. MutArray a -> Array a
unsafeFreeze (MutArray a -> Array a) -> MutArray a -> Array a
forall a b. (a -> b) -> a -> b
$ IO (MutArray a) -> MutArray a
forall a. IO a -> a
unsafePerformIO (IO (MutArray a) -> MutArray a) -> IO (MutArray a) -> MutArray a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> MutArray a -> IO (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
(a -> Bool) -> MutArray a -> m (MutArray a)
MArray.strip a -> Bool
p (Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr)
instance Eq a => Eq (Array a) where
{-# INLINE (==) #-}
Array a
arr1 == :: Array a -> Array a -> Bool
== Array a
arr2 =
IO Bool -> Bool
forall a. IO a -> a
unsafeInlineIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$! Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr1 MutArray a -> MutArray a -> IO Bool
forall (m :: * -> *) a.
(MonadIO m, Eq a) =>
MutArray a -> MutArray a -> m Bool
`MArray.eq` Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr2
instance Ord a => Ord (Array a) where
{-# INLINE compare #-}
compare :: Array a -> Array a -> Ordering
compare Array a
arr1 Array a
arr2 =
IO Ordering -> Ordering
forall a. IO a -> a
unsafeInlineIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$! Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr1 MutArray a -> MutArray a -> IO Ordering
forall (m :: * -> *) a.
(MonadIO m, Ord a) =>
MutArray a -> MutArray a -> m Ordering
`MArray.cmp` Array a -> MutArray a
forall a. Array a -> MutArray a
unsafeThaw Array a
arr2
{-# INLINE (<) #-}
Array a
x < :: Array a -> Array a -> Bool
< Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
LT -> Bool
True; Ordering
_ -> Bool
False }
{-# INLINE (<=) #-}
Array a
x <= :: Array a -> Array a -> Bool
<= Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
GT -> Bool
False; Ordering
_ -> Bool
True }
{-# INLINE (>) #-}
Array a
x > :: Array a -> Array a -> Bool
> Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
GT -> Bool
True; Ordering
_ -> Bool
False }
{-# INLINE (>=) #-}
Array a
x >= :: Array a -> Array a -> Bool
>= Array a
y = case Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
LT -> Bool
False; Ordering
_ -> Bool
True }
{-# INLINE max #-}
max :: Array a -> Array a -> Array a
max Array a
x Array a
y = if Array a
x Array a -> Array a -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a
y then Array a
y else Array a
x
{-# INLINE min #-}
min :: Array a -> Array a -> Array a
min Array a
x Array a
y = if Array a
x Array a -> Array a -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a
y then Array a
x else Array a
y
instance Show a => Show (Array a) where
{-# INLINE show #-}
show :: Array a -> String
show Array a
arr = String
"fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show (Array a -> [a]
forall a. Array a -> [a]
toList Array a
arr)
instance Read a => Read (Array a) where
{-# INLINE readPrec #-}
readPrec :: ReadPrec (Array a)
readPrec = do
String
fromListWord <- Int -> ReadPrec Char -> ReadPrec String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
9 ReadPrec Char
ReadPrec.get
if String
fromListWord String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"fromList "
then [a] -> Array a
forall a. [a] -> Array a
fromList ([a] -> Array a) -> ReadPrec [a] -> ReadPrec (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
else ReadPrec (Array a)
forall a. ReadPrec a
ReadPrec.pfail