-- |
-- Module      : Streamly.Internal.Data.Array.Generic
-- Copyright   : (c) 2019 Composewell Technologies
--
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Portability : GHC
--
module Streamly.Internal.Data.Array.Generic
    ( Array(..)

    -- * Construction
    , nil
    , createOf
    , create
    , writeWith
    , writeLastN

    , fromStreamN
    , fromStream
    , fromPureStream
    , fromByteStr#

    , fromListN
    , fromList

    , chunksOf

    -- * Elimination
    , length
    , reader

    , toList
    , read
    , readRev

    , foldl'
    , foldr
    , streamFold
    , fold

    -- * Random Access
    , getIndexUnsafe
    , getIndex
    , getSliceUnsafe
    , strip

    -- * Deprecated
    , writeN
    , write
    )
where

#include "inline.hs"

import Control.Monad (replicateM)
import Control.Monad.IO.Class (MonadIO)
import Data.Functor.Identity (Identity(..))
import Data.Word (Word8)
import GHC.Base (MutableArray#, RealWorld)
import GHC.Exts (Addr#)
import GHC.IO (unsafePerformIO)
import Text.Read (readPrec)

import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.System.IO (unsafeInlineIO)

import qualified Streamly.Internal.Data.MutArray.Generic 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.Generic as RB
import qualified Streamly.Internal.Data.Stream.Type as D
import qualified Streamly.Internal.Data.Stream.Generate as D
import qualified Text.ParserCombinators.ReadPrec as ReadPrec

import Prelude hiding (Foldable(..), read)

-------------------------------------------------------------------------------
-- Array Data Type
-------------------------------------------------------------------------------

data Array a =
    Array
        { forall a. Array a -> MutableArray# RealWorld a
arrContents# :: MutableArray# RealWorld a
          -- ^ The internal contents of the array representing the entire array.

        , forall a. Array a -> Int
arrStart :: {-# UNPACK #-}!Int
          -- ^ The starting index of this slice.

        , forall a. Array a -> Int
arrLen :: {-# UNPACK #-}!Int
          -- ^ The length of this slice.
        }

unsafeFreeze :: MArray.MutArray a -> Array a
unsafeFreeze :: forall a. 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 :: forall a. 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 :: forall a. 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

-------------------------------------------------------------------------------
-- Construction - Folds
-------------------------------------------------------------------------------

{-# INLINE_NORMAL createOf #-}
createOf :: MonadIO m => Int -> Fold m a (Array a)
createOf :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
createOf = (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.createOf

-- XXX Deprecate in major
-- {-# DEPRECATED writeN "Please use createOf instead." #-}
{-# INLINE writeN #-}
writeN :: MonadIO m => Int -> Fold m a (Array a)
writeN :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
writeN = Int -> Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (Array a)
createOf

{-# INLINE_NORMAL writeWith #-}
writeWith :: MonadIO m => Int -> Fold m a (Array a)
writeWith :: forall (m :: * -> *) a. MonadIO m => 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.createWith Int
elemCount

-- | Fold the whole input to a single array.
--
-- /Caution! Do not use this on infinite streams./
--
{-# INLINE create #-}
create :: MonadIO m => Fold m a (Array a)
create :: forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
create = (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.create

-- XXX Deprecate in major
-- {-# DEPRECATED write "Please use create instead." #-}
{-# INLINE write #-}
write :: MonadIO m => Fold m a (Array a)
write :: forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
write = Fold m a (Array a)
forall (m :: * -> *) a. MonadIO m => Fold m a (Array a)
create

fromPureStream :: Stream Identity a -> Array a
fromPureStream :: forall a. Stream Identity a -> Array a
fromPureStream Stream Identity a
x =
    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) -> IO (MutArray a) -> IO (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) (Stream Identity a -> IO (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Stream Identity a -> m (MutArray a)
MArray.fromPureStream Stream Identity a
x)
-- fromPureStream = runIdentity . D.fold (unsafeMakePure write)
-- fromPureStream = fromList . runIdentity . D.toList

fromByteStr# :: Addr# -> Array Word8
fromByteStr# :: Addr# -> Array Word8
fromByteStr# Addr#
addr = Stream Identity Word8 -> Array Word8
forall a. Stream Identity a -> Array a
fromPureStream (Addr# -> Stream Identity Word8
forall (m :: * -> *). Monad m => Addr# -> Stream m Word8
D.fromByteStr# Addr#
addr)

-------------------------------------------------------------------------------
-- Stream Ops
-------------------------------------------------------------------------------

{-# INLINE_NORMAL chunksOf #-}
chunksOf :: forall m a. MonadIO m
    => Int -> Stream m a -> Stream m (Array a)
chunksOf :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> Stream m (Array a)
chunksOf Int
n Stream m a
strm = (MutArray a -> Array a)
-> Stream m (MutArray a) -> Stream m (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 (Stream m (MutArray a) -> Stream m (Array a))
-> Stream m (MutArray a) -> Stream m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Stream m a -> Stream m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> Stream m (MutArray a)
MArray.chunksOf Int
n Stream m a
strm

-------------------------------------------------------------------------------
-- Construction - from streams
-------------------------------------------------------------------------------

{-# INLINE fromStreamN #-}
fromStreamN :: MonadIO m => Int -> Stream m a -> m (Array a)
fromStreamN :: forall (m :: * -> *) a.
MonadIO m =>
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 :: forall (m :: * -> *) a. MonadIO m => 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

-- XXX Consider foldr/build fusion in toList/fromList

{-# INLINABLE fromListN #-}
fromListN :: Int -> [a] -> Array a
fromListN :: forall a. 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 :: forall a. [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

-------------------------------------------------------------------------------
-- Elimination - Unfolds
-------------------------------------------------------------------------------

{-# INLINE length #-}
length :: Array a -> Int
length :: forall a. 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 :: forall (m :: * -> *) a. Monad m => 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)

-------------------------------------------------------------------------------
-- Elimination - to streams
-------------------------------------------------------------------------------

{-# INLINE_NORMAL toList #-}
toList :: Array a -> [a]
toList :: forall a. 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 :: forall (m :: * -> *) a. Monad m => 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 :: forall (m :: * -> *) a. Monad m => 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

-------------------------------------------------------------------------------
-- Elimination - using Folds
-------------------------------------------------------------------------------

{-# INLINE_NORMAL foldl' #-}
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' :: forall b a. (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 :: forall a b. (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 :: forall (m :: * -> *) a b. Monad m => 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 :: forall (m :: * -> *) a b.
Monad m =>
(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)

-------------------------------------------------------------------------------
-- Random reads and writes
-------------------------------------------------------------------------------

-- | /O(1)/ Lookup the element at the given index. Index starts from 0. Does
-- not check the bounds.
--
-- @since 0.8.0
{-# INLINE getIndexUnsafe #-}
getIndexUnsafe :: Int -> Array a -> a
getIndexUnsafe :: forall a. 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)

-- | Lookup the element at the given index. Index starts from 0.
--
{-# INLINE getIndex #-}
getIndex :: Int -> Array a -> Maybe a
getIndex :: forall a. Int -> Array a -> Maybe a
getIndex Int
i 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
..} =
    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 a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> Array a -> a
forall a. Int -> Array a -> a
getIndexUnsafe Int
i Array a
arr
    else Maybe a
forall a. Maybe a
Nothing

-- >>> import qualified Streamly.Data.Stream as Stream
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Array.Generic as Array
-- >>> import Data.Function ((&))
-- >>> :{
--  Stream.fromList [1,2,3,4,5::Int]
--      & Stream.scan (Array.writeLastN 2)
--      & Stream.fold Fold.toList
--  :}
-- [fromList [],fromList [1],fromList [1,2],fromList [2,3],fromList [3,4],fromList [4,5]]
--
{-# INLINE writeLastN #-}
writeLastN :: MonadIO m => Int -> Fold m a (Array a)
writeLastN :: forall (m :: * -> *) a. MonadIO m => 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.copyToMutArray 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 :: forall a. 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

-- XXX This is not efficient as it copies the array. We should support array
-- slicing so that we can just refer to the underlying array memory instead of
-- copying.

-- | Truncate the array at the beginning and end as long as the predicate
-- holds true. Returns a slice of the original array.
{-# INLINE strip #-}
strip :: (a -> Bool) -> Array a -> Array a
strip :: forall a. (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)

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

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

    -- Default definitions defined in base do not have an INLINE on them, so we
    -- replicate them here with an INLINE.
    {-# 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 }

    -- These two default methods use '<=' rather than 'compare'
    -- because the latter is often more expensive
    {-# 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