{-# 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,
unsafeFreezeArray, unsafeThawArray, sameMutableArray,
copyArray, copyMutableArray,
cloneArray, cloneMutableArray,
sizeofArray, sizeofMutableArray,
fromListN, fromList,
mapArray',
traverseArrayP
) where
import Control.Monad.Primitive
import GHC.Base ( Int(..) )
import GHC.Exts
#if (MIN_VERSION_base(4,7,0))
hiding (toList)
#endif
import qualified GHC.Exts as Exts
#if (MIN_VERSION_base(4,7,0))
import GHC.Exts (fromListN, fromList)
#endif
import Data.Typeable ( Typeable )
import Data.Data
(Data(..), DataType, mkDataType, Constr, mkConstr, Fixity(..), constrIndex)
import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType )
import Control.Monad.ST(ST,runST)
import Control.Applicative
import Control.Monad (MonadPlus(..), when)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
#if MIN_VERSION_base(4,4,0)
import Control.Monad.Zip
#endif
import Data.Foldable (Foldable(..), toList)
#if !(MIN_VERSION_base(4,8,0))
import Data.Traversable (Traversable(..))
import Data.Monoid
#endif
#if MIN_VERSION_base(4,9,0)
import qualified GHC.ST as GHCST
import qualified Data.Foldable as F
import Data.Semigroup
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity
#endif
#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
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),Read1(..))
#endif
import Control.Monad (liftM2)
data Array a = Array
{ Array a -> Array# a
array# :: Array# a }
deriving ( Typeable )
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 a :: 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 a :: 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# n# :: Int#
n#) x :: 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
(\s# :: 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
(# s'# :: State# (PrimState m)
s'#, arr# :: 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 arr :: MutableArray (PrimState m) a
arr (I# 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 arr :: MutableArray (PrimState m) a
arr (I# i# :: Int#
i#) x :: 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 arr :: Array a
arr (I# 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 (# x :: a
x #) -> a
x
indexArray## :: Array a -> Int -> (# a #)
indexArray## :: Array a -> Int -> (# a #)
indexArray## arr :: Array a
arr (I# 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 arr :: Array a
arr (I# 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 (# x :: 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 ma# :: MutableArray# (PrimState m) a
ma#) (I# off# :: Int#
off#) (I# len# :: 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
$ \s :: 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
(# s' :: State# (PrimState m)
s', a# :: 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 arr :: 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 (\s# :: 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
(# s'# :: State# (PrimState m)
s'#, arr'# :: 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 a# :: Array# a
a#) (I# off# :: Int#
off#) (I# len# :: 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
$ \s :: 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
(# s' :: State# (PrimState m)
s', ma# :: 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 a :: 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 (\s# :: 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
(# s'# :: State# (PrimState m)
s'#, arr'# :: 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 arr :: MutableArray s a
arr brr :: 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 #-}
#if __GLASGOW_HASKELL__ > 706
copyArray :: MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray (MutableArray dst# :: MutableArray# (PrimState m) a
dst#) (I# doff# :: Int#
doff#) (Array src# :: Array# a
src#) (I# soff# :: Int#
soff#) (I# len# :: 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#)
#else
copyArray !dst !doff !src !soff !len = go 0
where
go i | i < len = do
x <- indexArrayM src (soff+i)
writeArray dst (doff+i) x
go (i+1)
| otherwise = return ()
#endif
copyMutableArray :: PrimMonad m
=> MutableArray (PrimState m) a
-> Int
-> MutableArray (PrimState m) a
-> Int
-> Int
-> m ()
{-# INLINE copyMutableArray #-}
#if __GLASGOW_HASKELL__ > 706
copyMutableArray :: MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray (MutableArray dst# :: MutableArray# (PrimState m) a
dst#) (I# doff# :: Int#
doff#)
(MutableArray src# :: MutableArray# (PrimState m) a
src#) (I# soff# :: Int#
soff#) (I# len# :: 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#)
#else
copyMutableArray !dst !doff !src !soff !len = go 0
where
go i | i < len = do
x <- readArray src (soff+i)
writeArray dst (doff+i) x
go (i+1)
| otherwise = return ()
#endif
cloneArray :: Array a
-> Int
-> Int
-> Array a
{-# INLINE cloneArray #-}
cloneArray :: Array a -> Int -> Int -> Array a
cloneArray (Array arr# :: Array# a
arr#) (I# off# :: Int#
off#) (I# len# :: 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 arr'# :: 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 arr# :: MutableArray# (PrimState m) a
arr#) (I# off# :: Int#
off#) (I# len# :: 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
(\s# :: 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
(# s'# :: State# (PrimState m)
s'#, arr'# :: 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 0 (String -> String -> a
forall a. String -> String -> a
die "emptyArray" "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 #-}
#if !MIN_VERSION_base(4,9,0)
createArray
:: Int
-> a
-> (forall s. MutableArray s a -> ST s ())
-> Array a
createArray 0 _ _ = emptyArray
createArray n x f = runArray $ do
mary <- newArray n x
f mary
pure mary
runArray
:: (forall s. ST s (MutableArray s a))
-> Array a
runArray m = runST $ m >>= unsafeFreezeArray
#else /* Below, runRW# is available. */
createArray
:: Int
-> a
-> (forall s. MutableArray s a -> ST s ())
-> Array a
createArray :: Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray 0 _ _ = Array# a -> Array a
forall a. Array# a -> Array a
Array ((# #) -> Array# a
forall a. (# #) -> Array# a
emptyArray# (# #))
createArray n :: Int
n x :: a
x f :: 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
runArray
:: (forall s. ST s (MutableArray s a))
-> Array a
runArray :: (forall s. ST s (MutableArray s a)) -> Array a
runArray m :: 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# m :: 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
$ \s :: 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 { (# s' :: State# RealWorld
s', MutableArray mary# :: 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 (# _, ary# :: 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 f :: 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 ar :: Array# a
ar -> Array# a
ar
{-# NOINLINE emptyArray# #-}
#endif
die :: String -> String -> a
die :: String -> String -> a
die fun :: String
fun problem :: String
problem = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Data.Primitive.Array." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " 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 p :: a -> b -> Bool
p a1 :: Array a
a1 a2 :: 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
- 1)
where loop :: Int -> Bool
loop i :: Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Bool
True
| (# x1 :: a
x1 #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
, (# x2 :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
instance Eq a => Eq (Array a) where
a1 :: Array a
a1 == :: Array a -> Array a -> Bool
== a2 :: 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
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
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
#endif
instance Eq (MutableArray s a) where
ma1 :: MutableArray s a
ma1 == :: MutableArray s a -> MutableArray s a -> Bool
== ma2 :: 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 elemCompare :: a -> b -> Ordering
elemCompare a1 :: Array a
a1 a2 :: Array b
a2 = Int -> Ordering
loop 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 i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
mn
, (# x1 :: a
x1 #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
, (# x2 :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+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 a1 :: Array a
a1 a2 :: 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
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
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
#endif
instance Foldable Array where
foldr :: (a -> b -> b) -> b -> Array a -> b
foldr f :: a -> b -> b
f = \z :: 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 i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = b
z
| (# x :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))
in Int -> b
go 0
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> Array a -> b
foldl f :: b -> a -> b
f = \z :: b
z !Array a
ary ->
let
go :: Int -> b
go i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = b
z
| (# x :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-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
- 1)
{-# INLINE foldl #-}
foldr1 :: (a -> a -> a) -> Array a -> a
foldr1 f :: 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
- 1
go :: Int -> a
go i :: Int
i =
case Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
(# x :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1))
in if Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then String -> String -> a
forall a. String -> String -> a
die "foldr1" "empty array"
else Int -> a
go 0
{-# INLINE foldr1 #-}
foldl1 :: (a -> a -> a) -> Array a -> a
foldl1 f :: 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
- 1
go :: Int -> a
go i :: Int
i =
case Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
(# x :: a
x #) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> a
x
| Bool
otherwise -> a -> a -> a
f (Int -> a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) a
x
in if Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then String -> String -> a
forall a. String -> String -> a
die "foldl1" "empty array"
else Int -> a
go Int
sz
{-# INLINE foldl1 #-}
#if MIN_VERSION_base(4,6,0)
foldr' :: (a -> b -> b) -> b -> Array a -> b
foldr' f :: a -> b -> b
f = \z :: b
z !Array a
ary ->
let
go :: Int -> b -> b
go i :: Int
i !b
acc
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -1 = b
acc
| (# x :: a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> b -> b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-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
- 1) b
z
{-# INLINE foldr' #-}
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' f :: b -> a -> b
f = \z :: 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 i :: Int
i !b
acc
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = b
acc
| (# x :: a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> b -> b
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (b -> a -> b
f b
acc a
x)
in Int -> b -> b
go 0 b
z
{-# INLINE foldl' #-}
#endif
#if MIN_VERSION_base(4,8,0)
null :: Array a -> Bool
null a :: 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
== 0
{-# INLINE null #-}
length :: Array a -> Int
length = Array a -> Int
forall a. Array a -> Int
sizeofArray
{-# INLINE length #-}
maximum :: Array a -> a
maximum ary :: Array a
ary | Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = String -> String -> a
forall a. String -> String -> a
die "maximum" "empty array"
| (# frst :: a
frst #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary 0
= Int -> a -> a
go 1 a
frst
where
sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> a -> a
go i :: Int
i !a
e
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
| (# x :: a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> a -> a
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
e a
x)
{-# INLINE maximum #-}
minimum :: Array a -> a
minimum ary :: Array a
ary | Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = String -> String -> a
forall a. String -> String -> a
die "minimum" "empty array"
| (# frst :: a
frst #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary 0
= Int -> a -> a
go 1 a
frst
where sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> a -> a
go i :: Int
i !a
e
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
| (# x :: a
x #) <- Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> a -> a
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+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
(+) 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
(*) 1
{-# INLINE product #-}
#endif
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 m :: 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
>>= \ ar :: 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 "traverse" "bad indexing"
{-# NOINLINE badTraverseValue #-}
instance Traversable Array where
traverse :: (a -> f b) -> Array a -> f (Array b)
traverse f :: 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 f :: 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
$ \mary :: 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)
| (# x :: 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
b (STA m :: 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
$ \mary :: 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
+ 1))
in if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 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
#-}
#if MIN_VERSION_base(4,8,0)
{-# RULES
"traverse/Id" forall (f :: a -> Identity b). traverseArray f =
(coerce :: (Array a -> Array (Identity b))
-> Array a -> Identity (Array b)) (fmap f)
#-}
#endif
traverseArrayP
:: PrimMonad m
=> (a -> m b)
-> Array a
-> m (Array b)
traverseArrayP :: (a -> m b) -> Array a -> m (Array b)
traverseArrayP f :: 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
+ 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 0 MutableArray (PrimState m) b
mary
{-# INLINE traverseArrayP #-}
mapArray' :: (a -> b) -> Array a -> Array b
mapArray' :: (a -> b) -> Array a -> Array b
mapArray' f :: a -> b
f a :: 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 "mapArray'" "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
$ \mb :: MutableArray s b
mb ->
let go :: Int -> ST s ()
go i :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
in Int -> ST s ()
go 0
{-# INLINE mapArray' #-}
arrayFromListN :: Int -> [a] -> Array a
arrayFromListN :: Int -> [a] -> Array a
arrayFromListN n :: Int
n l :: [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 "fromListN" "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
$ \sma :: 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 "fromListN" "list length less than specified size"
go !Int
ix (x :: a
x : xs :: [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
+1) [a]
xs
else String -> String -> ST s ()
forall a. String -> String -> a
die "fromListN" "list length greater than specified size"
in Int -> [a] -> ST s ()
go 0 [a]
l
arrayFromList :: [a] -> Array a
arrayFromList :: [a] -> Array a
arrayFromList l :: [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
#if MIN_VERSION_base(4,7,0)
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
#else
fromListN :: Int -> [a] -> Array a
fromListN = arrayFromListN
fromList :: [a] -> Array a
fromList = arrayFromList
#endif
instance Functor Array where
fmap :: (a -> b) -> Array a -> Array b
fmap f :: a -> b
f a :: 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 "fmap" "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
$ \mb :: MutableArray s b
mb ->
let go :: Int -> ST s ()
go i :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
in Int -> ST s ()
go 0
#if MIN_VERSION_base(4,8,0)
e :: a
e <$ :: a -> Array b -> Array a
<$ 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 ())
#endif
instance Applicative Array where
pure :: a -> Array a
pure x :: 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 1 a
x
ab :: Array (a -> b)
ab <*> :: Array (a -> b) -> Array a -> Array b
<*> a :: 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
szabInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sza) (String -> String -> b
forall a. String -> String -> a
die "<*>" "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
$ \mb :: MutableArray s b
mb ->
let go1 :: Int -> ST s ()
go1 i :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sza) a -> b
f 0
Int -> ST s ()
go1 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
go2 :: Int -> (a -> b) -> Int -> ST s ()
go2 off :: Int
off f :: a -> b
f j :: 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
+ 1)
in Int -> ST s ()
go1 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
a :: Array a
a *> :: Array a -> Array b -> Array b
*> 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
szaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
szb) (String -> String -> b
forall a. String -> String -> a
die "*>" "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
$ \mb :: MutableArray s b
mb ->
let go :: Int -> ST s ()
go i :: 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 0 Int
szb
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go 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
a :: Array a
a <* :: Array a -> Array b -> Array a
<* b :: 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
szaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
szb) (String -> String -> a
forall a. String -> String -> a
die "<*" "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
$ \ma :: MutableArray s a
ma ->
let fill :: Int -> Int -> a -> ST s ()
fill off :: Int
off i :: Int
i e :: 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
offInt -> 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) a
e
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go :: Int -> ST s ()
go i :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
szb) 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go 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
a1 :: Array a
a1 <|> :: Array a -> Array a -> Array a
<|> a2 :: 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 "<|>" "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
$ \ma :: 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 0 Array a
a1 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 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 a :: 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
== 0 = Array [a]
forall a. Array a
emptyArray
| Bool
otherwise = String -> String -> Array [a]
forall a. String -> String -> a
die "some" "infinite arrays are not well defined"
many :: Array a -> Array [a]
many a :: 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
== 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 "many" "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
(*>)
ary :: Array a
ary >>= :: Array a -> (a -> Array b) -> Array b
>>= f :: a -> Array b
f = Int -> ArrayStack b -> Int -> Array b
collect 0 ArrayStack b
forall a. ArrayStack a
EmptyStack (Int
laInt -> Int -> Int
forall a. Num a => a -> a -> a
-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 sz :: Int
sz stk :: ArrayStack b
stk i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 ">>=" "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 0 ArrayStack b
stk
| (# x :: 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
== 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
- 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
fill :: Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill _ EmptyStack _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
fill off :: Int
off (PushArray sb :: Array a
sb sbs :: ArrayStack a
sbs) smb :: 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 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 _ = 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 s :: String
s f :: a -> b -> c
f aa :: Array a
aa ab :: 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 "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
$ \mc :: MutableArray s c
mc ->
let go :: Int -> ST s ()
go i :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
| Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go 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 #-}
#if MIN_VERSION_base(4,4,0)
instance MonadZip Array where
mzip :: Array a -> Array b -> Array (a, b)
mzip aa :: Array a
aa ab :: 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 "mzip" (,) Array a
aa Array b
ab
mzipWith :: (a -> b -> c) -> Array a -> Array b -> Array c
mzipWith f :: a -> b -> c
f aa :: Array a
aa ab :: 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 "mzipWith" a -> b -> c
f Array a
aa Array b
ab
munzip :: Array (a, b) -> (Array a, Array b)
munzip aab :: 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 "munzip" "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 "munzip" "impossible")
let go :: Int -> ST s ()
go i :: Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = do
(a :: a
a, b :: 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
go _ = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Int -> ST s ()
go 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
#endif
instance MonadFix Array where
mfix :: (a -> Array a) -> Array a
mfix f :: 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 "mfix" "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 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
$
\r :: 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 (\xi :: 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
+ 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 "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 l :: [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 "mconcat" "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
$ \ma :: 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 off :: Int
off (a :: Array a
a:as :: [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 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 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 elemShowsPrec :: Int -> a -> String -> String
elemShowsPrec elemListShowsPrec :: [a] -> String -> String
elemListShowsPrec p :: Int
p a :: Array a
a = Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String -> String -> String
showString "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
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 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 _ sl :: [a] -> String -> String
sl _ = [a] -> String -> String
sl
instance Show a => Show (Array a) where
showsPrec :: Int -> Array a -> String -> String
showsPrec p :: Int
p a :: 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
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
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
#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
#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)
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
#endif
arrayLiftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec _ read_list :: 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
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
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 = 10
data Tag = FromListTag | FromListNTag
lexTag :: ReadP Tag
lexTag :: ReadP Tag
lexTag = do
String
_ <- String -> ReadP String
string "fromList"
String
s <- ReadP String
look
case String
s of
'N':c :: Char
c:_
| '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
<= '9'
-> String -> ReadP Tag
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ""
| Bool
otherwise -> Tag
FromListNTag Tag -> ReadP Char -> ReadP Tag
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP Char
get
_ -> 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 "Data.Primitive.Array.Array" [Constr
fromListConstr]
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
arrayDataType "fromList" [] Fixity
Prefix
instance Data a => Data (Array a) where
toConstr :: Array a -> Constr
toConstr _ = Constr
fromListConstr
dataTypeOf :: Array a -> DataType
dataTypeOf _ = DataType
arrayDataType
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Array a)
gunfold k :: forall b r. Data b => c (b -> r) -> c r
k z :: forall r. r -> c r
z c :: Constr
c = case Constr -> Int
constrIndex Constr
c of
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)
_ -> String -> c (Array a)
forall a. HasCallStack => String -> a
error "gunfold"
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Array a -> c (Array a)
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z m :: 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 _ = String -> Constr
forall a. HasCallStack => String -> a
error "toConstr"
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MutableArray s a)
gunfold _ _ = String -> Constr -> c (MutableArray s a)
forall a. HasCallStack => String -> a
error "gunfold"
dataTypeOf :: MutableArray s a -> DataType
dataTypeOf _ = String -> DataType
mkNoRepType "Data.Primitive.Array.MutableArray"