{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

{-# OPTIONS_GHC -Wall #-}

-- | Sort primitive arrays with a stable sorting algorithm. All functions
-- in this module are marked as @INLINABLE@, so they will specialize
-- when used in a monomorphic setting.
module Data.Primitive.Sort
  ( -- * Immutable
    sort
  , sortUnique
  , sortTagged
  , sortUniqueTagged
    -- * Mutable
  , sortMutable
  , sortUniqueMutable
  , sortTaggedMutable
  , sortUniqueTaggedMutable
  ) where

import Control.Monad.ST
import Control.Applicative
import GHC.Int (Int(..))
import GHC.Prim
import Data.Primitive.Contiguous (Contiguous,ContiguousU,Mutable,Element)
import qualified Data.Primitive.Contiguous as C

-- | Sort an immutable array. Duplicate elements are preserved.
--
-- >>> sort ([5,6,7,9,5,4,5,7] :: Array Int)
-- fromListN 8 [4,5,5,5,6,7,7,9]
sort :: (Contiguous arr, Element arr a, Ord a)
  => arr a
  -> arr a
{-# INLINE sort #-}
sort :: arr a -> arr a
sort !arr a
src = (forall s. ST s (arr a)) -> arr a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (arr a)) -> arr a)
-> (forall s. ST s (arr a)) -> arr a
forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = arr a -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size arr a
src
  Mutable arr s a
dst <- Int -> ST s (Mutable arr (PrimState (ST s)) a)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new (arr a -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size arr a
src)
  Mutable arr (PrimState (ST s)) a -> Int -> Sliced arr a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy Mutable arr s a
Mutable arr (PrimState (ST s)) a
dst Int
0 (arr a -> Int -> Int -> Sliced arr a
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice arr a
src Int
0 Int
len)
  Mutable arr s a
res <- Mutable arr s a -> ST s (Mutable arr s a)
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> ST s (Mutable arr s a)
sortMutable Mutable arr s a
dst
  Mutable arr (PrimState (ST s)) a -> ST s (arr a)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze Mutable arr s a
Mutable arr (PrimState (ST s)) a
res

-- | Sort a tagged immutable array. Each element from the @keys@ array is
-- paired up with an element from the @values@ array at the matching
-- index. The sort permutes the @values@ array so that a value end up
-- in the same position as its corresponding key. The two argument array
-- should be of the same length, but if one is shorter than the other,
-- the longer one will be truncated so that the lengths match.
--
-- >>> sortTagged ([5,6,7,5,5,7] :: Array Int) ([1,2,3,4,5,6] :: Array Int)
-- (fromListN 6 [5,5,5,6,7,7],fromListN 6 [1,4,5,2,3,6])
--
-- Since the sort is stable, the values corresponding to a key that
-- appears multiple times have their original order preserved.
sortTagged :: forall k v karr varr. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)
  => karr k -- ^ keys
  -> varr v -- ^ values
  -> (karr k,varr v)
{-# INLINE sortTagged #-}
sortTagged :: karr k -> varr v -> (karr k, varr v)
sortTagged !karr k
src !varr v
srcTags = (forall s. ST s (karr k, varr v)) -> (karr k, varr v)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (karr k, varr v)) -> (karr k, varr v))
-> (forall s. ST s (karr k, varr v)) -> (karr k, varr v)
forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (karr k -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size karr k
src) (varr v -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size varr v
srcTags)
  Mutable karr s k
dst <- Int -> ST s (Mutable karr (PrimState (ST s)) k)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  Mutable karr (PrimState (ST s)) k
-> Int -> Sliced karr k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst Int
0 (karr k -> Int -> Int -> Sliced karr k
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice karr k
src Int
0 Int
len)
  Mutable varr s v
dstTags <- Int -> ST s (Mutable varr (PrimState (ST s)) v)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  Mutable varr (PrimState (ST s)) v
-> Int -> Sliced varr v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags Int
0 (varr v -> Int -> Int -> Sliced varr v
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice varr v
srcTags Int
0 Int
len)
  (Mutable karr s k
res,Mutable varr s v
resTags) <- Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
forall (karr :: * -> *) k (varr :: * -> *) v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
sortTaggedMutableN Int
len Mutable karr s k
dst Mutable varr s v
dstTags
  karr k
res' <- Mutable karr (PrimState (ST s)) k -> ST s (karr k)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze Mutable karr s k
Mutable karr (PrimState (ST s)) k
res
  varr v
resTags' <- Mutable varr (PrimState (ST s)) v -> ST s (varr v)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze Mutable varr s v
Mutable varr (PrimState (ST s)) v
resTags
  (karr k, varr v) -> ST s (karr k, varr v)
forall (m :: * -> *) a. Monad m => a -> m a
return (karr k
res',varr v
resTags')

-- | Sort a tagged immutable array. Only a single copy of each
-- duplicate key is preserved, along with the last value from @values@
-- that corresponded to it. The two argument arrays
-- should be of the same length, but if one is shorter than the other,
-- the longer one will be truncated so that the lengths match.
--
-- >>> sortUniqueTagged ([5,6,7,5,5,7] :: Array Int) ([1,2,3,4,5,6] :: Array Int)
-- (fromListN 3 [5,6,7],fromListN 3 [5,2,6])
sortUniqueTagged :: forall k v karr varr. (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)
  => karr k -- ^ keys
  -> varr v -- ^ values
  -> (karr k,varr v)
{-# INLINE sortUniqueTagged #-}
sortUniqueTagged :: karr k -> varr v -> (karr k, varr v)
sortUniqueTagged !karr k
src !varr v
srcTags = (forall s. ST s (karr k, varr v)) -> (karr k, varr v)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (karr k, varr v)) -> (karr k, varr v))
-> (forall s. ST s (karr k, varr v)) -> (karr k, varr v)
forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (karr k -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size karr k
src) (varr v -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size varr v
srcTags)
  Mutable karr s k
