{-# LANGUAGE CPP, MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
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)
import qualified GHC.ST as GHCST
import qualified Data.Foldable as F
import Data.Semigroup
import Data.Functor.Identity
#if !MIN_VERSION_base(4,10,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(..))
import Language.Haskell.TH.Syntax (Lift (..))
data Array a = Array
{ forall a. Array a -> Array# a
array# :: Array# a }
deriving ( Typeable )
instance Lift a => Lift (Array a) where
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped :: forall (m :: * -> *). Quote m => Array a -> Code m (Array a)
liftTyped Array a
ary = case [a]
lst of
[] -> [|| Array (emptyArray# (##)) ||]
[a
x] -> [|| pure $! x ||]
a
x : [a]
xs -> [|| unsafeArrayFromListN' len x xs ||]
#else
lift ary = case lst of
[] -> [| Array (emptyArray# (##)) |]
[x] -> [| pure $! x |]
x : xs -> [| unsafeArrayFromListN' len x xs |]
#endif
where
len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length Array a
ary
lst :: [a]
lst = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
ary
unsafeArrayFromListN' :: Int -> a -> [a] -> Array a
unsafeArrayFromListN' :: forall a. Int -> a -> [a] -> Array a
unsafeArrayFromListN' Int
n a
y [a]
ys =
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
n a
y forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
let go :: Int -> [a] -> ST s ()
go !Int
_ix [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go !Int
ix (!a
x : [a]
xs) = do
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
ma Int
ix a
x
Int -> [a] -> ST s ()
go (Int
ixforall a. Num a => a -> a -> a
+Int
1) [a]
xs
in Int -> [a] -> ST s ()
go Int
1 [a]
ys
#if MIN_VERSION_deepseq(1,4,3)
instance NFData1 Array where
liftRnf :: forall a. (a -> ()) -> Array a -> ()
liftRnf a -> ()
r = 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\()
_ -> forall a. NFData a => a -> ()
rnf) ()
data MutableArray s a = MutableArray
{ forall s a. MutableArray s a -> MutableArray# s a
marray# :: MutableArray# s a }
deriving ( Typeable )
sizeofArray :: Array a -> Int
sizeofArray :: forall a. Array a -> Int
sizeofArray Array a
a = Int# -> Int
I# (forall a. Array# a -> Int#
sizeofArray# (forall a. Array a -> Array# a
array# Array a
a))
{-# INLINE sizeofArray #-}
sizeofMutableArray :: MutableArray s a -> Int
sizeofMutableArray :: forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray s a
a = Int# -> Int
I# (forall d a. MutableArray# d a -> Int#
sizeofMutableArray# (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 :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (I# Int#
n#) a
x = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
(\State# (PrimState m)
s# -> case 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 = 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 :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray (PrimState m) a
arr (I# Int#
i#) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# (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 :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray (PrimState m) a
arr (I# Int#
i#) a
x = forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# (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 :: forall a. Array a -> Int -> a
indexArray Array a
arr (I# Int#
i#) = case forall a. Array# a -> Int# -> (# a #)
indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i# of (# a
x #) -> a
x
indexArray## :: Array a -> Int -> (# a #)
indexArray## :: forall a. Array a -> Int -> (# a #)
indexArray## Array a
arr (I# Int#
i) = forall a. Array# a -> Int# -> (# a #)
indexArray# (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 :: forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
arr (I# Int#
i#)
= case forall a. Array# a -> Int# -> (# a #)
indexArray# (forall a. Array a -> Array# a
array# Array a
arr) Int#
i# of (# a
x #) -> 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 :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray (MutableArray MutableArray# (PrimState m) a
ma#) (I# Int#
off#) (I# Int#
len#) =
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case 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', forall a. Array# a -> Array a
Array Array# a
a# #)
unsafeFreezeArray :: PrimMonad m => MutableArray (PrimState m) a -> m (Array a)
{-# INLINE unsafeFreezeArray #-}
unsafeFreezeArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) a
arr
= forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case forall d a.
MutableArray# d a -> State# d -> (# State# d, Array# a #)
unsafeFreezeArray# (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 = 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 :: forall (m :: * -> *) a.
PrimMonad m =>
Array a -> Int -> Int -> m (MutableArray (PrimState m) a)
thawArray (Array Array# a
a#) (I# Int#
off#) (I# Int#
len#) =
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s -> case 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', 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 :: forall (m :: * -> *) a.
PrimMonad m =>
Array a -> m (MutableArray (PrimState m) a)
unsafeThawArray Array a
a
= forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (\State# (PrimState m)
s# -> case forall a d.
Array# a -> State# d -> (# State# d, MutableArray# d a #)
unsafeThawArray# (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 = 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 :: forall s a. MutableArray s a -> MutableArray s a -> Bool
sameMutableArray MutableArray s a
arr MutableArray s a
brr
= Int# -> Bool
isTrue# (forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
arr) (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 :: forall (m :: * -> *) a.
PrimMonad m =>
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#)
= forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (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 :: forall (m :: * -> *) a.
PrimMonad m =>
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#)
= forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (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 :: forall a. Array a -> Int -> Int -> Array a
cloneArray (Array Array# a
arr#) (I# Int#
off#) (I# Int#
len#)
= case forall a. Array# a -> Int# -> Int# -> Array# a
cloneArray# Array# a
arr# Int#
off# Int#
len# of Array# a
arr'# -> 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 :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
cloneMutableArray (MutableArray MutableArray# (PrimState m) a
arr#) (I# Int#
off#) (I# Int#
len#) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
(\State# (PrimState m)
s# -> case 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'#, forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# (PrimState m) a
arr'# #))
emptyArray :: Array a
emptyArray :: forall a. Array a
emptyArray =
forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 (forall a. String -> String -> a
die String
"emptyArray" String
"impossible") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
runArray :: forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray forall s. ST s (MutableArray s a)
m = forall a. Array# a -> Array a
Array (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 a. (forall s. ST s (MutableArray s a)) -> Array# a
runArray# forall s. ST s (MutableArray s a)
m = case forall o. (State# RealWorld -> o) -> o
runRW# forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case forall s a. ST s a -> State# s -> (# State# s, a #)
unST forall s. ST s (MutableArray s a)
m State# RealWorld
s of { (# State# RealWorld
s', MutableArray MutableArray# RealWorld a
mary# #) ->
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 :: forall s a. ST s a -> State# s -> (# State# s, a #)
unST (GHCST.ST STRep s a
f) = STRep s a
f
emptyArray# :: (# #) -> Array# a
emptyArray# :: forall a. (# #) -> Array# a
emptyArray# (# #)
_ = case forall a. Array a
emptyArray of Array Array# a
ar -> Array# a
ar
{-# NOINLINE emptyArray# #-}
createArray
:: Int
-> a
-> (forall s. MutableArray s a -> ST s ())
-> Array a
createArray :: forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
0 a
_ forall s. MutableArray s a -> ST s ()
_ = forall a. Array# a -> Array a
Array (forall a. (# #) -> Array# a
emptyArray# (# #))
createArray Int
n a
x forall s. MutableArray s a -> ST s ()
f = forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray forall a b. (a -> b) -> a -> b
$ do
MutableArray s a
mary <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n a
x
forall s. MutableArray s a -> ST s ()
f MutableArray s a
mary
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableArray s a
mary
die :: String -> String -> a
die :: forall a. String -> String -> a
die String
fun String
problem = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Data.Primitive.Array." forall a. [a] -> [a] -> [a]
++ String
fun forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
problem
arrayLiftEq :: (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq :: forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq a -> b -> Bool
p Array a
a1 Array b
a2 = forall a. Array a -> Int
sizeofArray Array a
a1 forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
sizeofArray Array b
a2 Bool -> Bool -> Bool
&& Int -> Bool
loop (forall a. Array a -> Int
sizeofArray Array a
a1 forall a. Num a => a -> a -> a
- Int
1)
where loop :: Int -> Bool
loop Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
True
| (# a
x1 #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
, (# b
x2 #) <- 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 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 = forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq forall a. Eq a => a -> a -> Bool
(==) Array a
a1 Array a
a2
instance Eq1 Array where
liftEq :: forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
liftEq = forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
arrayLiftEq
instance Eq (MutableArray s a) where
MutableArray s a
ma1 == :: MutableArray s a -> MutableArray s a -> Bool
== MutableArray s a
ma2 = Int# -> Bool
isTrue# (forall d a. MutableArray# d a -> MutableArray# d a -> Int#
sameMutableArray# (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ma1) (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ma2))
arrayLiftCompare :: (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare :: forall a b. (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 = forall a. Array a -> Int
sizeofArray Array a
a1 forall a. Ord a => a -> a -> a
`min` forall a. Array a -> Int
sizeofArray Array b
a2
loop :: Int -> Ordering
loop Int
i
| Int
i forall a. Ord a => a -> a -> Bool
< Int
mn
, (# a
x1 #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
a1 Int
i
, (# b
x2 #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array b
a2 Int
i
= a -> b -> Ordering
elemCompare a
x1 b
x2 forall a. Monoid a => a -> a -> a
`mappend` Int -> Ordering
loop (Int
i forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = forall a. Ord a => a -> a -> Ordering
compare (forall a. Array a -> Int
sizeofArray Array a
a1) (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 = forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare forall a. Ord a => a -> a -> Ordering
compare Array a
a1 Array a
a2
instance Ord1 Array where
liftCompare :: forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
liftCompare = forall a b. (a -> b -> Ordering) -> Array a -> Array b -> Ordering
arrayLiftCompare
instance Foldable Array where
foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f = \b
z !Array a
ary ->
let
!sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> b
go Int
i
| Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = b
z
| (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= a -> b -> b
f a
x (Int -> b
go (Int
i forall a. Num a => a -> a -> a
+ Int
1))
in Int -> b
go Int
0
{-# INLINE foldr #-}
foldl :: forall b a. (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 forall a. Ord a => a -> a -> Bool
< Int
0 = b
z
| (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= b -> a -> b
f (Int -> b
go (Int
i forall a. Num a => a -> a -> a
- Int
1)) a
x
in Int -> b
go (forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE foldl #-}
foldr1 :: forall a. (a -> a -> a) -> Array a -> a
foldr1 a -> a -> a
f = \ !Array a
ary ->
let
!sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1
go :: Int -> a
go Int
i =
case forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
(# a
x #) | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz -> a
x
| Bool
otherwise -> a -> a -> a
f a
x (Int -> a
go (Int
i forall a. Num a => a -> a -> a
+ Int
1))
in if Int
sz forall a. Ord a => a -> a -> Bool
< Int
0
then forall a. String -> String -> a
die String
"foldr1" String
"empty array"
else Int -> a
go Int
0
{-# INLINE foldr1 #-}
foldl1 :: forall a. (a -> a -> a) -> Array a -> a
foldl1 a -> a -> a
f = \ !Array a
ary ->
let
!sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1
go :: Int -> a
go Int
i =
case forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i of
(# a
x #) | Int
i forall a. Eq a => a -> a -> Bool
== Int
0 -> a
x
| Bool
otherwise -> a -> a -> a
f (Int -> a
go (Int
i forall a. Num a => a -> a -> a
- Int
1)) a
x
in if Int
sz forall a. Ord a => a -> a -> Bool
< Int
0
then forall a. String -> String -> a
die String
"foldl1" String
"empty array"
else Int -> a
go Int
sz
{-# INLINE foldl1 #-}
foldr' :: forall a b. (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 forall a. Eq a => a -> a -> Bool
== -Int
1 = b
acc
| (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> b -> b
go (Int
i forall a. Num a => a -> a -> a
- Int
1) (a -> b -> b
f a
x b
acc)
in Int -> b -> b
go (forall a. Array a -> Int
sizeofArray Array a
ary forall a. Num a => a -> a -> a
- Int
1) b
z
{-# INLINE foldr' #-}
foldl' :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f = \b
z !Array a
ary ->
let
!sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> b -> b
go Int
i !b
acc
| Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = b
acc
| (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> b -> b
go (Int
i 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 :: forall a. Array a -> Bool
null Array a
a = forall a. Array a -> Int
sizeofArray Array a
a forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE null #-}
length :: forall a. Array a -> Int
length = forall a. Array a -> Int
sizeofArray
{-# INLINE length #-}
maximum :: forall a. Ord a => Array a -> a
maximum Array a
ary | Int
sz forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. String -> String -> a
die String
"maximum" String
"empty array"
| (# a
frst #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
= Int -> a -> a
go Int
1 a
frst
where
sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> a -> a
go Int
i !a
e
| Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
| (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> a -> a
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall a. Ord a => a -> a -> a
max a
e a
x)
{-# INLINE maximum #-}
minimum :: forall a. Ord a => Array a -> a
minimum Array a
ary | Int
sz forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. String -> String -> a
die String
"minimum" String
"empty array"
| (# a
frst #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
0
= Int -> a -> a
go Int
1 a
frst
where sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> a -> a
go Int
i !a
e
| Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = a
e
| (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= Int -> a -> a
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall a. Ord a => a -> a -> a
min a
e a
x)
{-# INLINE minimum #-}
sum :: forall a. Num a => Array a -> a
sum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0
{-# INLINE sum #-}
product :: forall a. Num a => Array a -> a
product = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(*) a
1
{-# INLINE product #-}
newtype STA a = STA { forall a. 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 :: forall a. Int -> STA a -> Array a
runSTA !Int
sz = \ (STA forall s. MutableArray# s a -> ST s (Array a)
m) -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s a. Int -> ST s (MutableArray s a)
newArray_ Int
sz forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ MutableArray s a
ar -> forall s. MutableArray# s a -> ST s (Array a)
m (forall s a. MutableArray s a -> MutableArray# s a
marray# MutableArray s a
ar)
{-# INLINE runSTA #-}
newArray_ :: Int -> ST s (MutableArray s a)
newArray_ :: forall s a. Int -> ST s (MutableArray s a)
newArray_ !Int
n = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n forall a. a
badTraverseValue
badTraverseValue :: a
badTraverseValue :: forall a. a
badTraverseValue = forall a. String -> String -> a
die String
"traverse" String
"bad indexing"
{-# NOINLINE badTraverseValue #-}
instance Traversable Array where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverse a -> f b
f = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverseArray a -> f b
f = \ !Array a
ary ->
let
!len :: Int
len = forall a. Array a -> Int
sizeofArray Array a
ary
go :: Int -> f (STA b)
go !Int
i
| Int
i forall a. Eq a => a -> a -> Bool
== Int
len = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary -> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray (forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary)
| (# a
x #) <- forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
= 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 a. (forall s. MutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \MutableArray# s b
mary ->
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray (forall s a. MutableArray# s a -> MutableArray s a
MutableArray MutableArray# s b
mary) Int
i b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m 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 forall a. Num a => a -> a -> a
+ Int
1))
in if Int
len forall a. Eq a => a -> a -> Bool
== Int
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Array a
emptyArray
else forall a. Int -> STA a -> Array a
runSTA Int
len 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 :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> m b) -> Array a -> m (Array b)
traverseArrayP a -> m b
f = \ !Array a
ary ->
let
!sz :: Int
sz = 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 forall a. Eq a => a -> a -> Bool
== Int
sz
= forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray (PrimState m) b
mary
| Bool
otherwise
= do
a
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
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 forall a. Num a => a -> a -> a
+ Int
1) MutableArray (PrimState m) b
mary
in do
MutableArray (PrimState m) b
mary <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz 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' :: forall a b. (a -> b) -> Array a -> Array b
mapArray' a -> b
f Array a
a =
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray Array a
a) (forall a. String -> String -> a
die String
"mapArray'" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go :: Int -> ST s ()
go Int
i | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
sizeofArray Array a
a
= forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do a
x <- 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
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb Int
i b
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
in Int -> ST s ()
go Int
0
{-# INLINE mapArray' #-}
arrayFromListN :: Int -> [a] -> Array a
arrayFromListN :: forall a. Int -> [a] -> Array a
arrayFromListN Int
n [a]
l =
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
n (forall a. String -> String -> a
die String
"fromListN" String
"uninitialized element") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
sma ->
let go :: Int -> [a] -> ST s ()
go !Int
ix [] = if Int
ix forall a. Eq a => a -> a -> Bool
== Int
n
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else 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 forall a. Ord a => a -> a -> Bool
< Int
n
then do
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
sma Int
ix a
x
Int -> [a] -> ST s ()
go (Int
ixforall a. Num a => a -> a -> a
+Int
1) [a]
xs
else 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 :: forall a. [a] -> Array a
arrayFromList [a]
l = forall a. Int -> [a] -> Array a
arrayFromListN (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 = forall a. Int -> [a] -> Array a
arrayFromListN
fromList :: [Item (Array a)] -> Array a
fromList = forall a. [a] -> Array a
arrayFromList
toList :: Array a -> [Item (Array a)]
toList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Functor Array where
fmap :: forall a b. (a -> b) -> Array a -> Array b
fmap a -> b
f Array a
a =
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray Array a
a) (forall a. String -> String -> a
die String
"fmap" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go :: Int -> ST s ()
go Int
i | Int
i forall a. Eq a => a -> a -> Bool
== forall a. Array a -> Int
sizeofArray Array a
a
= forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do a
x <- forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb Int
i (a -> b
f a
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
in Int -> ST s ()
go Int
0
a
e <$ :: forall a b. a -> Array b -> Array a
<$ Array b
a = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray Array b
a) a
e (\ !MutableArray s a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Applicative Array where
pure :: forall a. a -> Array a
pure a
x = forall a. (forall s. ST s (MutableArray s a)) -> Array a
runArray forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
1 a
x
Array (a -> b)
ab <*> :: forall a b. Array (a -> b) -> Array a -> Array b
<*> Array a
a = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
szab forall a. Num a => a -> a -> a
* Int
sza) (forall a. String -> String -> a
die String
"<*>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go1 :: Int -> ST s ()
go1 Int
i = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
szab) forall a b. (a -> b) -> a -> b
$
do
a -> b
f <- 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 forall a. Num a => a -> a -> a
* Int
sza) a -> b
f Int
0
Int -> ST s ()
go1 (Int
i forall a. Num a => a -> a -> a
+ Int
1)
go2 :: Int -> (a -> b) -> Int -> ST s ()
go2 Int
off a -> b
f Int
j = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j forall a. Ord a => a -> a -> Bool
< Int
sza) forall a b. (a -> b) -> a -> b
$
do
a
x <- forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
j
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb (Int
off 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 forall a. Num a => a -> a -> a
+ Int
1)
in Int -> ST s ()
go1 Int
0
where szab :: Int
szab = forall a. Array a -> Int
sizeofArray Array (a -> b)
ab; sza :: Int
sza = forall a. Array a -> Int
sizeofArray Array a
a
Array a
a *> :: forall a b. Array a -> Array b -> Array b
*> Array b
b = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza forall a. Num a => a -> a -> a
* Int
szb) (forall a. String -> String -> a
die String
"*>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s b
mb ->
let go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
sza = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s b
mb (Int
i forall a. Num a => a -> a -> a
* Int
szb) Array b
b Int
0 Int
szb forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go Int
0
where sza :: Int
sza = forall a. Array a -> Int
sizeofArray Array a
a; szb :: Int
szb = forall a. Array a -> Int
sizeofArray Array b
b
Array a
a <* :: forall a b. Array a -> Array b -> Array a
<* Array b
b = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza forall a. Num a => a -> a -> a
* Int
szb) (forall a. String -> String -> a
die String
"<*" String
"impossible") 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 forall a. Ord a => a -> a -> Bool
< Int
szb = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
ma (Int
off forall a. Num a => a -> a -> a
+ Int
i) a
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> a -> ST s ()
fill Int
off (Int
i forall a. Num a => a -> a -> a
+ Int
1) a
e
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
sza
= do a
x <- forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
a Int
i
Int -> Int -> a -> ST s ()
fill (Int
i forall a. Num a => a -> a -> a
* Int
szb) Int
0 a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go Int
0
where sza :: Int
sza = forall a. Array a -> Int
sizeofArray Array a
a; szb :: Int
szb = forall a. Array a -> Int
sizeofArray Array b
b
instance Alternative Array where
empty :: forall a. Array a
empty = forall a. Array a
emptyArray
Array a
a1 <|> :: forall a. Array a -> Array a -> Array a
<|> Array a
a2 = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
sza1 forall a. Num a => a -> a -> a
+ Int
sza2) (forall a. String -> String -> a
die String
"<|>" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma Int
0 Array a
a1 Int
0 Int
sza1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma Int
sza1 Array a
a2 Int
0 Int
sza2
where sza1 :: Int
sza1 = forall a. Array a -> Int
sizeofArray Array a
a1; sza2 :: Int
sza2 = forall a. Array a -> Int
sizeofArray Array a
a2
some :: forall a. Array a -> Array [a]
some Array a
a | forall a. Array a -> Int
sizeofArray Array a
a forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Array a
emptyArray
| Bool
otherwise = forall a. String -> String -> a
die String
"some" String
"infinite arrays are not well defined"
many :: forall a. Array a -> Array [a]
many Array a
a | forall a. Array a -> Int
sizeofArray Array a
a forall a. Eq a => a -> a -> Bool
== Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise = 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 :: forall a. a -> Array a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
>> :: forall a b. Array a -> Array b -> Array b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
Array a
ary >>= :: forall a b. Array a -> (a -> Array b) -> Array b
>>= a -> Array b
f = Int -> ArrayStack b -> Int -> Array b
collect Int
0 forall a. ArrayStack a
EmptyStack (Int
la forall a. Num a => a -> a -> a
- Int
1)
where
la :: Int
la = 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 forall a. Ord a => a -> a -> Bool
< Int
0 = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (forall a. String -> String -> a
die String
">>=" String
"impossible") forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a}.
PrimMonad m =>
Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill Int
0 ArrayStack b
stk
| (# a
x #) <- 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 = forall a. Array a -> Int
sizeofArray Array b
sb
= if Int
lsb forall a. Eq a => a -> a -> Bool
== Int
0
then Int -> ArrayStack b -> Int -> Array b
collect Int
sz ArrayStack b
stk (Int
i forall a. Num a => a -> a -> a
- Int
1)
else Int -> ArrayStack b -> Int -> Array b
collect (Int
sz forall a. Num a => a -> a -> a
+ Int
lsb) (forall a. Array a -> ArrayStack a -> ArrayStack a
PushArray Array b
sb ArrayStack b
stk) (Int
i 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
_ = 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 = forall a. Array a -> Int
sizeofArray Array a
sb
= 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
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ArrayStack a -> MutableArray (PrimState m) a -> m ()
fill (Int
off 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 :: forall a. String -> Array a
fail String
_ = forall (f :: * -> *) a. Alternative f => f a
empty
instance MonadPlus Array where
mzero :: forall a. Array a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
mplus :: forall a. Array a -> Array a -> Array a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
zipW :: String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW :: forall a b c.
String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
s a -> b -> c
f Array a
aa Array b
ab = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
mn (forall a. String -> String -> a
die String
s String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s c
mc ->
let go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
mn
= do
a
x <- forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
aa Int
i
b
y <- forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array b
ab Int
i
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s c
mc Int
i (a -> b -> c
f a
x b
y)
Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go Int
0
where mn :: Int
mn = forall a. Array a -> Int
sizeofArray Array a
aa forall a. Ord a => a -> a -> a
`min` forall a. Array a -> Int
sizeofArray Array b
ab
{-# INLINE zipW #-}
instance MonadZip Array where
mzip :: forall a b. Array a -> Array b -> Array (a, b)
mzip Array a
aa Array b
ab = forall a b c.
String -> (a -> b -> c) -> Array a -> Array b -> Array c
zipW String
"mzip" (,) Array a
aa Array b
ab
mzipWith :: forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c
mzipWith a -> b -> c
f Array a
aa Array b
ab = 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 :: forall a b. Array (a, b) -> (Array a, Array b)
munzip Array (a, b)
aab = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
let sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array (a, b)
aab
MutableArray s a
ma <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz (forall a. String -> String -> a
die String
"munzip" String
"impossible")
MutableArray s b
mb <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz (forall a. String -> String -> a
die String
"munzip" String
"impossible")
let go :: Int -> ST s ()
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
sz = do
(a
a, b
b) <- forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array (a, b)
aab Int
i
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
ma Int
i a
a
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s b
mb Int
i b
b
Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
go Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
Int -> ST s ()
go Int
0
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
ma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s b
mb
instance MonadFix Array where
mfix :: forall a. (a -> Array a) -> Array a
mfix a -> Array a
f = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (forall a. Array a -> Int
sizeofArray (a -> Array a
f forall a. a
err))
(forall a. String -> String -> a
die String
"mfix" String
"impossible") forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix Int
0 forall a b. (a -> b) -> a -> b
$
\Int -> MutableArray s a -> ST s ()
r !Int
i !MutableArray s a
mary -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
< Int
sz) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
mary Int
i (forall a. (a -> a) -> a
fix (\a
xi -> a -> Array a
f a
xi forall a. Array a -> Int -> a
`indexArray` Int
i))
Int -> MutableArray s a -> ST s ()
r (Int
i forall a. Num a => a -> a -> a
+ Int
1) MutableArray s a
mary
where
sz :: Int
sz = forall a. Array a -> Int
sizeofArray (a -> Array a
f forall a. a
err)
err :: a
err = forall a. HasCallStack => String -> a
error String
"mfix for Data.Primitive.Array applied to strict function."
instance Semigroup (Array a) where
<> :: Array a -> Array a -> Array a
(<>) = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
sconcat :: NonEmpty (Array a) -> Array a
sconcat = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
stimes :: forall b. Integral b => b -> Array a -> Array a
stimes b
n Array a
arr = case forall a. Ord a => a -> a -> Ordering
compare b
n b
0 of
Ordering
LT -> forall a. String -> String -> a
die String
"stimes" String
"negative multiplier"
Ordering
EQ -> forall (f :: * -> *) a. Alternative f => f a
empty
Ordering
GT -> forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray (Int
n' forall a. Num a => a -> a -> a
* forall a. Array a -> Int
sizeofArray Array a
arr) (forall a. String -> String -> a
die String
"stimes" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
let go :: Int -> ST s ()
go Int
i = if Int
i forall a. Ord a => a -> a -> Bool
< Int
n'
then do
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma (Int
i forall a. Num a => a -> a -> a
* forall a. Array a -> Int
sizeofArray Array a
arr) Array a
arr Int
0 (forall a. Array a -> Int
sizeofArray Array a
arr)
Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
in Int -> ST s ()
go Int
0
where n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n :: Int
instance Monoid (Array a) where
mempty :: Array a
mempty = 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 = forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
createArray Int
sz (forall a. String -> String -> a
die String
"mconcat" String
"impossible") forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
let go :: Int -> [Array a] -> ST s ()
go !Int
_ [ ] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int
off (Array a
a:[Array a]
as) =
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
ma Int
off Array a
a Int
0 (forall a. Array a -> Int
sizeofArray Array a
a) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [Array a] -> ST s ()
go (Int
off forall a. Num a => a -> a -> a
+ 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 = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Array a -> Int
sizeofArray forall a b. (a -> b) -> a -> b
$ [Array a]
l
arrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec Int -> a -> ShowS
elemShowsPrec [a] -> ShowS
elemListShowsPrec Int
p Array a
a = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromListN " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Array a -> Int
sizeofArray Array a
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec Int -> a -> ShowS
elemShowsPrec [a] -> ShowS
elemListShowsPrec Int
11 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array a
a)
listLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
listLiftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
sl Int
_ = [a] -> ShowS
sl
instance Show a => Show (Array a) where
showsPrec :: Int -> Array a -> ShowS
showsPrec Int
p Array a
a = forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList Int
p Array a
a
instance Show1 Array where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
liftShowsPrec = forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array a -> ShowS
arrayLiftShowsPrec
instance Read a => Read (Array a) where
readPrec :: ReadPrec (Array a)
readPrec = forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec forall a. Read a => ReadPrec a
readPrec forall a. Read a => ReadPrec [a]
readListPrec
instance Read1 Array where
#if MIN_VERSION_base(4,10,0)
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
liftReadPrec = forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec
#else
liftReadsPrec = arrayLiftReadsPrec
#endif
arrayLiftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Array a)
arrayLiftReadPrec ReadPrec a
_ ReadPrec [a]
read_list = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP ()
skipSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
((forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
read_list) forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
RdPrc.+++
do
Tag
tag <- forall a. ReadP a -> ReadPrec a
RdPrc.lift ReadP Tag
lexTag
case Tag
tag of
Tag
FromListTag -> forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
read_list
Tag
FromListNTag -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall l. IsList l => Int -> [Item l] -> l
fromListN 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' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'
-> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
| Bool
otherwise -> Tag
FromListNTag forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP Char
get
String
_ -> 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 (c :: * -> *).
(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 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall l. IsList l => [Item l] -> l
fromList)
Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
gfoldl :: forall (c :: * -> *).
(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 = forall g. g -> c g
z forall l. IsList l => [Item l] -> l
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` 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
_ = forall a. HasCallStack => String -> a
error String
"toConstr"
gunfold :: forall (c :: * -> *).
(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
_ = 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"