{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE Rank2Types            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE UnboxedTuples         #-}
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- Zero based arrays.
--
-- Note that no bounds checking are performed.
module Data.Strict.HashMap.Autogen.Internal.Array
    ( Array(..)
    , MArray(..)

      -- * Creation
    , new
    , new_
    , singleton
    , singletonM
    , snoc
    , pair

      -- * Basic interface
    , length
    , lengthM
    , read
    , write
    , index
    , indexM
    , index#
    , update
    , updateWith'
    , unsafeUpdateM
    , insert
    , insertM
    , delete
    , sameArray1
    , trim

    , unsafeFreeze
    , unsafeThaw
    , unsafeSameArray
    , run
    , copy
    , copyM

      -- * Folds
    , foldl
    , foldl'
    , foldr
    , foldr'
    , foldMap
    , all

    , thaw
    , map
    , map'
    , traverse
    , traverse'
    , toList
    , fromList
    , fromList'
    , shrink
    ) where

import Control.Applicative (liftA2)
import Control.DeepSeq     (NFData (..), NFData1 (..))
import Control.Monad       ((>=>))
import Control.Monad.ST    (runST, stToIO)
import GHC.Exts            (Int (..), SmallArray#, SmallMutableArray#,
                            cloneSmallMutableArray#, copySmallArray#,
                            copySmallMutableArray#, indexSmallArray#,
                            newSmallArray#, readSmallArray#,
                            reallyUnsafePtrEquality#, sizeofSmallArray#,
                            sizeofSmallMutableArray#, tagToEnum#,
                            thawSmallArray#, unsafeCoerce#,
                            unsafeFreezeSmallArray#, unsafeThawSmallArray#,
                            writeSmallArray#)
import GHC.ST              (ST (..))
import Prelude             hiding (all, filter, foldMap, foldl, foldr, length,
                            map, read, traverse)

import qualified GHC.Exts                   as Exts
import qualified Language.Haskell.TH.Syntax as TH
#if defined(ASSERTS)
import qualified Prelude
#endif


#if defined(ASSERTS)
-- This fugly hack is brought by GHC's apparent reluctance to deal
-- with MagicHash and UnboxedTuples when inferring types. Eek!
# define CHECK_BOUNDS(_func_,_len_,_k_) \
if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Strict.HashMap.Autogen.Internal.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
# define CHECK_OP(_func_,_op_,_lhs_,_rhs_) \
if not ((_lhs_) _op_ (_rhs_)) then error ("Data.Strict.HashMap.Autogen.Internal.Array." ++ (_func_) ++ ": Check failed: _lhs_ _op_ _rhs_ (" ++ show (_lhs_) ++ " vs. " ++ show (_rhs_) ++ ")") else
# define CHECK_GT(_func_,_lhs_,_rhs_) CHECK_OP(_func_,>,_lhs_,_rhs_)
# define CHECK_LE(_func_,_lhs_,_rhs_) CHECK_OP(_func_,<=,_lhs_,_rhs_)
# define CHECK_EQ(_func_,_lhs_,_rhs_) CHECK_OP(_func_,==,_lhs_,_rhs_)
#else
# define CHECK_BOUNDS(_func_,_len_,_k_)
# define CHECK_OP(_func_,_op_,_lhs_,_rhs_)
# define CHECK_GT(_func_,_lhs_,_rhs_)
# define CHECK_LE(_func_,_lhs_,_rhs_)
# define CHECK_EQ(_func_,_lhs_,_rhs_)
#endif

data Array a = Array {
      forall a. Array a -> SmallArray# a
unArray :: !(SmallArray# a)
    }

instance Show a => Show (Array a) where
    show :: Array a -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> [a]
toList

-- Determines whether two arrays have the same memory address.
-- This is more reliable than testing pointer equality on the
-- Array wrappers, but it's still slightly bogus.
unsafeSameArray :: Array a -> Array b -> Bool
unsafeSameArray :: forall a b. Array a -> Array b -> Bool
unsafeSameArray (Array SmallArray# a
xs) (Array SmallArray# b
ys) =
  forall a. Int# -> a
tagToEnum# (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# forall a. a -> a -> Int#
reallyUnsafePtrEquality# SmallArray# a
xs SmallArray# b
ys)

sameArray1 :: (a -> b -> Bool) -> Array a -> Array b -> Bool
sameArray1 :: forall a b. (a -> b -> Bool) -> Array a -> Array b -> Bool
sameArray1 a -> b -> Bool
eq !Array a
xs0 !Array b
ys0
  | Int
lenxs forall a. Eq a => a -> a -> Bool
/= Int
lenys = Bool
False
  | Bool
otherwise = Int -> Array a -> Array b -> Bool
go Int
0 Array a
xs0 Array b
ys0
  where
    go :: Int -> Array a -> Array b -> Bool
go !Int
k !Array a
xs !Array b
ys
      | Int
k forall a. Eq a => a -> a -> Bool
== Int
lenxs = Bool
True
      | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# Array a
xs Int
k
      , (# b
y #) <- forall a. Array a -> Int -> (# a #)
index# Array b
ys Int
k
      = a -> b -> Bool
eq a
x b
y Bool -> Bool -> Bool
&& Int -> Array a -> Array b -> Bool
go (Int
k forall a. Num a => a -> a -> a
+ Int
1) Array a
xs Array b
ys

    !lenxs :: Int
lenxs = forall a. Array a -> Int
length Array a
xs0
    !lenys :: Int
lenys = forall a. Array a -> Int
length Array b
ys0

length :: Array a -> Int
length :: forall a. Array a -> Int
length Array a
ary = Int# -> Int
I# (forall a. SmallArray# a -> Int#
sizeofSmallArray# (forall a. Array a -> SmallArray# a
unArray Array a
ary))
{-# INLINE length #-}

data MArray s a = MArray {
      forall s a. MArray s a -> SmallMutableArray# s a
unMArray :: !(SmallMutableArray# s a)
    }

lengthM :: MArray s a -> Int
lengthM :: forall s a. MArray s a -> Int
lengthM MArray s a
mary = Int# -> Int
I# (forall d a. SmallMutableArray# d a -> Int#
sizeofSmallMutableArray# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s a
mary))
{-# INLINE lengthM #-}

------------------------------------------------------------------------

instance NFData a => NFData (Array a) where
    rnf :: Array a -> ()
rnf = forall a. NFData a => Array a -> ()
rnfArray

rnfArray :: NFData a => Array a -> ()
rnfArray :: forall a. NFData a => Array a -> ()
rnfArray Array a
ary0 = forall {a}. NFData a => Array a -> Int -> Int -> ()
go Array a
ary0 Int
n0 Int
0
  where
    n0 :: Int
n0 = forall a. Array a -> Int
length Array a
ary0
    go :: Array a -> Int -> Int -> ()
go !Array a
ary !Int
n !Int
i
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = ()
        | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# Array a
ary Int
i
        = forall a. NFData a => a -> ()
rnf a
x seq :: forall a b. a -> b -> b
`seq` Array a -> Int -> Int -> ()
go Array a
ary Int
n (Int
iforall a. Num a => a -> a -> a
+Int
1)
-- We use index# just in case GHC can't see that the
-- relevant rnf is strict, or in case it actually isn't.
{-# INLINE rnfArray #-}

-- | @since 0.2.14.0
instance NFData1 Array where
    liftRnf :: forall a. (a -> ()) -> Array a -> ()
liftRnf = forall a. (a -> ()) -> Array a -> ()
liftRnfArray

liftRnfArray :: (a -> ()) -> Array a -> ()
liftRnfArray :: forall a. (a -> ()) -> Array a -> ()
liftRnfArray a -> ()
rnf0 Array a
ary0 = Array a -> Int -> Int -> ()
go Array a
ary0 Int
n0 Int
0
  where
    n0 :: Int
n0 = forall a. Array a -> Int
length Array a
ary0
    go :: Array a -> Int -> Int -> ()
go !Array a
ary !Int
n !Int
i
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = ()
        | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# Array a
ary Int
i
        = a -> ()
rnf0 a
x seq :: forall a b. a -> b -> b
`seq` Array a -> Int -> Int -> ()
go Array a
ary Int
n (Int
iforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE liftRnfArray #-}

-- | Create a new mutable array of specified size, in the specified
-- state thread, with each element containing the specified initial
-- value.
new :: Int -> a -> ST s (MArray s a)
new :: forall a s. Int -> a -> ST s (MArray s a)
new Int
i !a
b = forall a s. Int -> a -> ST s (MArray s a)
new' Int
i a
b
{-# INLINE new #-}

new' :: Int -> a -> ST s (MArray s a)
new' :: forall a s. Int -> a -> ST s (MArray s a)
new' _n :: Int
_n@(I# Int#
n#) a
b =
    CHECK_GT("new",_n,(0 :: Int))
    forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s ->
        case forall a d.
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
n# a
b State# s
s of
            (# State# s
s', SmallMutableArray# s a
ary #) -> (# State# s
s', forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s a
ary #)
{-# INLINE new' #-}

new_ :: Int -> ST s (MArray s a)
new_ :: forall s a. Int -> ST s (MArray s a)
new_ Int
n = forall a s. Int -> a -> ST s (MArray s a)
new' Int
n forall a. a
undefinedElem

-- | When 'Exts.shrinkSmallMutableArray#' is available, the returned array is the same as the array given, as it is shrunk in place.
-- Otherwise a copy is made.
shrink :: MArray s a -> Int -> ST s (MArray s a)
#if __GLASGOW_HASKELL__ >= 810
shrink :: forall s a. MArray s a -> Int -> ST s (MArray s a)
shrink MArray s a
mary _n :: Int
_n@(I# Int#
n#) =
  CHECK_GT("shrink", _n, (0 :: Int))
  CHECK_LE("shrink", _n, (lengthM mary))
  forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s -> case forall d a. SmallMutableArray# d a -> Int# -> State# d -> State# d
Exts.shrinkSmallMutableArray# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s a
mary) Int#
n# State# s
s of
    State# s
s' -> (# State# s
s', MArray s a
mary #)
#else
shrink mary n = cloneM mary 0 n
#endif 
{-# INLINE shrink #-}

singleton :: a -> Array a
singleton :: forall a. a -> Array a
singleton !a
x = forall a. (forall s. ST s a) -> a
runST (forall a s. a -> ST s (Array a)
singletonM a
x)
{-# INLINE singleton #-}

singletonM :: a -> ST s (Array a)
singletonM :: forall a s. a -> ST s (Array a)
singletonM !a
x = forall a s. Int -> a -> ST s (MArray s a)
new Int
1 a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a. MArray s a -> ST s (Array a)
unsafeFreeze
{-# INLINE singletonM #-}

snoc :: Array a -> a -> Array a
snoc :: forall a. Array a -> a -> Array a
snoc Array a
ary a
x = forall e. (forall s. ST s (MArray s e)) -> Array e
run forall a b. (a -> b) -> a -> b
$ do
  MArray s a
mary <- forall a s. Int -> a -> ST s (MArray s a)
new (Int
n forall a. Num a => a -> a -> a
+ Int
1) a
x
  forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
copy Array a
ary Int
0 MArray s a
mary Int
0 Int
n
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MArray s a
mary
  where
    n :: Int
n = forall a. Array a -> Int
length Array a
ary
{-# INLINE snoc #-}

pair :: a -> a -> Array a
pair :: forall a. a -> a -> Array a
pair !a
x !a
y = forall e. (forall s. ST s (MArray s e)) -> Array e
run forall a b. (a -> b) -> a -> b
$ do
    MArray s a
ary <- forall a s. Int -> a -> ST s (MArray s a)
new Int
2 a
x
    forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s a
ary Int
1 a
y
    forall (m :: * -> *) a. Monad m => a -> m a
return MArray s a
ary
{-# INLINE pair #-}

read :: MArray s a -> Int -> ST s a
read :: forall s a. MArray s a -> Int -> ST s a
read MArray s a
ary _i :: Int
_i@(I# Int#
i#) = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \ State# s
s ->
    CHECK_BOUNDS("read", lengthM ary, _i)
        forall d a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s a
ary) Int#
i# State# s
s
{-# INLINE read #-}

write :: MArray s a -> Int -> a -> ST s ()
write :: forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s a
ary _i :: Int
_i@(I# Int#
i#) !a
b = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \ State# s
s ->
    CHECK_BOUNDS("write", lengthM ary, _i)
        case forall d a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s a
ary) Int#
i# a
b State# s
s of
            State# s
s' -> (# State# s
s' , () #)
{-# INLINE write #-}

index :: Array a -> Int -> a
index :: forall a. Array a -> Int -> a
index Array a
ary _i :: Int
_i@(I# Int#
i#) =
    CHECK_BOUNDS("index", length ary, _i)
        case forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# (forall a. Array a -> SmallArray# a
unArray Array a
ary) Int#
i# of (# a
b #) -> a
b
{-# INLINE index #-}

index# :: Array a -> Int -> (# a #)
index# :: forall a. Array a -> Int -> (# a #)
index# Array a
ary _i :: Int
_i@(I# Int#
i#) =
    CHECK_BOUNDS("index#", length ary, _i)
        forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# (forall a. Array a -> SmallArray# a
unArray Array a
ary) Int#
i#
{-# INLINE index# #-}

indexM :: Array a -> Int -> ST s a
indexM :: forall a s. Array a -> Int -> ST s a
indexM Array a
ary _i :: Int
_i@(I# Int#
i#) =
    CHECK_BOUNDS("indexM", length ary, _i)
        case forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# (forall a. Array a -> SmallArray# a
unArray Array a
ary) Int#
i# of (# a
b #) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
b
{-# INLINE indexM #-}

unsafeFreeze :: MArray s a -> ST s (Array a)
unsafeFreeze :: forall s a. MArray s a -> ST s (Array a)
unsafeFreeze MArray s a
mary
    = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s -> case forall d a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s a
mary) State# s
s of
                   (# State# s
s', SmallArray# a
ary #) -> (# State# s
s', forall a. SmallArray# a -> Array a
Array SmallArray# a
ary #)
{-# INLINE unsafeFreeze #-}

unsafeThaw :: Array a -> ST s (MArray s a)
unsafeThaw :: forall a s. Array a -> ST s (MArray s a)
unsafeThaw Array a
ary
    = forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \State# s
s -> case forall a d.
SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #)
unsafeThawSmallArray# (forall a. Array a -> SmallArray# a
unArray Array a
ary) State# s
s of
                   (# State# s
s', SmallMutableArray# s a
mary #) -> (# State# s
s', forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s a
mary #)
{-# INLINE unsafeThaw #-}

run :: (forall s . ST s (MArray s e)) -> Array e
run :: forall e. (forall s. ST s (MArray s e)) -> Array e
run forall s. ST s (MArray s e)
act = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s. ST s (MArray s e)
act forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a. MArray s a -> ST s (Array a)
unsafeFreeze
{-# INLINE run #-}

-- | Unsafely copy the elements of an array. Array bounds are not checked.
copy :: Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
copy :: forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
copy !Array e
src !_sidx :: Int
_sidx@(I# Int#
sidx#) !MArray s e
dst !_didx :: Int
_didx@(I# Int#
didx#) _n :: Int
_n@(I# Int#
n#) =
    CHECK_LE("copy", _sidx + _n, length src)
    CHECK_LE("copy", _didx + _n, lengthM dst)
        forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \ State# s
s# ->
        case forall a d.
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallArray# (forall a. Array a -> SmallArray# a
unArray Array e
src) Int#
sidx# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s e
dst) Int#
didx# Int#
n# State# s
s# of
            State# s
s2 -> (# State# s
s2, () #)

-- | Unsafely copy the elements of an array. Array bounds are not checked.
copyM :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
copyM :: forall s e.
MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
copyM !MArray s e
src !_sidx :: Int
_sidx@(I# Int#
sidx#) !MArray s e
dst !_didx :: Int
_didx@(I# Int#
didx#) _n :: Int
_n@(I# Int#
n#) =
    CHECK_BOUNDS("copyM: src", lengthM src, _sidx + _n - 1)
    CHECK_BOUNDS("copyM: dst", lengthM dst, _didx + _n - 1)
    forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \ State# s
s# ->
    case forall d a.
SmallMutableArray# d a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copySmallMutableArray# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s e
src) Int#
sidx# (forall s a. MArray s a -> SmallMutableArray# s a
unMArray MArray s e
dst) Int#
didx# Int#
n# State# s
s# of
        State# s
s2 -> (# State# s
s2, () #)

cloneM :: MArray s a -> Int -> Int -> ST s (MArray s a)
cloneM :: forall s a. MArray s a -> Int -> Int -> ST s (MArray s a)
cloneM _mary :: MArray s a
_mary@(MArray SmallMutableArray# s a
mary#) _off :: Int
_off@(I# Int#
off#) _len :: Int
_len@(I# Int#
len#) =
    CHECK_BOUNDS("cloneM_off", lengthM _mary, _off)
    CHECK_BOUNDS("cloneM_end", lengthM _mary, _off + _len - 1)
    forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \ State# s
s ->
    case forall d a.
SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
cloneSmallMutableArray# SmallMutableArray# s a
mary# Int#
off# Int#
len# State# s
s of
      (# State# s
s', SmallMutableArray# s a
mary'# #) -> (# State# s
s', forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s a
mary'# #)

-- | Create a new array of the @n@ first elements of @mary@.
trim :: MArray s a -> Int -> ST s (Array a)
trim :: forall s a. MArray s a -> Int -> ST s (Array a)
trim MArray s a
mary Int
n = forall s a. MArray s a -> Int -> Int -> ST s (MArray s a)
cloneM MArray s a
mary Int
0 Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s a. MArray s a -> ST s (Array a)
unsafeFreeze
{-# INLINE trim #-}

-- | \(O(n)\) Insert an element at the given position in this array,
-- increasing its size by one.
insert :: Array e -> Int -> e -> Array e
insert :: forall e. Array e -> Int -> e -> Array e
insert Array e
ary Int
idx e
b = forall a. (forall s. ST s a) -> a
runST (forall e s. Array e -> Int -> e -> ST s (Array e)
insertM Array e
ary Int
idx e
b)
{-# INLINE insert #-}

-- | \(O(n)\) Insert an element at the given position in this array,
-- increasing its size by one.
insertM :: Array e -> Int -> e -> ST s (Array e)
insertM :: forall e s. Array e -> Int -> e -> ST s (Array e)
insertM Array e
ary Int
idx e
b =
    CHECK_BOUNDS("insertM", count + 1, idx)
        do MArray s e
mary <- forall a s. Int -> a -> ST s (MArray s a)
new (Int
countforall a. Num a => a -> a -> a
+Int
1) e
b
           forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
copy Array e
ary Int
0 MArray s e
mary Int
0 Int
idx
           forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
copy Array e
ary Int
idx MArray s e
mary (Int
idxforall a. Num a => a -> a -> a
+Int
1) (Int
countforall a. Num a => a -> a -> a
-Int
idx)
           forall s a. MArray s a -> ST s (Array a)
unsafeFreeze MArray s e
mary
  where !count :: Int
count = forall a. Array a -> Int
length Array e
ary
{-# INLINE insertM #-}

-- | \(O(n)\) Update the element at the given position in this array.
update :: Array e -> Int -> e -> Array e
update :: forall e. Array e -> Int -> e -> Array e
update Array e
ary Int
idx e
b = forall a. (forall s. ST s a) -> a
runST (forall e s. Array e -> Int -> e -> ST s (Array e)
updateM Array e
ary Int
idx e
b)
{-# INLINE update #-}

-- | \(O(n)\) Update the element at the given position in this array.
updateM :: Array e -> Int -> e -> ST s (Array e)
updateM :: forall e s. Array e -> Int -> e -> ST s (Array e)
updateM Array e
ary Int
idx e
b =
    CHECK_BOUNDS("updateM", count, idx)
        do MArray s e
mary <- forall e s. Array e -> Int -> Int -> ST s (MArray s e)
thaw Array e
ary Int
0 Int
count
           forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s e
mary Int
idx e
b
           forall s a. MArray s a -> ST s (Array a)
unsafeFreeze MArray s e
mary
  where !count :: Int
count = forall a. Array a -> Int
length Array e
ary
{-# INLINE updateM #-}

-- | \(O(n)\) Update the element at the given positio in this array, by
-- applying a function to it.  Evaluates the element to WHNF before
-- inserting it into the array.
updateWith' :: Array e -> Int -> (e -> e) -> Array e
updateWith' :: forall e. Array e -> Int -> (e -> e) -> Array e
updateWith' Array e
ary Int
idx e -> e
f
  | (# e
x #) <- forall a. Array a -> Int -> (# a #)
index# Array e
ary Int
idx
  = forall e. Array e -> Int -> e -> Array e
update Array e
ary Int
idx forall a b. (a -> b) -> a -> b
$! e -> e
f e
x
{-# INLINE updateWith' #-}

-- | \(O(1)\) Update the element at the given position in this array,
-- without copying.
unsafeUpdateM :: Array e -> Int -> e -> ST s ()
unsafeUpdateM :: forall e s. Array e -> Int -> e -> ST s ()
unsafeUpdateM Array e
ary Int
idx e
b =
    CHECK_BOUNDS("unsafeUpdateM", length ary, idx)
        do MArray s e
mary <- forall a s. Array a -> ST s (MArray s a)
unsafeThaw Array e
ary
           forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s e
mary Int
idx e
b
           Array e
_ <- forall s a. MArray s a -> ST s (Array a)
unsafeFreeze MArray s e
mary
           forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE unsafeUpdateM #-}

foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f = \ b
z0 Array a
ary0 -> Array a -> Int -> Int -> b -> b
go Array a
ary0 (forall a. Array a -> Int
length Array a
ary0) Int
0 b
z0
  where
    go :: Array a -> Int -> Int -> b -> b
go Array a
ary Int
n Int
i !b
z
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = b
z
        | Bool
otherwise
        = case forall a. Array a -> Int -> (# a #)
index# Array a
ary Int
i of
            (# a
x #) -> Array a -> Int -> Int -> b -> b
go Array a
ary Int
n (Int
iforall a. Num a => a -> a -> a
+Int
1) (b -> a -> b
f b
z a
x)
{-# INLINE foldl' #-}

foldr' :: (a -> b -> b) -> b -> Array a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr' a -> b -> b
f = \ b
z0 Array a
ary0 -> Array a -> Int -> b -> b
go Array a
ary0 (forall a. Array a -> Int
length Array a
ary0 forall a. Num a => a -> a -> a
- Int
1) b
z0
  where
    go :: Array a -> Int -> b -> b
go !Array a
_ary (-1) b
z = b
z
    go !Array a
ary Int
i !b
z
      | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# Array a
ary Int
i
      = Array a -> Int -> b -> b
go Array a
ary (Int
i forall a. Num a => a -> a -> a
- Int
1) (a -> b -> b
f a
x b
z)
{-# INLINE foldr' #-}

foldr :: (a -> b -> b) -> b -> Array a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f = \ b
z0 Array a
ary0 -> Array a -> Int -> Int -> b -> b
go Array a
ary0 (forall a. Array a -> Int
length Array a
ary0) Int
0 b
z0
  where
    go :: Array a -> Int -> Int -> b -> b
go Array a
ary Int
n Int
i b
z
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = b
z
        | Bool
otherwise
        = case forall a. Array a -> Int -> (# a #)
index# Array a
ary Int
i of
            (# a
x #) -> a -> b -> b
f a
x (Array a -> Int -> Int -> b -> b
go Array a
ary Int
n (Int
iforall a. Num a => a -> a -> a
+Int
1) b
z)
{-# INLINE foldr #-}

foldl :: (b -> a -> b) -> b -> Array a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Array a -> b
foldl b -> a -> b
f = \ b
z0 Array a
ary0 -> Array a -> Int -> b -> b
go Array a
ary0 (forall a. Array a -> Int
length Array a
ary0 forall a. Num a => a -> a -> a
- Int
1) b
z0
  where
    go :: Array a -> Int -> b -> b
go Array a
_ary (-1) b
z = b
z
    go Array a
ary Int
i b
z
      | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# Array a
ary Int
i
      = b -> a -> b
f (Array a -> Int -> b -> b
go Array a
ary (Int
i forall a. Num a => a -> a -> a
- Int
1) b
z) a
x
{-# INLINE foldl #-}

-- We go to a bit of trouble here to avoid appending an extra mempty.
-- The below implementation is by Mateusz Kowalczyk, who indicates that
-- benchmarks show it to be faster than one that avoids lifting out
-- lst.
foldMap :: Monoid m => (a -> m) -> Array a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Array a -> m
foldMap a -> m
f = \Array a
ary0 -> case forall a. Array a -> Int
length Array a
ary0 of
  Int
0 -> forall a. Monoid a => a
mempty
  Int
len ->
    let !lst :: Int
lst = Int
len forall a. Num a => a -> a -> a
- Int
1
        go :: Int -> m
go Int
i | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# Array a
ary0 Int
i, let fx :: m
fx = a -> m
f a
x =
          if Int
i forall a. Eq a => a -> a -> Bool
== Int
lst then m
fx else m
fx forall a. Monoid a => a -> a -> a
`mappend` Int -> m
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
    in Int -> m
go Int
0
{-# INLINE foldMap #-}

-- | Verifies that a predicate holds for all elements of an array.
all :: (a -> Bool) -> Array a -> Bool
all :: forall a. (a -> Bool) -> Array a -> Bool
all a -> Bool
p = forall a b. (a -> b -> b) -> b -> Array a -> b
foldr (\a
a Bool
acc -> a -> Bool
p a
a Bool -> Bool -> Bool
&& Bool
acc) Bool
True
{-# INLINE all #-}

undefinedElem :: a
undefinedElem :: forall a. a
undefinedElem = forall a. HasCallStack => String -> a
error String
"Data.Strict.HashMap.Autogen.Internal.Array: Undefined element"
{-# NOINLINE undefinedElem #-}

thaw :: Array e -> Int -> Int -> ST s (MArray s e)
thaw :: forall e s. Array e -> Int -> Int -> ST s (MArray s e)
thaw !Array e
ary !_o :: Int
_o@(I# Int#
o#) _n :: Int
_n@(I# Int#
n#) =
    CHECK_LE("thaw", _o + _n, length ary)
        forall s a. STRep s a -> ST s a
ST forall a b. (a -> b) -> a -> b
$ \ State# s
s -> case forall a d.
SmallArray# a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
thawSmallArray# (forall a. Array a -> SmallArray# a
unArray Array e
ary) Int#
o# Int#
n# State# s
s of
            (# State# s
s2, SmallMutableArray# s e
mary# #) -> (# State# s
s2, forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s e
mary# #)
{-# INLINE thaw #-}

-- | \(O(n)\) Delete an element at the given position in this array,
-- decreasing its size by one.
delete :: Array e -> Int -> Array e
delete :: forall e. Array e -> Int -> Array e
delete Array e
ary Int
idx = forall a. (forall s. ST s a) -> a
runST (forall e s. Array e -> Int -> ST s (Array e)
deleteM Array e
ary Int
idx)
{-# INLINE delete #-}

-- | \(O(n)\) Delete an element at the given position in this array,
-- decreasing its size by one.
deleteM :: Array e -> Int -> ST s (Array e)
deleteM :: forall e s. Array e -> Int -> ST s (Array e)
deleteM Array e
ary Int
idx = do
    CHECK_BOUNDS("deleteM", count, idx)
        do MArray s e
mary <- forall s a. Int -> ST s (MArray s a)
new_ (Int
countforall a. Num a => a -> a -> a
-Int
1)
           forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
copy Array e
ary Int
0 MArray s e
mary Int
0 Int
idx
           forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
copy Array e
ary (Int
idxforall a. Num a => a -> a -> a
+Int
1) MArray s e
mary Int
idx (Int
countforall a. Num a => a -> a -> a
-(Int
idxforall a. Num a => a -> a -> a
+Int
1))
           forall s a. MArray s a -> ST s (Array a)
unsafeFreeze MArray s e
mary
  where !count :: Int
count = forall a. Array a -> Int
length Array e
ary
{-# INLINE deleteM #-}

map :: (a -> b) -> Array a -> Array b
map :: forall a b. (a -> b) -> Array a -> Array b
map a -> b
f = \ Array a
ary ->
    let !n :: Int
n = forall a. Array a -> Int
length Array a
ary
    in forall e. (forall s. ST s (MArray s e)) -> Array e
run forall a b. (a -> b) -> a -> b
$ do
        MArray s b
mary <- forall s a. Int -> ST s (MArray s a)
new_ Int
n
        forall {s}. Array a -> MArray s b -> Int -> Int -> ST s ()
go Array a
ary MArray s b
mary Int
0 Int
n
        forall (m :: * -> *) a. Monad m => a -> m a
return MArray s b
mary
  where
    go :: Array a -> MArray s b -> Int -> Int -> ST s ()
go Array a
ary MArray s b
mary Int
i Int
n
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n    = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
             a
x <- forall a s. Array a -> Int -> ST s a
indexM Array a
ary Int
i
             forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s b
mary Int
i forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
             Array a -> MArray s b -> Int -> Int -> ST s ()
go Array a
ary MArray s b
mary (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINE map #-}

-- | Strict version of 'map'.
map' :: (a -> b) -> Array a -> Array b
map' :: forall a b. (a -> b) -> Array a -> Array b
map' a -> b
f = \ Array a
ary ->
    let !n :: Int
n = forall a. Array a -> Int
length Array a
ary
    in forall e. (forall s. ST s (MArray s e)) -> Array e
run forall a b. (a -> b) -> a -> b
$ do
        MArray s b
mary <- forall s a. Int -> ST s (MArray s a)
new_ Int
n
        forall {s}. Array a -> MArray s b -> Int -> Int -> ST s ()
go Array a
ary MArray s b
mary Int
0 Int
n
        forall (m :: * -> *) a. Monad m => a -> m a
return MArray s b
mary
  where
    go :: Array a -> MArray s b -> Int -> Int -> ST s ()
go Array a
ary MArray s b
mary Int
i Int
n
        | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n    = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
             a
x <- forall a s. Array a -> Int -> ST s a
indexM Array a
ary Int
i
             forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s b
mary Int
i forall a b. (a -> b) -> a -> b
$! a -> b
f a
x
             Array a -> MArray s b -> Int -> Int -> ST s ()
go Array a
ary MArray s b
mary (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
n
{-# INLINE map' #-}

fromList :: Int -> [a] -> Array a
fromList :: forall a. Int -> [a] -> Array a
fromList Int
n [a]
xs0 =
    CHECK_EQ("fromList", n, Prelude.length xs0)
        forall e. (forall s. ST s (MArray s e)) -> Array e
run forall a b. (a -> b) -> a -> b
$ do
            MArray s a
mary <- forall s a. Int -> ST s (MArray s a)
new_ Int
n
            forall {a} {s}. [a] -> MArray s a -> Int -> ST s ()
go [a]
xs0 MArray s a
mary Int
0
            forall (m :: * -> *) a. Monad m => a -> m a
return MArray s a
mary
  where
    go :: [a] -> MArray s a -> Int -> ST s ()
go []     !MArray s a
_   !Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (a
x:[a]
xs) MArray s a
mary Int
i  = do forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s a
mary Int
i a
x
                           [a] -> MArray s a -> Int -> ST s ()
go [a]
xs MArray s a
mary (Int
iforall a. Num a => a -> a -> a
+Int
1)

fromList' :: Int -> [a] -> Array a
fromList' :: forall a. Int -> [a] -> Array a
fromList' Int
n [a]
xs0 =
    CHECK_EQ("fromList'", n, Prelude.length xs0)
        forall e. (forall s. ST s (MArray s e)) -> Array e
run forall a b. (a -> b) -> a -> b
$ do
            MArray s a
mary <- forall s a. Int -> ST s (MArray s a)
new_ Int
n
            forall {a} {s}. [a] -> MArray s a -> Int -> ST s ()
go [a]
xs0 MArray s a
mary Int
0
            forall (m :: * -> *) a. Monad m => a -> m a
return MArray s a
mary
  where
    go :: [a] -> MArray s a -> Int -> ST s ()
go []      !MArray s a
_   !Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (!a
x:[a]
xs) MArray s a
mary Int
i  = do forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s a
mary Int
i a
x
                            [a] -> MArray s a -> Int -> ST s ()
go [a]
xs MArray s a
mary (Int
iforall a. Num a => a -> a -> a
+Int
1)

-- | @since 0.2.17.0
instance TH.Lift a => TH.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
ar = [|| fromList' arlen arlist ||]
#else
  lift ar = [| fromList' arlen arlist |]
#endif
    where
      arlen :: Int
arlen = forall a. Array a -> Int
length Array a
ar
      arlist :: [a]
arlist = forall a. Array a -> [a]
toList Array a
ar

toList :: Array a -> [a]
toList :: forall a. Array a -> [a]
toList = forall a b. (a -> b -> b) -> b -> Array a -> b
foldr (:) []

newtype STA a = STA {forall a.
STA a -> forall s. SmallMutableArray# s a -> ST s (Array a)
_runSTA :: forall s. SmallMutableArray# s a -> ST s (Array a)}

runSTA :: Int -> STA a -> Array a
runSTA :: forall a. Int -> STA a -> Array a
runSTA !Int
n (STA forall s. SmallMutableArray# 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 (MArray s a)
new_ Int
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (MArray SmallMutableArray# s a
ar) -> forall s. SmallMutableArray# s a -> ST s (Array a)
m SmallMutableArray# s a
ar

traverse :: Applicative f => (a -> f b) -> Array a -> f (Array b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverse a -> f b
f = \ !Array a
ary ->
  let
    !len :: Int
len = forall a. Array a -> Int
length 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. SmallMutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary -> forall s a. MArray s a -> ST s (Array a)
unsafeFreeze (forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s b
mary)
      | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# 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. SmallMutableArray# s b -> ST s (Array b)
m) -> forall a.
(forall s. SmallMutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary ->
                  forall s a. MArray s a -> Int -> a -> ST s ()
write (forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s b
mary) Int
i b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. SmallMutableArray# s b -> ST s (Array b)
m SmallMutableArray# 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 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] traverse #-}

-- TODO: Would it be better to just use a lazy traversal
-- and then force the elements of the result? My guess is
-- yes.
traverse' :: Applicative f => (a -> f b) -> Array a -> f (Array b)
traverse' :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
traverse' a -> f b
f = \ !Array a
ary ->
  let
    !len :: Int
len = forall a. Array a -> Int
length 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. SmallMutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary -> forall s a. MArray s a -> ST s (Array a)
unsafeFreeze (forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s b
mary)
      | (# a
x #) <- forall a. Array a -> Int -> (# a #)
index# 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. SmallMutableArray# s b -> ST s (Array b)
m) -> forall a.
(forall s. SmallMutableArray# s a -> ST s (Array a)) -> STA a
STA forall a b. (a -> b) -> a -> b
$ \SmallMutableArray# s b
mary ->
                    forall s a. MArray s a -> Int -> a -> ST s ()
write (forall s a. SmallMutableArray# s a -> MArray s a
MArray SmallMutableArray# s b
mary) Int
i b
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. SmallMutableArray# s b -> ST s (Array b)
m SmallMutableArray# 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 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] traverse' #-}

-- Traversing in ST, we don't need to get fancy; we
-- can just do it directly.
traverseST :: (a -> ST s b) -> Array a -> ST s (Array b)
traverseST :: forall a s b. (a -> ST s b) -> Array a -> ST s (Array b)
traverseST a -> ST s b
f = \ Array a
ary0 ->
  let
    !len :: Int
len = forall a. Array a -> Int
length Array a
ary0
    go :: Int -> MArray s b -> ST s (MArray s b)
go Int
k !MArray s b
mary
      | Int
k forall a. Eq a => a -> a -> Bool
== Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return MArray s b
mary
      | Bool
otherwise = do
          a
x <- forall a s. Array a -> Int -> ST s a
indexM Array a
ary0 Int
k
          b
y <- a -> ST s b
f a
x
          forall s a. MArray s a -> Int -> a -> ST s ()
write MArray s b
mary Int
k b
y
          Int -> MArray s b -> ST s (MArray s b)
go (Int
k forall a. Num a => a -> a -> a
+ Int
1) MArray s b
mary
  in forall s a. Int -> ST s (MArray s a)
new_ Int
len forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> MArray s b -> ST s (MArray s b)
go Int
0 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall s a. MArray s a -> ST s (Array a)
unsafeFreeze)
{-# INLINE traverseST #-}

traverseIO :: (a -> IO b) -> Array a -> IO (Array b)
traverseIO :: forall a b. (a -> IO b) -> Array a -> IO (Array b)
traverseIO a -> IO b
f = \ Array a
ary0 ->
  let
    !len :: Int
len = forall a. Array a -> Int
length Array a
ary0
    go :: Int -> MArray RealWorld b -> IO (MArray RealWorld b)
go Int
k !MArray RealWorld b
mary
      | Int
k forall a. Eq a => a -> a -> Bool
== Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return MArray RealWorld b
mary
      | Bool
otherwise = do
          a
x <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall a s. Array a -> Int -> ST s a
indexM Array a
ary0 Int
k
          b
y <- a -> IO b
f a
x
          forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall s a. MArray s a -> Int -> a -> ST s ()
write MArray RealWorld b
mary Int
k b
y
          Int -> MArray RealWorld b -> IO (MArray RealWorld b)
go (Int
k forall a. Num a => a -> a -> a
+ Int
1) MArray RealWorld b
mary
  in forall a. ST RealWorld a -> IO a
stToIO (forall s a. Int -> ST s (MArray s a)
new_ Int
len) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> MArray RealWorld b -> IO (MArray RealWorld b)
go Int
0 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. ST RealWorld a -> IO a
stToIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. MArray s a -> ST s (Array a)
unsafeFreeze)
{-# INLINE traverseIO #-}


-- Why don't we have similar RULES for traverse'? The efficient
-- way to traverse strictly in IO or ST is to force results as
-- they come in, which leads to different semantics. In particular,
-- we need to ensure that
--
--  traverse' (\x -> print x *> pure undefined) xs
--
-- will actually print all the values and then return undefined.
-- We could add a strict mapMWithIndex, operating in an arbitrary
-- Monad, that supported such rules, but we don't have that right now.
{-# RULES
"traverse/ST" forall f. traverse f = traverseST f
"traverse/IO" forall f. traverse f = traverseIO f
 #-}