dst <- Int -> ST s (Mutable karr (PrimState (ST s)) k)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  Mutable karr (PrimState (ST s)) k
-> Int -> Sliced karr k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst Int
0 (karr k -> Int -> Int -> Sliced karr k
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice karr k
src Int
0 Int
len)
  Mutable varr s v
dstTags <- Int -> ST s (Mutable varr (PrimState (ST s)) v)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  Mutable varr (PrimState (ST s)) v
-> Int -> Sliced varr v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags Int
0 (varr v -> Int -> Int -> Sliced varr v
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice varr v
srcTags Int
0 Int
len)
  (Mutable karr s k
res0,Mutable varr s v
resTags0) <- Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
forall (karr :: * -> *) k (varr :: * -> *) v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
sortTaggedMutableN Int
len Mutable karr s k
dst Mutable varr s v
dstTags
  (Mutable karr s k
res1,Mutable varr s v
resTags1) <- Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
forall (karr :: * -> *) (varr :: * -> *) s k v.
(ContiguousU karr, Element karr k, Eq k, ContiguousU varr,
 Element varr v) =>
Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
uniqueTaggedMutableN Int
len Mutable karr s k
res0 Mutable varr s v
resTags0
  karr k
res' <- Mutable karr (PrimState (ST s)) k -> ST s (karr k)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze Mutable karr s k
Mutable karr (PrimState (ST s)) k
res1
  varr v
resTags' <- Mutable varr (PrimState (ST s)) v -> ST s (varr v)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze Mutable varr s v
Mutable varr (PrimState (ST s)) v
resTags1
  (karr k, varr v) -> ST s (karr k, varr v)
