{-# LANGUAGE CPP, MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Primitive.Array (
Array(..), MutableArray(..),
newArray, readArray, writeArray, indexArray, indexArrayM, indexArray##,
freezeArray, thawArray, runArray, createArray,
unsafeFreezeArray, unsafeThawArray, sameMutableArray,
copyArray, copyMutableArray,
cloneArray, cloneMutableArray,
sizeofArray, sizeofMutableArray,
emptyArray,
fromListN, fromList,
arrayFromListN, arrayFromList,
mapArray',
traverseArrayP
) where
import Control.DeepSeq
import Control.Monad.Primitive
import GHC.Exts hiding (toList)
import qualified GHC.Exts as Exts
import Data.Typeable ( Typeable )
import Data.Data
(Data(..), DataType, mkDataType, mkNoRepType, Constr, mkConstr, Fixity(..), constrIndex)
import Control.Monad.ST (ST, runST)
import Control.Applicative
import Control.Monad (MonadPlus(..), when, liftM2)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import qualified Data.Foldable as Foldable
import Control.Monad.Zip
import Data.Foldable (Foldable(..), toList)
#if MIN_VERSION_base(4,9,0)
import qualified GHC.ST as GHCST
import qualified Data.Foldable as F
import Data.Semigroup
#endif
import Data.Functor.Identity
#if MIN_VERSION_base(4,10,0)
import GHC.Exts (runRW#)
#elif MIN_VERSION_base(4,9,0)
import GHC.Base (runRW#)
#endif
import Text.Read (Read (..), parens, prec)
import Text.ParserCombinators.ReadPrec (ReadPrec)
import qualified Text.ParserCombinators.ReadPrec as RdPrc
import Text.ParserCombinators.ReadP
import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..), Read1(..))
data Array a = Array
{ Array a -> Array# a
array# :: Array# a }
deriving ( Typeable )
#if MIN_VERSION_deepseq(1,4,3)
instance NFData1 Array where
liftRnf :: (a -> ()) -> Array a -> ()
liftRnf a -> ()
r = (() -> a -> ()) -> () -> Array a -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\()
_ -> a -> ()
r) ()
#endif
instance NFData a => NFData (Array a) where
rnf :: Array a -> ()
rnf = (() -> a -> ()) -> () -> Array a -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\()
_ -> a -> ()
forall a. NFData a => a -> ()
rnf) ()
data MutableArray s a = MutableArray
{ MutableArray s a -> MutableArray# s a
marray# :: MutableArray# s a }
deriving ( Typeable )
sizeofArray :: Array a -> Int
sizeofArray :: Array a -> Int
sizeofArray Array a
a = Int# -> Int
I# (Array# a -> Int#
forall a. Array# a -> Int#
sizeofArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
a))
{-# INLINE sizeofArray #-}
sizeofMutableArray :: MutableArray s a -> Int
sizeofMutableArray :: MutableArray s a -> Int
sizeofMutableArray MutableArray s a
a = Int# -> Int
I# (MutableArray# s a -> Int#
forall d a. MutableArray# d a -> Int#
sizeofMutableArray# (MutableArray s a -> MutableArray# s a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
a))
{-# INLINE sizeofMutableArray #-}
newArray :: PrimMonad m => Int -> a -> m (MutableArray (PrimState m) a)
{-# INLINE newArray #-}
newArray :: Int -> a -> m (MutableArray (PrimState m) a)
newArray (I# Int#
n#) a
x = (State# (PrimState m)
-> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
(\State# (PrimState m)
s# -> case Int#
-> a
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
n# a
x State# (PrimState m)
s# of
(# State# (PrimState m)
s'#, MutableArray# (PrimState m) a
arr# #) ->
let ma :: MutableArray (PrimState m) a
ma = MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr#
in (# State# (PrimState m)
s'# , MutableArray (PrimState m) a
ma #))
readArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m a
{-# INLINE readArray #-}
readArray :: MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray (PrimState m) a
arr (I# Int#
i#) = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (MutableArray# (PrimState m) a
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# (MutableArray (PrimState m) a -> MutableArray# (PrimState m) a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray (PrimState m) a
arr) Int#
i#)
writeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> a -> m ()
{-# INLINE writeArray #-}
writeArray :: MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray (PrimState m) a
arr (I# Int#
i#) a
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableArray# (PrimState m) a
-> Int# -> a -> State# (PrimState m) -> State# (PrimState m)
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# (MutableArray (PrimState m) a -> MutableArray# (PrimState m) a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray (PrimState m) a
arr) Int#
i# a
x)
indexArray :: Array a -> Int -> a
{-# INLINE indexArray #-}
indexArray :: Array a -> Int -> a
indexArray Array a
arr (I# Int#
i#) = case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i# of (# a
x #) -> a
x
indexArray## :: Array a -> Int -> (# a #)
indexArray## :: Array a -> Int -> (# a #)
indexArray## Array a
arr (I# Int#
i) = Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i
{-# INLINE indexArray## #-}
indexArrayM :: Monad m => Array a -> Int -> m a
{-# INLINE indexArrayM #-}
indexArrayM :: Array a -> Int -> m a
indexArrayM Array a
arr (I# Int#
i#)
= case Array# a -> Int# -> (# a #)
forall a. Array# a -> Int# -> (# a #)
indexArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
arr) Int#
i# of (# a
x #) -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
freezeArray
:: PrimMonad m
=> MutableArray (PrimState m) a
-> Int
-> Int
-> m (Array a)
{-# INLINE freezeArray #-}
freezeArray :: MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray (MutableArray MutableArray# (PrimState m) a
ma#) (I# Int#
off#) (I# Int#
len#) =
(State# (PrimState m) -> (# State# (PrimState m), Array a #))
-> m (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), Array a #))
-> m (Array a))
-> (State# (PrimState m) -> (# State# (PrimState m), Array a #))
-> m (Array a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), Array# a #)
forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, Array# a #)
freezeArray# MutableArray# (PrimState m) a
ma# Int#
off# Int#
len# State# (PrimState m)
s of
(# State# (PrimState m)
s', Array# a
a# #) -> (# State# (PrimState m)
s', Array# a -> Array a
forall a. Array# a -> Array a
Array Array# a
a# #)
unsafeFreezeArray :: PrimMonad m => MutableArray (PrimState m) a -> m (Array a)
{-# INLINE unsafeFreezeArray #-}
unsafeFreezeArray :: MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) a
arr
= (State# (PrimState m) -> (# State# (PrimState m), Array a #))
-> m (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case MutableArray# (PrimState m) a
-> State# (PrimState m) -> (# State# (PrimState m), Array# a #)
forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
unsafeFreezeArray# (MutableArray (PrimState m) a -> MutableArray# (PrimState m) a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray (PrimState m) a
arr) State# (PrimState m)
s# of
(# State# (PrimState m)
s'#, Array# a
arr'# #) ->
let a :: Array a
a = Array# a -> Array a
forall a. Array# a -> Array a
Array Array# a
arr'#
in (# State# (PrimState m)
s'#, Array a
a #))
thawArray
:: PrimMonad m
=> Array a
-> Int
-> Int
-> m (MutableArray (PrimState m) a)
{-# INLINE thawArray #-}
thawArray :: Array a -> Int -> Int -> m (MutableArray (PrimState m) a)
thawArray (Array Array# a
a#) (I# Int#
off#) (I# Int#
len#) =
(State# (PrimState m)
-> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m)
-> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a))
-> (State# (PrimState m)
-> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case Array# a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
forall a d.
Array# a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
thawArray# Array# a
a# Int#
off# Int#
len# State# (PrimState m)
s of
(# State# (PrimState m)
s', MutableArray# (PrimState m) a
ma# #) -> (# State# (PrimState m)
s', MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
ma# #)
unsafeThawArray :: PrimMonad m => Array a -> m (MutableArray (PrimState m) a)
{-# INLINE unsafeThawArray #-}
unsafeThawArray :: Array a -> m (MutableArray (PrimState m) a)
unsafeThawArray Array a
a
= (State# (PrimState m)
-> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case Array# a
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
forall a d.
Array# a -> State# d -> (# State# d, MutableArray# d a #)
unsafeThawArray# (Array a -> Array# a
forall a. Array a -> Array# a
array# Array a
a) State# (PrimState m)
s# of
(# State# (PrimState m)
s'#, MutableArray# (PrimState m) a
arr'# #) ->
let ma :: MutableArray (PrimState m) a
ma = MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr'#
in (# State# (PrimState m)
s'#, MutableArray (PrimState m) a
ma #))
sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool
{-# INLINE sameMutableArray #-}
sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool
sameMutableArray MutableArray s a
arr MutableArray s a
brr
= Int# -> Bool
isTrue# (MutableArray# s a -> MutableArray# s a -> Int#
forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# (MutableArray s a -> MutableArray# s a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
arr) (MutableArray s a -> MutableArray# s a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
brr))
copyArray :: PrimMonad m
=> MutableArray (PrimState m) a
-> Int
-> Array a
-> Int
-> Int
-> m ()
{-# INLINE copyArray #-}
copyArray :: MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray (MutableArray MutableArray# (PrimState m) a
dst#) (I# Int#
doff#) (Array Array# a
src#) (I# Int#
soff#) (I# Int#
len#)
= (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Array# a
-> Int#
-> MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall a d.
Array# a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyArray# Array# a
src# Int#
soff# MutableArray# (PrimState m) a
dst# Int#
doff# Int#
len#)
copyMutableArray :: PrimMonad m
=> MutableArray (PrimState m) a
-> Int
-> MutableArray (PrimState m) a
-> Int
-> Int
-> m ()
{-# INLINE copyMutableArray #-}
copyMutableArray :: MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray (MutableArray MutableArray# (PrimState m) a
dst#) (I# Int#
doff#)
(MutableArray MutableArray# (PrimState m) a
src#) (I# Int#
soff#) (I# Int#
len#)
= (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableArray# (PrimState m) a
-> Int#
-> MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> State# (PrimState m)
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray# MutableArray# (PrimState m) a
src# Int#
soff# MutableArray# (PrimState m) a
dst# Int#
doff# Int#
len#)
cloneArray :: Array a
-> Int
-> Int
-> Array a
{-# INLINE cloneArray #-}
cloneArray :: Array a -> Int -> Int -> Array a
cloneArray (Array Array# a
arr#) (I# Int#
off#) (I# Int#
len#)
= case Array# a -> Int# -> Int# -> Array# a
forall a. Array# a -> Int# -> Int# -> Array# a
cloneArray# Array# a
arr# Int#
off# Int#
len# of Array# a
arr'# -> Array# a -> Array a
forall a. Array# a -> Array a
Array Array# a
arr'#
cloneMutableArray :: PrimMonad m
=> MutableArray (PrimState m) a
-> Int
-> Int
-> m (MutableArray (PrimState m) a)
{-# INLINE cloneMutableArray #-}
cloneMutableArray :: MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
cloneMutableArray (MutableArray MutableArray# (PrimState m) a
arr#) (I# Int#
off#) (I# Int#
len#) = (State# (PrimState m)
-> (# State# (PrimState m), MutableArray (PrimState m) a #))
-> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
(\State# (PrimState m)
s# -> case MutableArray# (PrimState m) a
-> Int#
-> Int#
-> State# (PrimState m)
-> (# State# (PrimState m), MutableArray# (PrimState m) a #)
forall d a.
MutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, MutableArray# d a #)
cloneMutableArray# MutableArray# (PrimState m) a
arr# Int#
off# Int#
len# State# (PrimState m)
s# of
(# State# (PrimState m)
s'#, MutableArray# (PrimState m) a
arr'# #) -> (# State# (PrimState m)
s'#, MutableArray# (PrimState m) a -> MutableArray (PrimState m) a
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr'# #))
emptyArray :: Array a
emptyArray :: Array a
emptyArray =
(forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 (String -> String -> a
forall a. String -> String -> a
die String
"emptyArray" String
"impossible") ST s (MutableArray s a)
-> (MutableArray s a -> ST s (Array a)) -> ST s (Array a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableArray s a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray
{-# NOINLINE emptyArray #-}
runArray
:: (forall s. ST s (MutableArray s a))
-> Array a
#if !MIN_VERSION_base(4,9,0)
runArray m = runST $ m >>= unsafeFreezeArray
#else /* Below, runRW# is available. */
runArray :: (forall s. ST s (MutableArray s a)) -> Array a
runArray forall s. ST s (MutableArray s a)
m = Array# a -> Array a
forall a. Array# a -> Array a
Array ((forall s. ST s (MutableArray s a)) -> Array# a
forall a. (forall s. ST s (MutableArray s a)) -> Array# a
runArray# forall s. ST s (MutableArray s a)
m)
runArray#
:: (forall s. ST s (MutableArray s a))
-> Array# a
runArray# :: (forall s. ST s (MutableArray s a)) -> Array# a
runArray# forall s. ST s (MutableArray s a)
m = case (State# RealWorld -> (# State# RealWorld, Array# a #))
-> (# State# RealWorld, Array# a #)
forall o. (State# RealWorld -> o) -> o
runRW# ((State# RealWorld -> (# State# RealWorld, Array# a #))
-> (# State# RealWorld, Array# a #))
-> (State# RealWorld -> (# State# RealWorld, Array# a #))
-> (# State# RealWorld, Array# a #)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case ST RealWorld (MutableArray RealWorld a)
-> State# RealWorld
-> (# State# RealWorld, MutableArray RealWorld a #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST ST RealWorld (MutableArray RealWorld a)
forall s. ST s (MutableArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', MutableArray MutableArray# RealWorld a
mary# #) ->
MutableArray# RealWorld a
-> State# RealWorld -> (# State# RealWorld, Array# a #)
forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
unsafeFreezeArray# MutableArray# RealWorld a
mary# State# RealWorld
s'} of (# State# RealWorld
_, Array# a
ary# #) -> Array# a
ary#
unST :: ST s a -> State# s -> (# State# s, a #)
unST :: ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST State# s -> (# State# s, a #)
f) = State# s -> (# State# s, a #)
f
emptyArray# :: (# #) -> Array# a
emptyArray# :: (# #) -> Array# a
emptyArray# (# #)
_ = case Array a
forall a. Array a
emptyArray of Array Array# a
ar -> Array# a
ar
{-# NOINLINE emptyArray# #-}
#endif
createArray
:: Int
-> a
-> (forall s. MutableArray s a -> ST s ())
-> Array a
#if !MIN_VERSION_base(4,9,0)
createArray 0 _ _ = emptyArray
#else
createArray :: Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
0 a
_ forall s. MutableArray s a -> ST s ()
_ = Array# a -> Array a
forall a. Array# a -> Array a
Array ((# #) -> Array# a
forall a. (# #) -> Array# a
emptyArray# (# #))
#endif
createArray Int
n a
x forall s. MutableArray s a -> ST s ()
f = (forall s. ST s (MutableArray s a)) -> Array a
forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray ((forall s. ST s (MutableArray s a)) -> Array a)
-> (forall s. ST s (MutableArray s a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
MutableArray s a
mary <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n a
x
MutableArray s a -> ST s ()
forall s. MutableArray s a -> ST s ()
f MutableArray s a
mary
MutableArray s a -> ST s (MutableArray s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableArray s a
mary
die :: String -> String -> a
die :: String -> String -> a
die String
fun String
problem = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.Primitive.Array." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
problem
arrayLiftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq a -> b -> Bool
p Array a
a1 Array b
a2 = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
a2 Bool -> Bool -> Bool
&& Int -> Bool
loop (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where loop :: Int -> Bool
loop Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
True
| (# a
x1 #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
, (# b
x2 #) <- Array b -> Int -> (# b #)
forall a. Array a -> Int -> (# a #)
indexArray## Array b
a2 Int
i
, Bool
otherwise = a -> b -> Bool
p a
x1 b
x2 Bool -> Bool -> Bool
&& Int -> Bool
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
instance Eq a => Eq (Array a) where
Array a
a1 == :: Array a -> Array a -> Bool
== Array a
a2 = (a -> a -> Bool) -> Array a -> Array a -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Array a
a1 Array a
a2
instance Eq1 Array where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
liftEq = (a -> b -> Bool) -> Array a -> Array b -> Bool
forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq
#else
eq1 = arrayLiftEq (==)
#endif
instance Eq (MutableArray s a) where
MutableArray s a
ma1 == :: MutableArray s a -> MutableArray s a -> Bool
== MutableArray s a
ma2 = Int# -> Bool
isTrue# (MutableArray# s a -> MutableArray# s a -> Int#
forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# (MutableArray s a -> MutableArray# s a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ma1) (MutableArray s a -> MutableArray# s a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ma2))
arrayLiftCompare :: (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare :: (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare a -> b -> Ordering
elemCompare Array a
a1 Array b
a2 = Int -> Ordering
loop Int
0
where
mn :: Int
mn = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
a2
loop :: Int -> Ordering
loop Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mn
, (# a
x1 #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
, (# b
x2 #) <- Array b -> Int -> (# b #)
forall a. Array a -> Int -> (# a #)
indexArray## Array b
a2 Int
i
= a -> b -> Ordering
elemCompare a
x1 b
x2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Int -> Ordering
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a1) (Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
a2)
instance Ord a => Ord (Array a) where
compare :: Array a -> Array a -> Ordering
compare Array a
a1 Array a
a2 = (a -> a -> Ordering) -> Array a -> Array a -> Ordering
forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
a1 Array a
a2
instance Ord1 Array where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftCompare :: (a -> b -> Ordering) -> Array a -> Array b -> Ordering
liftCompare = (a -> b -> Ordering) -> Array a -> Array b -> Ordering
forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare
#else
compare1 = arrayLiftCompare compare
#endif
instance Foldable Array where
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f = \b
z !Array a
ary ->
let
!sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> b
go Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = b
z
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= a -> b -> b
f a
x (Int -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
in Int -> b
go Int
0
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> Array a -> b
foldl b -> a -> b
f = \b
z !Array a
ary ->
let
go :: Int -> b
go Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = b
z
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= b -> a -> b
f (Int -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) a
x
in Int -> b
go (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE foldl #-}
foldr1 :: (a -> a -> a) -> Array a -> a
foldr1 a -> a -> a
f = \ !Array a
ary ->
let
!sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
go :: Int -> a
go Int
i =
case Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
(# a
x #) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz -> a
x
| Bool
otherwise -> a -> a -> a
f a
x (Int -> a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
in if Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then String -> String -> a
forall a. String -> String -> a
die String
"foldr1" String
"empty array"
else Int -> a
go Int
0
{-# INLINE foldr1 #-}
foldl1 :: (a -> a -> a) -> Array a -> a
foldl1 a -> a -> a
f = \ !Array a
ary ->
let
!sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
go :: Int -> a
go Int
i =
case Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
(# a
x #) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> a
x
| Bool
otherwise -> a -> a -> a
f (Int -> a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) a
x
in if Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then String -> String -> a
forall a. String -> String -> a
die String
"foldl1" String
"empty array"
else Int -> a
go Int
sz
{-# INLINE foldl1 #-}
foldr' :: (a -> b -> b) -> b -> Array a -> b
foldr' a -> b -> b
f = \b
z !Array a
ary ->
let
go :: Int -> b -> b
go Int
i !b
acc
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = b
acc
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> b -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (a -> b -> b
f a
x b
acc)
in Int -> b -> b
go (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b
z
{-# INLINE foldr' #-}
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f = \b
z !Array a
ary ->
let
!sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> b -> b
go Int
i !b
acc
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = b
acc
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> b -> b
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (b -> a -> b
f b
acc a
x)
in Int -> b -> b
go Int
0 b
z
{-# INLINE foldl' #-}
null :: Array a -> Bool
null Array a
a = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE null #-}
length :: Array a -> Int
length = Array a -> Int
forall a. Array a -> Int
sizeofArray
{-# INLINE length #-}
maximum :: Array a -> a
maximum Array a
ary | Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> String -> a
forall a. String -> String -> a
die String
"maximum" String
"empty array"
| (# a
frst #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
= Int -> a -> a
go Int
1 a
frst
where
sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> a -> a
go Int
i !a
e
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> a -> a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
e a
x)
{-# INLINE maximum #-}
minimum :: Array a -> a
minimum Array a
ary | Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> String -> a
forall a. String -> String -> a
die String
"minimum" String
"empty array"
| (# a
frst #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
= Int -> a -> a
go Int
1 a
frst
where sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> a -> a
go Int
i !a
e
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> a -> a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a -> a -> a
forall a. Ord a => a -> a -> a
min a
e a
x)
{-# INLINE minimum #-}
sum :: Array a -> a
sum = (a -> a -> a) -> a -> Array a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
{-# INLINE sum #-}
product :: Array a -> a
product = (a -> a -> a) -> a -> Array a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1
{-# INLINE product #-}
newtype STA a = STA { STA a -> forall s. MutableArray# s a -> ST s (Array a)
_runSTA :: forall s. MutableArray# s a -> ST s (Array a) }
runSTA :: Int -> STA a -> Array a
runSTA :: Int -> STA a -> Array a
runSTA !Int
sz = \ (STA forall s. MutableArray# s a -> ST s (Array a)
m) -> (forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> ST s (MutableArray s a)
forall s a. Int -> ST s (MutableArray s a)
newArray_ Int
sz ST s (MutableArray s a)
-> (MutableArray s a -> ST s (Array a)) -> ST s (Array a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ MutableArray s a
ar -> MutableArray# s a -> ST s (Array a)
forall s. MutableArray# s a -> ST s (Array a)
m (MutableArray s a -> MutableArray# s a
forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ar)
{-# INLINE runSTA #-}
newArray_ :: Int -> ST s (MutableArray s a)
newArray_ :: Int -> ST s (MutableArray s a)
newArray_ !Int
n = Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n a
forall a. a
badTraverseValue
badTraverseValue :: a
badTraverseValue :: a
badTraverseValue = String -> String -> a
forall a. String -> String -> a
die String
"traverse" String
"bad indexing"
{-# NOINLINE badTraverseValue #-}
instance Traversable Array where
traverse :: (a -> f b) -> Array a -> f (Array b)
traverse a -> f b
f = (a -> f b) -> Array a -> f (Array b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverseArray a -> f b
f
{-# INLINE traverse #-}
traverseArray
:: Applicative f
=> (a -> f b)
-> Array a
-> f (Array b)
traverseArray :: (a -> f b) -> Array a -> f (Array b)
traverseArray a -> f b
f = \ !Array a
ary ->
let
!len :: Int
len = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> f (STA b)
go !Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = STA b -> f (STA b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STA b -> f (STA b)) -> STA b -> f (STA b)
forall a b. (a -> b) -> a -> b
$ (forall s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA ((forall s. MutableArray# s b -> ST s (Array b)) -> STA b)
-> (forall s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary -> MutableArray (PrimState (ST s)) b -> ST s (Array b)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray (MutableArray# s b -> MutableArray s b
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary)
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= (b -> STA b -> STA b) -> f b -> f (STA b) -> f (STA b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\b
b (STA forall s. MutableArray# s b -> ST s (Array b)
m) -> (forall s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA ((forall s. MutableArray# s b -> ST s (Array b)) -> STA b)
-> (forall s. MutableArray# s b -> ST s (Array b)) -> STA b
forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary ->
MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray (MutableArray# s b -> MutableArray s b
forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary) Int
i b
b ST s () -> ST s (Array b) -> ST s (Array b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableArray# s b -> ST s (Array b)
forall s. MutableArray# s b -> ST s (Array b)
m MutableArray# s b
mary)
(a -> f b
f a
x) (Int -> f (STA b)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
in if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Array b -> f (Array b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Array b
forall a. Array a
emptyArray
else Int -> STA b -> Array b
forall a. Int -> STA a -> Array a
runSTA Int
len (STA b -> Array b) -> f (STA b) -> f (Array b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f (STA b)
go Int
0
{-# INLINE [1] traverseArray #-}
{-# RULES
"traverse/ST" forall (f :: a -> ST s b). traverseArray f =
traverseArrayP f
"traverse/IO" forall (f :: a -> IO b). traverseArray f =
traverseArrayP f
"traverse/Id" forall (f :: a -> Identity b). traverseArray f =
(coerce :: (Array a -> Array (Identity b))
-> Array a -> Identity (Array b)) (fmap f)
#-}
traverseArrayP
:: PrimMonad m
=> (a -> m b)
-> Array a
-> m (Array b)
traverseArrayP :: (a -> m b) -> Array a -> m (Array b)
traverseArrayP a -> m b
f = \ !Array a
ary ->
let
!sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> MutableArray (PrimState m) b -> m (Array b)
go !Int
i !MutableArray (PrimState m) b
mary
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz
= MutableArray (PrimState m) b -> m (Array b)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) b
mary
| Bool
otherwise
= do
a
a <- Array a -> Int -> m a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
ary Int
i
b
b <- a -> m b
f a
a
MutableArray (PrimState m) b -> Int -> b -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray (PrimState m) b
mary Int
i b
b
Int -> MutableArray (PrimState m) b -> m (Array b)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MutableArray (PrimState m) b
mary
in do
MutableArray (PrimState m) b
mary <- Int -> b -> m (MutableArray (PrimState m) b)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz b
forall a. a
badTraverseValue
Int -> MutableArray (PrimState m) b -> m (Array b)
go Int
0 MutableArray (PrimState m) b
mary
{-# INLINE traverseArrayP #-}
mapArray' :: (a -> b) -> Array a -> Array b
mapArray' :: (a -> b) -> Array a -> Array b
mapArray' a -> b
f Array a
a =
Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) (String -> String -> b
forall a. String -> String -> a
die String
"mapArray'" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a
= () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
let !y :: b
y = a -> b
f a
x
MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb Int
i b
y ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
in Int -> ST s ()
go Int
0
{-# INLINE mapArray' #-}
arrayFromListN :: Int -> [a] -> Array a
arrayFromListN :: Int -> [a] -> Array a
arrayFromListN Int
n [a]
l =
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
n (String -> String -> a
forall a. String -> String -> a
die String
"fromListN" String
"uninitialized element") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \MutableArray s a
sma ->
let go :: Int -> [a] -> ST s ()
go !Int
ix [] = if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> String -> ST s ()
forall a. String -> String -> a
die String
"fromListN" String
"list length less than specified size"
go !Int
ix (a
x : [a]
xs) = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then do
MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
sma Int
ix a
x
Int -> [a] -> ST s ()
go (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
xs
else String -> String -> ST s ()
forall a. String -> String -> a
die String
"fromListN" String
"list length greater than specified size"
in Int -> [a] -> ST s ()
go Int
0 [a]
l
arrayFromList :: [a] -> Array a
arrayFromList :: [a] -> Array a
arrayFromList [a]
l = Int -> [a] -> Array a
forall a. Int -> [a] -> Array a
arrayFromListN ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) [a]
l
instance Exts.IsList (Array a) where
type Item (Array a) = a
fromListN :: Int -> [Item (Array a)] -> Array a
fromListN = Int -> [Item (Array a)] -> Array a
forall a. Int -> [a] -> Array a
arrayFromListN
fromList :: [Item (Array a)] -> Array a
fromList = [Item (Array a)] -> Array a
forall a. [a] -> Array a
arrayFromList
toList :: Array a -> [Item (Array a)]
toList = Array a -> [Item (Array a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Functor Array where
fmap :: (a -> b) -> Array a -> Array b
fmap a -> b
f Array a
a =
Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) (String -> String -> b
forall a. String -> String -> a
die String
"fmap" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a
= () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb Int
i (a -> b
f a
x) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
in Int -> ST s ()
go Int
0
a
e <$ :: a -> Array b -> Array a
<$ Array b
a = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
a) a
e (\ !MutableArray s a
_ -> () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Applicative Array where
pure :: a -> Array a
pure a
x = (forall s. ST s (MutableArray s a)) -> Array a
forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray ((forall s. ST s (MutableArray s a)) -> Array a)
-> (forall s. ST s (MutableArray s a)) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
1 a
x
Array (a -> b)
ab <*> :: Array (a -> b) -> Array a -> Array b
<*> Array a
a = Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
szab Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sza) (String -> String -> b
forall a. String -> String -> a
die String
"<*>" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go1 :: Int -> ST s ()
go1 Int
i = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
szab) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
do
a -> b
f <- Array (a -> b) -> Int -> ST s (a -> b)
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array (a -> b)
ab Int
i
Int -> (a -> b) -> Int -> ST s ()
go2 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sza) a -> b
f Int
0
Int -> ST s ()
go1 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
go2 :: Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f Int
j = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sza) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
do
a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
j
MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) (a -> b
f a
x)
Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
in Int -> ST s ()
go1 Int
0
where szab :: Int
szab = Array (a -> b) -> Int
forall a. Array a -> Int
sizeofArray Array (a -> b)
ab; sza :: Int
sza = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a
Array a
a *> :: Array a -> Array b -> Array b
*> Array b
b = Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
szb) (String -> String -> b
forall a. String -> String -> a
die String
"*>" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sza = MutableArray (PrimState (ST s)) b
-> Int -> Array b -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
szb) Array b
b Int
0 Int
szb ST s () -> ST s () -> ST s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go Int
0
where sza :: Int
sza = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a; szb :: Int
szb = Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
b
Array a
a <* :: Array a -> Array b -> Array a
<* Array b
b = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
szb) (String -> String -> a
forall a. String -> String -> a
die String
"<*" String
"impossible") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
let fill :: Int -> Int -> a -> ST s ()
fill Int
off Int
i a
e | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
szb = MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) a
e ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> a -> ST s ()
fill Int
off (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
e
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sza
= do a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
Int -> Int -> a -> ST s ()
fill (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
szb) Int
0 a
x ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go Int
0
where sza :: Int
sza = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a; szb :: Int
szb = Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
b
instance Alternative Array where
empty :: Array a
empty = Array a
forall a. Array a
emptyArray
Array a
a1 <|> :: Array a -> Array a -> Array a
<|> Array a
a2 = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sza2) (String -> String -> a
forall a. String -> String -> a
die String
"<|>" String
"impossible") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma Int
0 Array a
a1 Int
0 Int
sza1 ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma Int
sza1 Array a
a2 Int
0 Int
sza2
where sza1 :: Int
sza1 = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a1; sza2 :: Int
sza2 = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a2
some :: Array a -> Array [a]
some Array a
a | Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Array [a]
forall a. Array a
emptyArray
| Bool
otherwise = String -> String -> Array [a]
forall a. String -> String -> a
die String
"some" String
"infinite arrays are not well defined"
many :: Array a -> Array [a]
many Array a
a | Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> Array [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise = String -> String -> Array [a]
forall a. String -> String -> a
die String
"many" String
"infinite arrays are not well defined"
data ArrayStack a
= PushArray !(Array a) !(ArrayStack a)
| EmptyStack
instance Monad Array where
return :: a -> Array a
return = a -> Array a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>> :: Array a -> Array b -> Array b
(>>) = Array a -> Array b -> Array b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
Array a
ary >>= :: Array a -> (a -> Array b) -> Array b
>>= a -> Array b
f = Int -> ArrayStack b -> Int -> Array b
collect Int
0 ArrayStack b
forall a. ArrayStack a
EmptyStack (Int
la Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
la :: Int
la = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
collect :: Int -> ArrayStack b -> Int -> Array b
collect Int
sz ArrayStack b
stk Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> b -> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (String -> String -> b
forall a. String -> String -> a
die String
">>=" String
"impossible") ((forall s. MutableArray s b -> ST s ()) -> Array b)
-> (forall s. MutableArray s b -> ST s ()) -> Array b
forall a b. (a -> b) -> a -> b
$ Int -> ArrayStack b -> MutableArray (PrimState (ST s)) b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill Int
0 ArrayStack b
stk
| (# a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
, let sb :: Array b
sb = a -> Array b
f a
x
lsb :: Int
lsb = Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
sb
= if Int
lsb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int -> ArrayStack b -> Int -> Array b
collect Int
sz ArrayStack b
stk (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else Int -> ArrayStack b -> Int -> Array b
collect (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lsb) (Array b -> ArrayStack b -> ArrayStack b
forall a. Array a -> ArrayStack a -> ArrayStack a
PushArray Array b
sb ArrayStack b
stk) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
fill :: Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill Int
_ ArrayStack a
EmptyStack MutableArray (PrimState m) a
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fill Int
off (PushArray Array a
sb ArrayStack a
sbs) MutableArray (PrimState m) a
smb
| let lsb :: Int
lsb = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
sb
= MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray (PrimState m) a
smb Int
off Array a
sb Int
0 Int
lsb
m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lsb) ArrayStack a
sbs MutableArray (PrimState m) a
smb
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
instance Fail.MonadFail Array where
fail :: String -> Array a
fail String
_ = Array a
forall (f :: * -> *) a. Alternative f => f a
empty
instance MonadPlus Array where
mzero :: Array a
mzero = Array a
forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: Array a -> Array a -> Array a
mplus = Array a -> Array a -> Array a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
zipW :: String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW :: String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
s a -> b -> c
f Array a
aa Array b
ab = Int -> c -> (forall s. MutableArray s c -> ST s ()) -> Array c
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
mn (String -> String -> c
forall a. String -> String -> a
die String
s String
"impossible") ((forall s. MutableArray s c -> ST s ()) -> Array c)
-> (forall s. MutableArray s c -> ST s ()) -> Array c
forall a b. (a -> b) -> a -> b
$ \MutableArray s c
mc ->
let go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mn
= do
a
x <- Array a -> Int -> ST s a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
aa Int
i
b
y <- Array b -> Int -> ST s b
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array b
ab Int
i
MutableArray (PrimState (ST s)) c -> Int -> c -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s c
MutableArray (PrimState (ST s)) c
mc Int
i (a -> b -> c
f a
x b
y)
Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go Int
0
where mn :: Int
mn = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
aa Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Array b -> Int
forall a. Array a -> Int
sizeofArray Array b
ab
{-# INLINE zipW #-}
instance MonadZip Array where
mzip :: Array a -> Array b -> Array (a, b)
mzip Array a
aa Array b
ab = String -> (a -> b -> (a, b)) -> Array a -> Array b -> Array (a, b)
forall a b c.
String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
"mzip" (,) Array a
aa Array b
ab
mzipWith :: (a -> b -> c) -> Array a -> Array b -> Array c
mzipWith a -> b -> c
f Array a
aa Array b
ab = String -> (a -> b -> c) -> Array a -> Array b -> Array c
forall a b c.
String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
"mzipWith" a -> b -> c
f Array a
aa Array b
ab
munzip :: Array (a, b) -> (Array a, Array b)
munzip Array (a, b)
aab = (forall s. ST s (Array a, Array b)) -> (Array a, Array b)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a, Array b)) -> (Array a, Array b))
-> (forall s. ST s (Array a, Array b)) -> (Array a, Array b)
forall a b. (a -> b) -> a -> b
$ do
let sz :: Int
sz = Array (a, b) -> Int
forall a. Array a -> Int
sizeofArray Array (a, b)
aab
MutableArray s a
ma <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz (String -> String -> a
forall a. String -> String -> a
die String
"munzip" String
"impossible")
MutableArray s b
mb <- Int -> b -> ST s (MutableArray (PrimState (ST s)) b)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz (String -> String -> b
forall a. String -> String -> a
die String
"munzip" String
"impossible")
let go :: Int -> ST s ()
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = do
(a
a, b
b) <- Array (a, b) -> Int -> ST s (a, b)
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array (a, b)
aab Int
i
MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma Int
i a
a
MutableArray (PrimState (ST s)) b -> Int -> b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb Int
i b
b
Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
go Int
_ = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Int -> ST s ()
go Int
0
(,) (Array a -> Array b -> (Array a, Array b))
-> ST s (Array a) -> ST s (Array b -> (Array a, Array b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma ST s (Array b -> (Array a, Array b))
-> ST s (Array b) -> ST s (Array a, Array b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MutableArray (PrimState (ST s)) b -> ST s (Array b)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s b
MutableArray (PrimState (ST s)) b
mb
instance MonadFix Array where
mfix :: (a -> Array a) -> Array a
mfix a -> Array a
f = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Array a -> Int
forall a. Array a -> Int
sizeofArray (a -> Array a
f a
forall a. a
err))
(String -> String -> a
forall a. String -> String -> a
die String
"mfix" String
"impossible") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ (((Int -> MutableArray s a -> ST s ())
-> Int -> MutableArray s a -> ST s ())
-> Int -> MutableArray s a -> ST s ())
-> Int
-> ((Int -> MutableArray s a -> ST s ())
-> Int -> MutableArray s a -> ST s ())
-> MutableArray s a
-> ST s ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int -> MutableArray s a -> ST s ())
-> Int -> MutableArray s a -> ST s ())
-> Int -> MutableArray s a -> ST s ()
forall a. (a -> a) -> a
fix Int
0 (((Int -> MutableArray s a -> ST s ())
-> Int -> MutableArray s a -> ST s ())
-> MutableArray s a -> ST s ())
-> ((Int -> MutableArray s a -> ST s ())
-> Int -> MutableArray s a -> ST s ())
-> MutableArray s a
-> ST s ()
forall a b. (a -> b) -> a -> b
$
\Int -> MutableArray s a -> ST s ()
r !Int
i !MutableArray s a
mary -> Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
mary Int
i ((a -> a) -> a
forall a. (a -> a) -> a
fix (\a
xi -> a -> Array a
f a
xi Array a -> Int -> a
forall a. Array a -> Int -> a
`indexArray` Int
i))
Int -> MutableArray s a -> ST s ()
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MutableArray s a
mary
where
sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray (a -> Array a
f a
forall a. a
err)
err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"mfix for Data.Primitive.Array applied to strict function."
#if MIN_VERSION_base(4,9,0)
instance Semigroup (Array a) where
<> :: Array a -> Array a -> Array a
(<>) = Array a -> Array a -> Array a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
sconcat :: NonEmpty (Array a) -> Array a
sconcat = [Array a] -> Array a
forall a. Monoid a => [a] -> a
mconcat ([Array a] -> Array a)
-> (NonEmpty (Array a) -> [Array a])
-> NonEmpty (Array a)
-> Array a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Array a) -> [Array a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
#endif
instance Monoid (Array a) where
mempty :: Array a
mempty = Array a
forall (f :: * -> *) a. Alternative f => f a
empty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<|>)
#endif
mconcat :: [Array a] -> Array a
mconcat [Array a]
l = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (String -> String -> a
forall a. String -> String -> a
die String
"mconcat" String
"impossible") ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
let go :: Int -> [Array a] -> ST s ()
go !Int
_ [ ] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int
off (Array a
a:[Array a]
as) =
MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma Int
off Array a
a Int
0 (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Array a] -> ST s ()
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) [Array a]
as
in Int -> [Array a] -> ST s ()
go Int
0 [Array a]
l
where sz :: Int
sz = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Array a] -> [Int]) -> [Array a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array a -> Int) -> [Array a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array a -> Int
forall a. Array a -> Int
sizeofArray ([Array a] -> Int) -> [Array a] -> Int
forall a b. (a -> b) -> a -> b
$ [Array a]
l
arrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
arrayLiftShowsPrec Int -> a -> String -> String
elemShowsPrec [a] -> String -> String
elemListShowsPrec Int
p Array a
a = Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String -> String -> String
showString String
"fromListN " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Show a => a -> String -> String
shows (Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
a) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" "
(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> [a] -> String -> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> [a] -> String -> String
listLiftShowsPrec Int -> a -> String -> String
elemShowsPrec [a] -> String -> String
elemListShowsPrec Int
11 (Array a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
a)
listLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> [a] -> String -> String
listLiftShowsPrec Int -> a -> String -> String
_ [a] -> String -> String
sl Int
_ = [a] -> String -> String
sl
instance Show a => Show (Array a) where
showsPrec :: Int -> Array a -> String -> String
showsPrec Int
p Array a
a = (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
arrayLiftShowsPrec Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec [a] -> String -> String
forall a. Show a => [a] -> String -> String
showList Int
p Array a
a
instance Show1 Array where
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftShowsPrec :: (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
liftShowsPrec = (Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
forall a.
(Int -> a -> String -> String)
-> ([a] -> String -> String) -> Int -> Array a -> String -> String
arrayLiftShowsPrec
#else
showsPrec1 = arrayLiftShowsPrec showsPrec showList
#endif
instance Read a => Read (Array a) where
readPrec :: ReadPrec (Array a)
readPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
instance Read1 Array where
#if MIN_VERSION_base(4,10,0)
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
liftReadPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec
#elif MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)
liftReadsPrec = arrayLiftReadsPrec
#else
readsPrec1 = arrayLiftReadsPrec readsPrec readList
#endif
arrayLiftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec ReadPrec a
_ ReadPrec [a]
read_list = ReadPrec (Array a) -> ReadPrec (Array a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Array a) -> ReadPrec (Array a))
-> ReadPrec (Array a) -> ReadPrec (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Array a) -> ReadPrec (Array a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec (ReadPrec (Array a) -> ReadPrec (Array a))
-> ReadPrec (Array a) -> ReadPrec (Array a)
forall a b. (a -> b) -> a -> b
$ ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP ()
skipSpaces ReadPrec () -> ReadPrec (Array a) -> ReadPrec (Array a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(([a] -> Array a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Array a) -> ReadPrec [a] -> ReadPrec (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
read_list) ReadPrec (Array a) -> ReadPrec (Array a) -> ReadPrec (Array a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
RdPrc.+++
do
Tag
tag <- ReadP Tag -> ReadPrec Tag
forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP Tag
lexTag
case Tag
tag of
Tag
FromListTag -> [a] -> Array a
forall l. IsList l => [Item l] -> l
fromList ([a] -> Array a) -> ReadPrec [a] -> ReadPrec (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
read_list
Tag
FromListNTag -> (Int -> [a] -> Array a)
-> ReadPrec Int -> ReadPrec [a] -> ReadPrec (Array a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int -> [a] -> Array a
forall l. IsList l => Int -> [Item l] -> l
fromListN ReadPrec Int
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
read_list)
where
app_prec :: Int
app_prec = Int
10
data Tag = FromListTag | FromListNTag
lexTag :: ReadP Tag
lexTag :: ReadP Tag
lexTag = do
String
_ <- String -> ReadP String
string String
"fromList"
String
s <- ReadP String
look
case String
s of
Char
'N':Char
c:String
_
| Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
-> String -> ReadP Tag
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
| Bool
otherwise -> Tag
FromListNTag Tag -> ReadP Char -> ReadP Tag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP Char
get
String
_ -> Tag -> ReadP Tag
forall (m :: * -> *) a. Monad m => a -> m a
return Tag
FromListTag
#if !MIN_VERSION_base(4,10,0)
arrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Array a)
arrayLiftReadsPrec reads_prec list_reads_prec = RdPrc.readPrec_to_S $
arrayLiftReadPrec (RdPrc.readS_to_Prec reads_prec) (RdPrc.readS_to_Prec (const list_reads_prec))
#endif
arrayDataType :: DataType
arrayDataType :: DataType
arrayDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Primitive.Array.Array" [Constr
fromListConstr]
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
arrayDataType String
"fromList" [] Fixity
Prefix
instance Data a => Data (Array a) where
toConstr :: Array a -> Constr
toConstr Array a
_ = Constr
fromListConstr
dataTypeOf :: Array a -> DataType
dataTypeOf Array a
_ = DataType
arrayDataType
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> c ([a] -> Array a) -> c (Array a)
forall b r. Data b => c (b -> r) -> c r
k (([a] -> Array a) -> c ([a] -> Array a)
forall r. r -> c r
z [a] -> Array a
forall l. IsList l => [Item l] -> l
fromList)
Int
_ -> String -> c (Array a)
forall a. HasCallStack => String -> a
error String
"gunfold"
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array a -> c (Array a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Array a
m = ([a] -> Array a) -> c ([a] -> Array a)
forall g. g -> c g
z [a] -> Array a
forall l. IsList l => [Item l] -> l
fromList c ([a] -> Array a) -> [a] -> c (Array a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` Array a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
m
instance (Typeable s, Typeable a) => Data (MutableArray s a) where
toConstr :: MutableArray s a -> Constr
toConstr MutableArray s a
_ = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MutableArray s a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = String -> Constr -> c (MutableArray s a)
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: MutableArray s a -> DataType
dataTypeOf MutableArray s a
_ = String -> DataType
mkNoRepType String
"Data.Primitive.Array.MutableArray"