forall (m :: * -> *) a. Monad m => a -> m a
return (karr k
res',varr v
resTags')

-- | Sort the mutable array. This operation preserves duplicate
-- elements. The argument may either be modified in-place, or another
-- array may be allocated and returned. The argument
-- may not be reused after being passed to this function.
sortMutable :: (Contiguous arr, Element arr a, Ord a)
  => Mutable arr s a
  -> ST s (Mutable arr s a)
{-# INLINE sortMutable #-}
sortMutable :: Mutable arr s a -> ST s (Mutable arr s a)
sortMutable !Mutable arr s a
dst = do
  Int
len <- Mutable arr (PrimState (ST s)) a -> ST s Int
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut Mutable arr s a
Mutable arr (PrimState (ST s)) a
dst
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
threshold
    then Mutable arr s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> Int -> Int -> ST s ()
insertionSortRange Mutable arr s a
dst Int
0 Int
len
    else do
      Mutable arr s a
work <- Int -> ST s (Mutable arr (PrimState (ST s)) a)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
      Mutable arr (PrimState (ST s)) a
-> Int -> MutableSliced arr (PrimState (ST s)) a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable arr s a
Mutable arr (PrimState (ST s)) a
work Int
0 (Mutable arr s a -> Int -> Int -> MutableSliced arr s a
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable arr s a
dst Int
0 Int
len)
      Mutable arr s a -> Mutable arr s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> Mutable arr s a -> Int -> Int -> ST s ()
splitMerge Mutable arr s a
dst Mutable arr s a
work Int
0 Int
len
  Mutable arr s a -> ST s (Mutable arr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return Mutable arr s a
dst

-- | Sort an array of a key type @k@, rearranging the values of
-- type @v@ according to the element they correspond to in the
-- key array. The argument arrays may not be reused after they
-- are passed to the function.
sortTaggedMutable :: (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)
  => Mutable karr s k
  -> Mutable varr s v
  -> ST s (Mutable karr s k, Mutable varr s v)
{-# INLINE sortTaggedMutable #-}
sortTaggedMutable :: Mutable karr s k
-> Mutable varr s v -> ST s (Mutable karr s k, Mutable varr s v)
sortTaggedMutable !Mutable karr s k
dst0 !Mutable varr s v
dstTags0 = do
  (!Mutable karr s k
dst,!Mutable varr s v
dstTags,!Int
len) <- Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v, Int)
forall (karr :: * -> *) k (varr :: * -> *) v s.
(ContiguousU karr, Element karr k, Ord k, ContiguousU varr,
 Element varr v) =>
Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v, Int)
alignArrays Mutable karr s k
dst0 Mutable varr s v
dstTags0
  Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
forall (karr :: * -> *) k (varr :: * -> *) v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
sortTaggedMutableN Int
len Mutable karr s k
dst Mutable varr s v
dstTags

alignArrays :: (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)
  => Mutable karr s k
  -> Mutable varr s v
  -> ST s (Mutable karr s k, Mutable varr s v,Int)
{-# INLINE alignArrays #-}
alignArrays :: Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v, Int)
alignArrays Mutable karr s k
dst0 Mutable varr s v
dstTags0 = do
  Int
lenDst <- Mutable karr (PrimState (ST s)) k -> ST s Int
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst0
  Int
lenDstTags <- Mutable varr (PrimState (ST s)) v -> ST s Int
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags0
  -- This cleans up mismatched lengths.
  if Int
lenDst Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenDstTags
    then (Mutable karr s k, Mutable varr s v, Int)
-> ST s (Mutable karr s k, Mutable varr s v, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
dst0,Mutable varr s v
dstTags0,Int
lenDst)
    else if Int
lenDst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lenDstTags
      then do
        Mutable varr s v
dstTags <- Mutable varr (PrimState (ST s)) v
-> Int -> ST s (Mutable varr (PrimState (ST s)) v)
forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
C.resize Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags0 Int
lenDst
        (Mutable karr s k, Mutable varr s v, Int)
-> ST s (Mutable karr s k, Mutable varr s v, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
dst0,Mutable varr s v
dstTags,Int
lenDst)
      else do
        Mutable karr s k
dst <- Mutable karr (PrimState (ST s)) k
-> Int -> ST s (Mutable karr (PrimState (ST s)) k)
forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
C.resize Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst0 Int
lenDstTags
        (Mutable karr s k, Mutable varr s v, Int)
-> ST s (Mutable karr s k, Mutable varr s v, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
dst,Mutable varr s v
dstTags0,Int
lenDstTags)

sortUniqueTaggedMutable :: (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)
  => Mutable karr s k -- ^ keys
  -> Mutable varr s v -- ^ values
  -> ST s (Mutable karr s k, Mutable varr s v)
{-# INLINE sortUniqueTaggedMutable #-}
sortUniqueTaggedMutable :: Mutable karr s k
-> Mutable varr s v -> ST s (Mutable karr s k, Mutable varr s v)
sortUniqueTaggedMutable Mutable karr s k
dst0 Mutable varr s v
dstTags0 = do
  (!Mutable karr s k
dst1,!Mutable varr s v
dstTags1,!Int
len) <- Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v, Int)
forall (karr :: * -> *) k (varr :: * -> *) v s.
(ContiguousU karr, Element karr k, Ord k, ContiguousU varr,
 Element varr v) =>
Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v, Int)
alignArrays Mutable karr s k
dst0 Mutable varr s v
dstTags0
  (!Mutable karr s k
dst2,!Mutable varr s v
dstTags2) <- Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
forall (karr :: * -> *) k (varr :: * -> *) v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
sortTaggedMutableN Int
len Mutable karr s k
dst1 Mutable varr s v
dstTags1
  Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
forall (karr :: * -> *) (varr :: * -> *) s k v.
(ContiguousU karr, Element karr k, Eq k, ContiguousU varr,
 Element varr v) =>
Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
uniqueTaggedMutableN Int
len Mutable karr s k
dst2 Mutable varr s v
dstTags2

sortTaggedMutableN :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)
  => Int
  -> Mutable karr s k
  -> Mutable varr s v
  -> ST s (Mutable karr s k, Mutable varr s v)
{-# INLINE sortTaggedMutableN #-}
sortTaggedMutableN :: Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
sortTaggedMutableN !Int
len !Mutable karr s k
dst !Mutable varr s v
dstTags = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
thresholdTagged
  then do
    Mutable karr s k -> Mutable varr s v -> Int -> Int -> ST s ()
forall (karr :: * -> *) (varr :: * -> *) s k v.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Mutable karr s k -> Mutable varr s v -> Int -> Int -> ST s ()
insertionSortTaggedRange Mutable karr s k
dst Mutable varr s v
dstTags Int
0 Int
len
    (Mutable karr s k, Mutable varr s v)
-> ST s (Mutable karr s k, Mutable varr s v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
dst,Mutable varr s v
dstTags)
  else do
    Mutable karr s k
work <- MutableSliced karr (PrimState (ST s)) k
-> ST s (Mutable karr (PrimState (ST s)) k)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
MutableSliced arr (PrimState m) b
-> m (Mutable arr (PrimState m) b)
C.cloneMut (Mutable karr s k -> Int -> Int -> MutableSliced karr s k
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable karr s k
dst Int
0 Int
len)
    Mutable varr s v
workTags <- MutableSliced varr (PrimState (ST s)) v
-> ST s (Mutable varr (PrimState (ST s)) v)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
MutableSliced arr (PrimState m) b
-> m (Mutable arr (PrimState m) b)
C.cloneMut (Mutable varr s v -> Int -> Int -> MutableSliced varr s v
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable varr s v
dstTags Int
0 Int
len)
    Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> ST s ()
forall (karr :: * -> *) k (varr :: * -> *) v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> ST s ()
splitMergeTagged Mutable karr s k
dst Mutable karr s k
work Mutable varr s v
dstTags Mutable varr s v
workTags Int
0 Int
len
    (Mutable karr s k, Mutable varr s v)
-> ST s (Mutable karr s k, Mutable varr s v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
dst,Mutable varr s v
dstTags)

-- | Sort an immutable array. Only a single copy of each duplicated
-- element is preserved.
--
-- >>> sortUnique ([5,6,7,9,5,4,5,7] :: Array Int)
-- fromListN 5 [4,5,6,7,9]
sortUnique :: (ContiguousU arr, Element arr a, Ord a)
  => arr a -> arr a
{-# INLINE sortUnique #-}
sortUnique :: arr a -> arr a
sortUnique arr a
src = (forall s. ST s (arr a)) -> arr a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (arr a)) -> arr a)
-> (forall s. ST s (arr a)) -> arr a
forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = arr a -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size arr a
src
  Mutable arr s a
dst <- Int -> ST s (Mutable arr (PrimState (ST s)) a)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  Mutable arr (PrimState (ST s)) a -> Int -> Sliced arr a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy Mutable arr s a
Mutable arr (PrimState (ST s)) a
dst Int
0 (arr a -> Int -> Int -> Sliced arr a
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice arr a
src Int
0 Int
len)
  Mutable arr s a
res <- Mutable arr s a -> ST s (Mutable arr s a)
forall (arr :: * -> *) a s.
(ContiguousU arr, Element arr a, Ord a) =>
Mutable arr s a -> ST s (Mutable arr s a)
sortUniqueMutable Mutable arr s a
dst
  Mutable arr (PrimState (ST s)) a -> ST s (arr a)
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze Mutable arr s a
Mutable arr (PrimState (ST s)) a
res

-- | Sort an immutable array. Only a single copy of each duplicated
-- element is preserved. This operation may run in-place, or it may
-- need to allocate a new array, so the argument may not be reused
-- after this function is applied to it. 
sortUniqueMutable :: (ContiguousU arr, Element arr a, Ord a)
  => Mutable arr s a
  -> ST s (Mutable arr s a)
{-# INLINE sortUniqueMutable #-}
sortUniqueMutable :: Mutable arr s a -> ST s (Mutable arr s a)
sortUniqueMutable Mutable arr s a
marr = do
  Mutable arr s a
res <- Mutable arr s a -> ST s (Mutable arr s a)
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> ST s (Mutable arr s a)
sortMutable Mutable arr s a
marr
  Mutable arr s a -> ST s (Mutable arr s a)
forall (arr :: * -> *) s a.
(ContiguousU arr, Element arr a, Eq a) =>
Mutable arr s a -> ST s (Mutable arr s a)
uniqueMutable Mutable arr s a
res

-- | Discards adjacent equal elements from an array. This operation
-- may run in-place, or it may need to allocate a new array, so the
-- argument may not be reused after this function is applied to it.
uniqueMutable :: forall arr s a. (ContiguousU arr, Element arr a, Eq a)
  => Mutable arr s a -> ST s (Mutable arr s a)
{-# INLINE uniqueMutable #-}
uniqueMutable :: Mutable arr s a -> ST s (Mutable arr s a)
uniqueMutable !Mutable arr s a
marr = do
  !Int
len <- Mutable arr (PrimState (ST s)) a -> ST s Int
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut Mutable arr s a
Mutable arr (PrimState (ST s)) a
marr
  if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    then do
      !a
a0 <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
marr Int
0
      let findFirstDuplicate :: a -> Int -> ST s Int
          findFirstDuplicate :: a -> Int -> ST s Int
findFirstDuplicate !a
prev !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
            then do
              a
a <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
marr Int
ix
              if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
prev
                then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix
                else a -> Int -> ST s Int
findFirstDuplicate a
a (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix
      Int
dupIx <- a -> Int -> ST s Int
findFirstDuplicate a
a0 Int
1
      if Int
dupIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
        then Mutable arr s a -> ST s (Mutable arr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return Mutable arr s a
marr
        else do
          let deduplicate :: a -> Int -> Int -> ST s Int
              deduplicate :: a -> Int -> Int -> ST s Int
deduplicate !a
prev !Int
srcIx !Int
dstIx = if Int
srcIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
                then do
                  a
a <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
marr Int
srcIx
                  if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
prev
                    then a -> Int -> Int -> ST s Int
deduplicate a
a (Int
srcIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
dstIx
                    else do
                      Mutable arr (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable arr s a
Mutable arr (PrimState (ST s)) a
marr Int
dstIx a
a
                      a -> Int -> Int -> ST s Int
deduplicate a
a (Int
srcIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
dstIx
          !a
a <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
marr Int
dupIx
          !Int
reducedLen <- a -> Int -> Int -> ST s Int
deduplicate a
a (Int
dupIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
dupIx
          Mutable arr (PrimState (ST s)) a
-> Int -> ST s (Mutable arr (PrimState (ST s)) a)
forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
C.resize Mutable arr s a
Mutable arr (PrimState (ST s)) a
marr Int
reducedLen
    else Mutable arr s a -> ST s (Mutable arr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return Mutable arr s a
marr

uniqueTaggedMutableN :: forall karr varr s k v. (ContiguousU karr, Element karr k, Eq k, ContiguousU varr, Element varr v)
  => Int
  -> Mutable karr s k
  -> Mutable varr s v
  -> ST s (Mutable karr s k, Mutable varr s v)
{-# INLINE uniqueTaggedMutableN #-}
uniqueTaggedMutableN :: Int
-> Mutable karr s k
-> Mutable varr s v
-> ST s (Mutable karr s k, Mutable varr s v)
uniqueTaggedMutableN !Int
len !Mutable karr s k
marr !Mutable varr s v
marrTags = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
  then do
    !k
a0 <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
marr Int
0
    let findFirstDuplicate :: k -> Int -> ST s Int
        findFirstDuplicate :: k -> Int -> ST s Int
findFirstDuplicate !k
prev !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
          then do
            k
a <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
marr Int
ix
            if k
a k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
prev
              then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix
              else k -> Int -> ST s Int
findFirstDuplicate k
a (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix
    Int
dupIx <- k -> Int -> ST s Int
findFirstDuplicate k
a0 Int
1
    if Int
dupIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
      then (Mutable karr s k, Mutable varr s v)
-> ST s (Mutable karr s k, Mutable varr s v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
marr,Mutable varr s v
marrTags)
      else do
        Mutable varr (PrimState (ST s)) v -> Int -> ST s v
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable varr s v
Mutable varr (PrimState (ST s)) v
marrTags Int
dupIx ST s v -> (v -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mutable varr (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable varr s v
Mutable varr (PrimState (ST s)) v
marrTags (Int
dupIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        let deduplicate :: k -> Int -> Int -> ST s Int
            deduplicate :: k -> Int -> Int -> ST s Int
deduplicate !k
prev !Int
srcIx !Int
dstIx = if Int
srcIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
              then do
                k
a <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
marr Int
srcIx
                if k
a k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
prev
                  then do
                    Mutable varr (PrimState (ST s)) v -> Int -> ST s v
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable varr s v
Mutable varr (PrimState (ST s)) v
marrTags Int
srcIx ST s v -> (v -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mutable varr (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable varr s v
Mutable varr (PrimState (ST s)) v
marrTags (Int
dstIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    k -> Int -> Int -> ST s Int
deduplicate k
a (Int
srcIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
dstIx
                  else do
                    Mutable varr (PrimState (ST s)) v -> Int -> ST s v
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable varr s v
Mutable varr (PrimState (ST s)) v
marrTags Int
srcIx ST s v -> (v -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mutable varr (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable varr s v
Mutable varr (PrimState (ST s)) v
marrTags Int
dstIx
                    Mutable karr (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable karr s k
Mutable karr (PrimState (ST s)) k
marr Int
dstIx k
a
                    k -> Int -> Int -> ST s Int
deduplicate k
a (Int
srcIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
dstIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
dstIx
        !k
a <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
marr Int
dupIx
        !Int
reducedLen <- k -> Int -> Int -> ST s Int
deduplicate k
a (Int
dupIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
dupIx
        (Mutable karr s k
 -> Mutable varr s v -> (Mutable karr s k, Mutable varr s v))
-> ST s (Mutable karr s k)
-> ST s (Mutable varr s v)
-> ST s (Mutable karr s k, Mutable varr s v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Mutable karr (PrimState (ST s)) k
-> Int -> ST s (Mutable karr (PrimState (ST s)) k)
forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
C.resize Mutable karr s k
Mutable karr (PrimState (ST s)) k
marr Int
reducedLen) (Mutable varr (PrimState (ST s)) v
-> Int -> ST s (Mutable varr (PrimState (ST s)) v)
forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
C.resize Mutable varr s v
Mutable varr (PrimState (ST s)) v
marrTags Int
reducedLen)
  else (Mutable karr s k, Mutable varr s v)
-> ST s (Mutable karr s k, Mutable varr s v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
marr,Mutable varr s v
marrTags)

splitMerge :: forall arr s a. (Contiguous arr, Element arr a, Ord a)
  => Mutable arr s a -- source and destination
  -> Mutable arr s a -- work array
  -> Int -- start
  -> Int -- end
  -> ST s ()
{-# INLINE splitMerge #-}
splitMerge :: Mutable arr s a -> Mutable arr s a -> Int -> Int -> ST s ()
splitMerge !Mutable arr s a
arr !Mutable arr s a
work !Int
start !Int
end = if Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
  then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else if Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
threshold
    then do
      let !mid :: Int
mid = Int -> Int -> Int
unsafeQuot (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start) Int
2
      Mutable arr s a -> Mutable arr s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> Mutable arr s a -> Int -> Int -> ST s ()
splitMerge Mutable arr s a
work Mutable arr s a
arr Int
start Int
mid
      Mutable arr s a -> Mutable arr s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> Mutable arr s a -> Int -> Int -> ST s ()
splitMerge Mutable arr s a
work Mutable arr s a
arr Int
mid Int
end
      Mutable arr s a
-> Mutable arr s a -> Int -> Int -> Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a
-> Mutable arr s a -> Int -> Int -> Int -> Int -> Int -> ST s ()
mergeNonContiguous Mutable arr s a
work Mutable arr s a
arr Int
start Int
mid Int
mid Int
end Int
start
    else Mutable arr s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> Int -> Int -> ST s ()
insertionSortRange Mutable arr s a
arr Int
start Int
end

splitMergeTagged :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)
  => Mutable karr s k -- source and destination
  -> Mutable karr s k -- work array
  -> Mutable varr s v
  -> Mutable varr s v
  -> Int -- start
  -> Int -- end
  -> ST s ()
{-# INLINE splitMergeTagged #-}
splitMergeTagged :: Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> ST s ()
splitMergeTagged !Mutable karr s k
arr !Mutable karr s k
work !Mutable varr s v
arrTags !Mutable varr s v
workTags !Int
start !Int
end = if Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
  then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else if Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
thresholdTagged
    then do
      let !mid :: Int
mid = Int -> Int -> Int
unsafeQuot (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start) Int
2
      Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> ST s ()
forall (karr :: * -> *) k (varr :: * -> *) v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> ST s ()
splitMergeTagged Mutable karr s k
work Mutable karr s k
arr Mutable varr s v
workTags Mutable varr s v
arrTags Int
start Int
mid
      Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> ST s ()
forall (karr :: * -> *) k (varr :: * -> *) v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> ST s ()
splitMergeTagged Mutable karr s k
work Mutable karr s k
arr Mutable varr s v
workTags Mutable varr s v
arrTags Int
mid Int
end
      Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
forall (karr :: * -> *) (varr :: * -> *) k v s.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
mergeNonContiguousTagged Mutable karr s k
work Mutable karr s k
arr Mutable varr s v
workTags Mutable varr s v
arrTags Int
start Int
mid Int
mid Int
end Int
start
    else Mutable karr s k -> Mutable varr s v -> Int -> Int -> ST s ()
forall (karr :: * -> *) (varr :: * -> *) s k v.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Mutable karr s k -> Mutable varr s v -> Int -> Int -> ST s ()
insertionSortTaggedRange Mutable karr s k
arr Mutable varr s v
arrTags Int
start Int
end

unsafeQuot :: Int -> Int -> Int
unsafeQuot :: Int -> Int -> Int
unsafeQuot (I# Int#
a) (I# Int#
b) = Int# -> Int
I# (Int# -> Int# -> Int#
quotInt# Int#
a Int#
b)
{-# INLINE unsafeQuot #-}

-- stepA assumes that we previously incremented ixA.
-- Consequently, we do not need to check that ixB
-- is still in bounds. As a precondition, both
-- indices are guarenteed to start in bounds.
mergeNonContiguous :: forall arr s a. (Contiguous arr, Element arr a, Ord a)
  => Mutable arr s a -- source
  -> Mutable arr s a -- dest
  -> Int -- start A
  -> Int -- end A
  -> Int -- start B
  -> Int -- end B
  -> Int -- start destination
  -> ST s ()
{-# INLINE mergeNonContiguous #-}
mergeNonContiguous :: Mutable arr s a
-> Mutable arr s a -> Int -> Int -> Int -> Int -> Int -> ST s ()
mergeNonContiguous !Mutable arr s a
src !Mutable arr s a
dst !Int
startA !Int
endA !Int
startB !Int
endB !Int
startDst =
  if Int
startB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endB
    then Int -> Int -> Int -> ST s ()
stepA Int
startA Int
startB Int
startDst
    else if Int
startA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endA
      then Int -> Int -> Int -> ST s ()
stepB Int
startA Int
startB Int
startDst
      else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
  continue :: Int -> Int -> Int -> ST s ()
  continue :: Int -> Int -> Int -> ST s ()
continue Int
ixA Int
ixB Int
ixDst = do
    !a
a <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
src Int
ixA
    !a
b <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
src Int
ixB
    if (a
a :: a) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b
      then do
        Mutable arr (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable arr s a
Mutable arr (PrimState (ST s)) a
dst Int
ixDst a
a
        Int -> Int -> Int -> ST s ()
stepA (Int
ixA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ixB (Int
ixDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      else do
        Mutable arr (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable arr s a
Mutable arr (PrimState (ST s)) a
dst Int
ixDst a
b
        Int -> Int -> Int -> ST s ()
stepB Int
ixA (Int
ixB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
ixDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  stepB :: Int -> Int -> Int -> ST s ()
  stepB :: Int -> Int -> Int -> ST s ()
stepB !Int
ixA !Int
ixB !Int
ixDst = if Int
ixB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endB
    then Int -> Int -> Int -> ST s ()
continue Int
ixA Int
ixB Int
ixDst
    else Int -> Int -> ST s ()
finishA Int
ixA Int
ixDst
  stepA :: Int -> Int -> Int -> ST s ()
  stepA :: Int -> Int -> Int -> ST s ()
stepA !Int
ixA !Int
ixB !Int
ixDst = if Int
ixA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endA
    then Int -> Int -> Int -> ST s ()
continue Int
ixA Int
ixB Int
ixDst
    else Int -> Int -> ST s ()
finishB Int
ixB Int
ixDst
  finishB :: Int -> Int -> ST s ()
  finishB :: Int -> Int -> ST s ()
finishB !Int
ixB !Int
ixDst = Mutable arr (PrimState (ST s)) a
-> Int -> MutableSliced arr (PrimState (ST s)) a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable arr s a
Mutable arr (PrimState (ST s)) a
dst Int
ixDst (Mutable arr s a -> Int -> Int -> MutableSliced arr s a
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable arr s a
src Int
ixB (Int
endB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixB))
  finishA :: Int -> Int -> ST s ()
  finishA :: Int -> Int -> ST s ()
finishA !Int
ixA !Int
ixDst = Mutable arr (PrimState (ST s)) a
-> Int -> MutableSliced arr (PrimState (ST s)) a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable arr s a
Mutable arr (PrimState (ST s)) a
dst Int
ixDst (Mutable arr s a -> Int -> Int -> MutableSliced arr s a
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable arr s a
src Int
ixA (Int
endA Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixA))

mergeNonContiguousTagged :: forall karr varr k v s. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)
  => Mutable karr s k -- source
  -> Mutable karr s k -- dest
  -> Mutable varr s v -- source tags
  -> Mutable varr s v -- dest tags
  -> Int -- start A
  -> Int -- end A
  -> Int -- start B
  -> Int -- end B
  -> Int -- start destination
  -> ST s ()
{-# INLINE mergeNonContiguousTagged #-}
mergeNonContiguousTagged :: Mutable karr s k
-> Mutable karr s k
-> Mutable varr s v
-> Mutable varr s v
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
mergeNonContiguousTagged !Mutable karr s k
src !Mutable karr s k
dst !Mutable varr s v
srcTags !Mutable varr s v
dstTags !Int
startA !Int
endA !Int
startB !Int
endB !Int
startDst =
  if Int
startB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endB
    then Int -> Int -> Int -> ST s ()
stepA Int
startA Int
startB Int
startDst
    else if Int
startA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endA
      then Int -> Int -> Int -> ST s ()
stepB Int
startA Int
startB Int
startDst
      else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
  continue :: Int -> Int -> Int -> ST s ()
  continue :: Int -> Int -> Int -> ST s ()
continue Int
ixA Int
ixB Int
ixDst = do
    !k
a <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
src Int
ixA
    !k
b <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
src Int
ixB
    if k
a k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
b
      then do
        Mutable karr (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst Int
ixDst k
a
        (Mutable varr (PrimState (ST s)) v -> Int -> ST s v
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable varr s v
Mutable varr (PrimState (ST s)) v
srcTags Int
ixA :: ST s v) ST s v -> (v -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mutable varr (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags Int
ixDst
        Int -> Int -> Int -> ST s ()
stepA (Int
ixA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
ixB (Int
ixDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      else do
        Mutable karr (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst Int
ixDst k
b
        (Mutable varr (PrimState (ST s)) v -> Int -> ST s v
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable varr s v
Mutable varr (PrimState (ST s)) v
srcTags Int
ixB :: ST s v) ST s v -> (v -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Mutable varr (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags Int
ixDst
        Int -> Int -> Int -> ST s ()
stepB Int
ixA (Int
ixB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
ixDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  stepB :: Int -> Int -> Int -> ST s ()
  stepB :: Int -> Int -> Int -> ST s ()
stepB !Int
ixA !Int
ixB !Int
ixDst = if Int
ixB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endB
    then Int -> Int -> Int -> ST s ()
continue Int
ixA Int
ixB Int
ixDst
    else Int -> Int -> ST s ()
finishA Int
ixA Int
ixDst
  stepA :: Int -> Int -> Int -> ST s ()
  stepA :: Int -> Int -> Int -> ST s ()
stepA !Int
ixA !Int
ixB !Int
ixDst = if Int
ixA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endA
    then Int -> Int -> Int -> ST s ()
continue Int
ixA Int
ixB Int
ixDst
    else Int -> Int -> ST s ()
finishB Int
ixB Int
ixDst
  finishB :: Int -> Int -> ST s ()
  finishB :: Int -> Int -> ST s ()
finishB !Int
ixB !Int
ixDst = do
    Mutable karr (PrimState (ST s)) k
-> Int -> MutableSliced karr (PrimState (ST s)) k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst Int
ixDst (Mutable karr s k -> Int -> Int -> MutableSliced karr s k
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable karr s k
src Int
ixB (Int
endB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixB))
    Mutable varr (PrimState (ST s)) v
-> Int -> MutableSliced varr (PrimState (ST s)) v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags Int
ixDst (Mutable varr s v -> Int -> Int -> MutableSliced varr s v
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable varr s v
srcTags Int
ixB (Int
endB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixB))
  finishA :: Int -> Int -> ST s ()
  finishA :: Int -> Int -> ST s ()
finishA !Int
ixA !Int
ixDst = do
    Mutable karr (PrimState (ST s)) k
-> Int -> MutableSliced karr (PrimState (ST s)) k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable karr s k
Mutable karr (PrimState (ST s)) k
dst Int
ixDst (Mutable karr s k -> Int -> Int -> MutableSliced karr s k
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable karr s k
src Int
ixA (Int
endA Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixA))
    Mutable varr (PrimState (ST s)) v
-> Int -> MutableSliced varr (PrimState (ST s)) v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable varr s v
Mutable varr (PrimState (ST s)) v
dstTags Int
ixDst (Mutable varr s v -> Int -> Int -> MutableSliced varr s v
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable varr s v
srcTags Int
ixA (Int
endA Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixA))

threshold :: Int
threshold :: Int
threshold = Int
16

thresholdTagged :: Int
thresholdTagged :: Int
thresholdTagged = Int
16

insertionSortRange :: forall arr s a. (Contiguous arr, Element arr a, Ord a)
  => Mutable arr s a
  -> Int -- start
  -> Int -- end
  -> ST s ()
{-# INLINE insertionSortRange #-}
insertionSortRange :: Mutable arr s a -> Int -> Int -> ST s ()
insertionSortRange !Mutable arr s a
arr !Int
start !Int
end = Int -> ST s ()
go Int
start
  where
  go :: Int -> ST s ()
  go :: Int -> ST s ()
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end
    then do
      !a
a <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
arr Int
ix
      Mutable arr s a -> a -> Int -> Int -> ST s ()
forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> a -> Int -> Int -> ST s ()
insertElement Mutable arr s a
arr (a
a :: a) Int
start Int
ix
      Int -> ST s ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    
insertElement :: forall arr s a. (Contiguous arr, Element arr a, Ord a)
  => Mutable arr s a
  -> a
  -> Int
  -> Int
  -> ST s ()
{-# INLINE insertElement #-}
insertElement :: Mutable arr s a -> a -> Int -> Int -> ST s ()
insertElement !Mutable arr s a
arr !a
a !Int
start !Int
end = Int -> ST s ()
go Int
end
  where
  go :: Int -> ST s ()
  go :: Int -> ST s ()
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
start
    then do
      !a
b <- Mutable arr (PrimState (ST s)) a -> Int -> ST s a
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable arr s a
Mutable arr (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      if a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
a
        then do
          Mutable arr (PrimState (ST s)) a
-> Int -> MutableSliced arr (PrimState (ST s)) a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable arr s a
Mutable arr (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Mutable arr s a -> Int -> Int -> MutableSliced arr s a
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable arr s a
arr Int
ix (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix))
          Mutable arr (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable arr s a
Mutable arr (PrimState (ST s)) a
arr Int
ix a
a
        else Int -> ST s ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    else do
      Mutable arr (PrimState (ST s)) a
-> Int -> MutableSliced arr (PrimState (ST s)) a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable arr s a
Mutable arr (PrimState (ST s)) a
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Mutable arr s a -> Int -> Int -> MutableSliced arr s a
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable arr s a
arr Int
ix (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix))
      Mutable arr (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable arr s a
Mutable arr (PrimState (ST s)) a
arr Int
ix a
a

insertionSortTaggedRange :: forall karr varr s k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)
  => Mutable karr s k
  -> Mutable varr s v
  -> Int -- start
  -> Int -- end
  -> ST s ()
{-# INLINE insertionSortTaggedRange #-}
insertionSortTaggedRange :: Mutable karr s k -> Mutable varr s v -> Int -> Int -> ST s ()
insertionSortTaggedRange !Mutable karr s k
karr !Mutable varr s v
varr !Int
start !Int
end = Int -> ST s ()
go Int
start
  where
  go :: Int -> ST s ()
  go :: Int -> ST s ()
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end
    then do
      !k
a <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
karr Int
ix
      !v
v <- Mutable varr (PrimState (ST s)) v -> Int -> ST s v
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable varr s v
Mutable varr (PrimState (ST s)) v
varr Int
ix
      Mutable karr s k
-> Mutable varr s v -> k -> v -> Int -> Int -> ST s ()
forall (karr :: * -> *) (varr :: * -> *) s k v.
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
Mutable karr s k
-> Mutable varr s v -> k -> v -> Int -> Int -> ST s ()
insertElementTagged Mutable karr s k
karr Mutable varr s v
varr k
a v
v Int
start Int
ix
      Int -> ST s ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    else () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    
insertElementTagged :: forall karr varr s k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)
  => Mutable karr s k
  -> Mutable varr s v
  -> k
  -> v
  -> Int
  -> Int
  -> ST s ()
{-# INLINE insertElementTagged #-}
insertElementTagged :: Mutable karr s k
-> Mutable varr s v -> k -> v -> Int -> Int -> ST s ()
insertElementTagged !Mutable karr s k
karr !Mutable varr s v
varr !k
a !v
v !Int
start !Int
end = Int -> ST s ()
go Int
end
  where
  go :: Int -> ST s ()
  go :: Int -> ST s ()
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
start
    then do
      !k
b <- Mutable karr (PrimState (ST s)) k -> Int -> ST s k
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read Mutable karr s k
Mutable karr (PrimState (ST s)) k
karr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      if k
b k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
a
        then do
          Mutable karr (PrimState (ST s)) k
-> Int -> MutableSliced karr (PrimState (ST s)) k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable karr s k
Mutable karr (PrimState (ST s)) k
karr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Mutable karr s k -> Int -> Int -> MutableSliced karr s k
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable karr s k
karr Int
ix (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix))
          Mutable karr (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable karr s k
Mutable karr (PrimState (ST s)) k
karr Int
ix k
a
          Mutable varr (PrimState (ST s)) v
-> Int -> MutableSliced varr (PrimState (ST s)) v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable varr s v
Mutable varr (PrimState (ST s)) v
varr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Mutable varr s v -> Int -> Int -> MutableSliced varr s v
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable varr s v
varr Int
ix (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix))
          Mutable varr (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable varr s v
Mutable varr (PrimState (ST s)) v
varr Int
ix v
v
        else Int -> ST s ()
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    else do
      Mutable karr (PrimState (ST s)) k
-> Int -> MutableSliced karr (PrimState (ST s)) k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable karr s k
Mutable karr (PrimState (ST s)) k
karr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Mutable karr s k -> Int -> Int -> MutableSliced karr s k
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable karr s k
karr Int
ix (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix))
      Mutable karr (PrimState (ST s)) k -> Int -> k -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable karr s k
Mutable karr (PrimState (ST s)) k
karr Int
ix k
a
      Mutable varr (PrimState (ST s)) v
-> Int -> MutableSliced varr (PrimState (ST s)) v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> MutableSliced arr (PrimState m) b -> m ()
C.copyMut Mutable varr s v
Mutable varr (PrimState (ST s)) v
varr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Mutable varr s v -> Int -> Int -> MutableSliced varr s v
forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut Mutable varr s v
varr Int
ix (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix))
      Mutable varr (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
C.write Mutable varr s v
Mutable varr (PrimState (ST s)) v
varr Int
ix v
v

-- $setup
--
-- These are to make doctest work correctly.
--
-- >>> :set -XOverloadedLists
-- >>> import Data.Primitive.Array (Array)
--