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

-- | 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.Word
import Data.Int
import Data.Primitive.Contiguous (Contiguous,ContiguousU,Mutable,Element)
import Data.Primitive (Prim,PrimArray,MutablePrimArray)
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 :: (Prim a, Ord a)
  => C.PrimArray a
  -> C.PrimArray a
{-# inlineable sort #-}
{-# specialize sort :: C.PrimArray Double -> C.PrimArray Double #-}
{-# specialize sort :: C.PrimArray Int -> C.PrimArray Int #-}
{-# specialize sort :: C.PrimArray Int64 -> C.PrimArray Int64 #-}
{-# specialize sort :: C.PrimArray Int32 -> C.PrimArray Int32 #-}
{-# specialize sort :: C.PrimArray Int16 -> C.PrimArray Int16 #-}
{-# specialize sort :: C.PrimArray Int8 -> C.PrimArray Int8 #-}
{-# specialize sort :: C.PrimArray Word -> C.PrimArray Word #-}
{-# specialize sort :: C.PrimArray Word64 -> C.PrimArray Word64 #-}
{-# specialize sort :: C.PrimArray Word32 -> C.PrimArray Word32 #-}
{-# specialize sort :: C.PrimArray Word16 -> C.PrimArray Word16 #-}
{-# specialize sort :: C.PrimArray Word8 -> C.PrimArray Word8 #-}
sort :: forall a. (Prim a, Ord a) => PrimArray a -> PrimArray a
sort !PrimArray a
src = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size PrimArray a
src
  MutablePrimArray s a
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size PrimArray a
src)
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy MutablePrimArray s a
dst Int
0 (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice PrimArray a
src Int
0 Int
len)
  MutablePrimArray s a
res <- forall a s.
(Prim a, Ord a) =>
MutablePrimArray s a -> ST s (MutablePrimArray s a)
sortMutable MutablePrimArray s a
dst
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze MutablePrimArray 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)
{-# inlineable sortTagged #-}
sortTagged :: forall k v (karr :: * -> *) (varr :: * -> *).
(Contiguous karr, Element karr k, Ord k, Contiguous varr,
 Element varr v) =>
karr k -> varr v -> (karr k, varr v)
sortTagged !karr k
src !varr v
srcTags = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = forall a. Ord a => a -> a -> a
min (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size karr k
src) (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size varr v
srcTags)
  Mutable karr s k
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  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
dst Int
0 (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 <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  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
dstTags Int
0 (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) <- 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' <- 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
res
  varr v
resTags' <- 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
resTags
  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)
{-# inlineable sortUniqueTagged #-}
sortUniqueTagged :: forall k v (karr :: * -> *) (varr :: * -> *).
(ContiguousU karr, Element karr k, Ord k, ContiguousU varr,
 Element varr v) =>
karr k -> varr v -> (karr k, varr v)
sortUniqueTagged !karr k
src !varr v
srcTags = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = forall a. Ord a => a -> a -> a
min (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size karr k
src) (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size varr v
srcTags)
  Mutable karr s k
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  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
dst Int
0 (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 <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  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
dstTags Int
0 (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) <- 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) <- 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' <- 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
res1
  varr v
resTags' <- 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
resTags1
  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 :: (Prim a, Ord a)
  => MutablePrimArray s a
  -> ST s (MutablePrimArray s a)
{-# inlineable sortMutable #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Double -> ST s (C.MutablePrimArray s Double) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int -> ST s (C.MutablePrimArray s Int) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int64 -> ST s (C.MutablePrimArray s Int64) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int32 -> ST s (C.MutablePrimArray s Int32) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int16 -> ST s (C.MutablePrimArray s Int16) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int8 -> ST s (C.MutablePrimArray s Int8) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word -> ST s (C.MutablePrimArray s Word) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word64 -> ST s (C.MutablePrimArray s Word64) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word32 -> ST s (C.MutablePrimArray s Word32) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word16 -> ST s (C.MutablePrimArray s Word16) #-}
{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word8 -> ST s (C.MutablePrimArray s Word8) #-}
sortMutable :: forall a s.
(Prim a, Ord a) =>
MutablePrimArray s a -> ST s (MutablePrimArray s a)
sortMutable !MutablePrimArray s a
dst = do
  Int
len <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut MutablePrimArray s a
dst
  if Int
len forall a. Ord a => a -> a -> Bool
< Int
threshold
    then forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a -> Int -> Int -> ST s ()
insertionSortRange MutablePrimArray s a
dst Int
0 Int
len
    else do
      MutablePrimArray s a
work <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
      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 MutablePrimArray s a
work Int
0 (forall (arr :: * -> *) a s.
(Contiguous arr, Element arr a) =>
Mutable arr s a -> Int -> Int -> MutableSliced arr s a
C.sliceMut MutablePrimArray s a
dst Int
0 Int
len)
      forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a
-> MutablePrimArray s a -> Int -> Int -> ST s ()
splitMerge MutablePrimArray s a
dst MutablePrimArray s a
work Int
0 Int
len
  forall (m :: * -> *) a. Monad m => a -> m a
return MutablePrimArray 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)
{-# inlineable sortTaggedMutable #-}
sortTaggedMutable :: 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)
sortTaggedMutable !Mutable karr s k
dst0 !Mutable varr s v
dstTags0 = do
  (!Mutable karr s k
dst,!Mutable varr s v
dstTags,!Int
len) <- 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
  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)
{-# inlineable alignArrays #-}
alignArrays :: 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 = do
  Int
lenDst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut Mutable karr s k
dst0
  Int
lenDstTags <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut Mutable varr s v
dstTags0
  -- This cleans up mismatched lengths.
  if Int
lenDst forall a. Eq a => a -> a -> Bool
== Int
lenDstTags
    then 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 forall a. Ord a => a -> a -> Bool
< Int
lenDstTags
      then do
        Mutable varr s v
dstTags <- 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
dstTags0 Int
lenDst
        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 <- 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
dst0 Int
lenDstTags
        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)
{-# inlineable sortUniqueTaggedMutable #-}
sortUniqueTaggedMutable :: 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)
sortUniqueTaggedMutable Mutable karr s k
dst0 Mutable varr s v
dstTags0 = do
  (!Mutable karr s k
dst1,!Mutable varr s v
dstTags1,!Int
len) <- 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) <- 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
  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)
{-# inlineable sortTaggedMutableN #-}
sortTaggedMutableN :: 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 = if Int
len forall a. Ord a => a -> a -> Bool
< Int
thresholdTagged
  then do
    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
    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 <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
MutableSliced arr (PrimState m) b
-> m (Mutable arr (PrimState m) b)
C.cloneMut (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 <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
MutableSliced arr (PrimState m) b
-> m (Mutable arr (PrimState m) b)
C.cloneMut (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)
    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
    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 :: (Prim a, Ord a) => PrimArray a -> PrimArray a
{-# inlineable sortUnique #-}
{-# specialize sortUnique :: C.PrimArray Double -> C.PrimArray Double #-}
{-# specialize sortUnique :: C.PrimArray Int -> C.PrimArray Int #-}
{-# specialize sortUnique :: C.PrimArray Int64 -> C.PrimArray Int64 #-}
{-# specialize sortUnique :: C.PrimArray Int32 -> C.PrimArray Int32 #-}
{-# specialize sortUnique :: C.PrimArray Int16 -> C.PrimArray Int16 #-}
{-# specialize sortUnique :: C.PrimArray Int8 -> C.PrimArray Int8 #-}
{-# specialize sortUnique :: C.PrimArray Word -> C.PrimArray Word #-}
{-# specialize sortUnique :: C.PrimArray Word64 -> C.PrimArray Word64 #-}
{-# specialize sortUnique :: C.PrimArray Word32 -> C.PrimArray Word32 #-}
{-# specialize sortUnique :: C.PrimArray Word16 -> C.PrimArray Word16 #-}
{-# specialize sortUnique :: C.PrimArray Word8 -> C.PrimArray Word8 #-}
sortUnique :: forall a. (Prim a, Ord a) => PrimArray a -> PrimArray a
sortUnique PrimArray a
src = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let len :: Int
len = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
C.size PrimArray a
src
  MutablePrimArray s a
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
C.new Int
len
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
C.copy MutablePrimArray s a
dst Int
0 (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
C.slice PrimArray a
src Int
0 Int
len)
  MutablePrimArray s a
res <- forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a -> ST s (MutablePrimArray s a)
sortUniqueMutable MutablePrimArray s a
dst
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
C.unsafeFreeze MutablePrimArray 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 :: forall s a. (Prim a, Ord a)
  => MutablePrimArray s a
  -> ST s (MutablePrimArray s a)
{-# inlineable sortUniqueMutable #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Double -> ST s (C.MutablePrimArray s Double) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int -> ST s (C.MutablePrimArray s Int) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int64 -> ST s (C.MutablePrimArray s Int64) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int32 -> ST s (C.MutablePrimArray s Int32) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int16 -> ST s (C.MutablePrimArray s Int16) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int8 -> ST s (C.MutablePrimArray s Int8) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word -> ST s (C.MutablePrimArray s Word) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word64 -> ST s (C.MutablePrimArray s Word64) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word32 -> ST s (C.MutablePrimArray s Word32) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word16 -> ST s (C.MutablePrimArray s Word16) #-}
{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word8 -> ST s (C.MutablePrimArray s Word8) #-}
sortUniqueMutable :: forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a -> ST s (MutablePrimArray s a)
sortUniqueMutable MutablePrimArray s a
marr = do
  MutablePrimArray s a
res <- forall a s.
(Prim a, Ord a) =>
MutablePrimArray s a -> ST s (MutablePrimArray s a)
sortMutable MutablePrimArray s a
marr
  forall (arr :: * -> *) s a.
(ContiguousU arr, Element arr a, Eq a) =>
Mutable arr s a -> ST s (Mutable arr s a)
uniqueMutable MutablePrimArray 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)
{-# inlineable uniqueMutable #-}
uniqueMutable :: 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
marr = do
  !Int
len <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
C.sizeMut Mutable arr s a
marr
  if Int
len forall a. Ord a => a -> a -> Bool
> Int
1
    then do
      !a
a0 <- 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
marr Int
0
      let findFirstDuplicate :: a -> Int -> ST s Int
          findFirstDuplicate :: a -> Int -> ST s Int
findFirstDuplicate !a
prev !Int
ix = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
len
            then do
              a
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
marr Int
ix
              if a
a forall a. Eq a => a -> a -> Bool
== a
prev
                then forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix
                else a -> Int -> ST s Int
findFirstDuplicate a
a (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
            else 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 forall a. Eq a => a -> a -> Bool
== Int
len
        then 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 forall a. Ord a => a -> a -> Bool
< Int
len
                then do
                  a
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
marr Int
srcIx
                  if a
a forall a. Eq a => a -> a -> Bool
== a
prev
                    then a -> Int -> Int -> ST s Int
deduplicate a
a (Int
srcIx forall a. Num a => a -> a -> a
+ Int
1) Int
dstIx
                    else do
                      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
marr Int
dstIx a
a
                      a -> Int -> Int -> ST s Int
deduplicate a
a (Int
srcIx forall a. Num a => a -> a -> a
+ Int
1) (Int
dstIx forall a. Num a => a -> a -> a
+ Int
1)
                else forall (m :: * -> *) a. Monad m => a -> m a
return Int
dstIx
          !a
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
marr Int
dupIx
          !Int
reducedLen <- a -> Int -> Int -> ST s Int
deduplicate a
a (Int
dupIx forall a. Num a => a -> a -> a
+ Int
1) Int
dupIx
          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
marr Int
reducedLen
    else 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)
{-# inlineable uniqueTaggedMutableN #-}
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)
uniqueTaggedMutableN !Int
len !Mutable karr s k
marr !Mutable varr s v
marrTags = if Int
len forall a. Ord a => a -> a -> Bool
> Int
1
  then do
    !k
a0 <- 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
marr Int
0
    let findFirstDuplicate :: k -> Int -> ST s Int
        findFirstDuplicate :: k -> Int -> ST s Int
findFirstDuplicate !k
prev !Int
ix = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
len
          then do
            k
a <- 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
marr Int
ix
            if k
a forall a. Eq a => a -> a -> Bool
== k
prev
              then forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix
              else k -> Int -> ST s Int
findFirstDuplicate k
a (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
          else 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 forall a. Eq a => a -> a -> Bool
== Int
len
      then forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
marr,Mutable varr s v
marrTags)
      else do
        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
marrTags Int
dupIx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
marrTags (Int
dupIx 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 forall a. Ord a => a -> a -> Bool
< Int
len
              then do
                k
a <- 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
marr Int
srcIx
                if k
a forall a. Eq a => a -> a -> Bool
== k
prev
                  then do
                    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
marrTags Int
srcIx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
marrTags (Int
dstIx forall a. Num a => a -> a -> a
- Int
1)
                    k -> Int -> Int -> ST s Int
deduplicate k
a (Int
srcIx forall a. Num a => a -> a -> a
+ Int
1) Int
dstIx
                  else do
                    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
marrTags Int
srcIx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
marrTags Int
dstIx
                    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
marr Int
dstIx k
a
                    k -> Int -> Int -> ST s Int
deduplicate k
a (Int
srcIx forall a. Num a => a -> a -> a
+ Int
1) (Int
dstIx forall a. Num a => a -> a -> a
+ Int
1)
              else forall (m :: * -> *) a. Monad m => a -> m a
return Int
dstIx
        !k
a <- 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
marr Int
dupIx
        !Int
reducedLen <- k -> Int -> Int -> ST s Int
deduplicate k
a (Int
dupIx forall a. Num a => a -> a -> a
+ Int
1) Int
dupIx
        forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (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
marr Int
reducedLen) (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
marrTags Int
reducedLen)
  else forall (m :: * -> *) a. Monad m => a -> m a
return (Mutable karr s k
marr,Mutable varr s v
marrTags)

splitMerge :: forall s a. (Prim a, Ord a)
  => MutablePrimArray s a -- source and destination
  -> MutablePrimArray s a -- work array
  -> Int -- start
  -> Int -- end
  -> ST s ()
{-# inlineable splitMerge #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Double -> C.MutablePrimArray s Double -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int -> C.MutablePrimArray s Int -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int64 -> C.MutablePrimArray s Int64 -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int32 -> C.MutablePrimArray s Int32 -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int16 -> C.MutablePrimArray s Int16 -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int8 -> C.MutablePrimArray s Int8 -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word -> C.MutablePrimArray s Word -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word64 -> C.MutablePrimArray s Word64 -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word32 -> C.MutablePrimArray s Word32 -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word16 -> C.MutablePrimArray s Word16 -> Int -> Int -> ST s () #-}
{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word8 -> C.MutablePrimArray s Word8 -> Int -> Int -> ST s () #-}
splitMerge :: forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a
-> MutablePrimArray s a -> Int -> Int -> ST s ()
splitMerge !MutablePrimArray s a
arr !MutablePrimArray s a
work !Int
start !Int
end = if Int
end forall a. Num a => a -> a -> a
- Int
start forall a. Ord a => a -> a -> Bool
< Int
2
  then forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else if Int
end forall a. Num a => a -> a -> a
- Int
start forall a. Ord a => a -> a -> Bool
> Int
threshold
    then do
      let !mid :: Int
mid = Int -> Int -> Int
unsafeQuot (Int
end forall a. Num a => a -> a -> a
+ Int
start) Int
2
      forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a
-> MutablePrimArray s a -> Int -> Int -> ST s ()
splitMerge MutablePrimArray s a
work MutablePrimArray s a
arr Int
start Int
mid
      forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a
-> MutablePrimArray s a -> Int -> Int -> ST s ()
splitMerge MutablePrimArray s a
work MutablePrimArray s a
arr Int
mid Int
end
      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 MutablePrimArray s a
work MutablePrimArray s a
arr Int
start Int
mid Int
mid Int
end Int
start
    else forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a -> Int -> Int -> ST s ()
insertionSortRange MutablePrimArray 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 ()
{-# inlineable splitMergeTagged #-}
splitMergeTagged :: 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
arr !Mutable karr s k
work !Mutable varr s v
arrTags !Mutable varr s v
workTags !Int
start !Int
end = if Int
end forall a. Num a => a -> a -> a
- Int
start forall a. Ord a => a -> a -> Bool
< Int
2
  then forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else if Int
end forall a. Num a => a -> a -> a
- Int
start forall a. Ord a => a -> a -> Bool
> Int
thresholdTagged
    then do
      let !mid :: Int
mid = Int -> Int -> Int
unsafeQuot (Int
end forall a. Num a => a -> a -> a
+ Int
start) Int
2
      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
      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
      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 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 ()
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Double -> C.MutablePrimArray s Double -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int -> C.MutablePrimArray s Int -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int64 -> C.MutablePrimArray s Int64 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int32 -> C.MutablePrimArray s Int32 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int16 -> C.MutablePrimArray s Int16 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int8 -> C.MutablePrimArray s Int8 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word -> C.MutablePrimArray s Word -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word64 -> C.MutablePrimArray s Word64 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word32 -> C.MutablePrimArray s Word32 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word16 -> C.MutablePrimArray s Word16 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word8 -> C.MutablePrimArray s Word8 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}
mergeNonContiguous :: 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
src !Mutable arr s a
dst !Int
startA !Int
endA !Int
startB !Int
endB !Int
startDst =
  if Int
startB 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 forall a. Ord a => a -> a -> Bool
< Int
endA
      then Int -> Int -> Int -> ST s ()
stepB Int
startA Int
startB Int
startDst
      else 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 <- 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
src Int
ixA
    !a
b <- 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
src Int
ixB
    if (a
a :: a) forall a. Ord a => a -> a -> Bool
<= a
b
      then do
        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
dst Int
ixDst a
a
        Int -> Int -> Int -> ST s ()
stepA (Int
ixA forall a. Num a => a -> a -> a
+ Int
1) Int
ixB (Int
ixDst forall a. Num a => a -> a -> a
+ Int
1)
      else do
        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
dst Int
ixDst a
b
        Int -> Int -> Int -> ST s ()
stepB Int
ixA (Int
ixB forall a. Num a => a -> a -> a
+ Int
1) (Int
ixDst 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 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 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 = 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
dst Int
ixDst (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 forall a. Num a => a -> a -> a
- Int
ixB))
  finishA :: Int -> Int -> ST s ()
  finishA :: Int -> Int -> ST s ()
finishA !Int
ixA !Int
ixDst = 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
dst Int
ixDst (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 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 ()
{-# inlineable mergeNonContiguousTagged #-}
mergeNonContiguousTagged :: 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
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 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 forall a. Ord a => a -> a -> Bool
< Int
endA
      then Int -> Int -> Int -> ST s ()
stepB Int
startA Int
startB Int
startDst
      else 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 <- 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
src Int
ixA
    !k
b <- 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
src Int
ixB
    if k
a forall a. Ord a => a -> a -> Bool
<= k
b
      then do
        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
dst Int
ixDst k
a
        (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
srcTags Int
ixA :: ST s v) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
dstTags Int
ixDst
        Int -> Int -> Int -> ST s ()
stepA (Int
ixA forall a. Num a => a -> a -> a
+ Int
1) Int
ixB (Int
ixDst forall a. Num a => a -> a -> a
+ Int
1)
      else do
        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
dst Int
ixDst k
b
        (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
srcTags Int
ixB :: ST s v) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
dstTags Int
ixDst
        Int -> Int -> Int -> ST s ()
stepB Int
ixA (Int
ixB forall a. Num a => a -> a -> a
+ Int
1) (Int
ixDst 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 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 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
    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
dst Int
ixDst (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 forall a. Num a => a -> a -> a
- Int
ixB))
    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
dstTags Int
ixDst (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 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
    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
dst Int
ixDst (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 forall a. Num a => a -> a -> a
- Int
ixA))
    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
dstTags Int
ixDst (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 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 s a. (Prim a, Ord a)
  => MutablePrimArray s a
  -> Int -- start
  -> Int -- end
  -> ST s ()
{-# inlineable insertionSortRange #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Double -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int64 -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int32 -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int16 -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int8 -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word64 -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word32 -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word16 -> Int -> Int -> ST s () #-}
{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word8 -> Int -> Int -> ST s () #-}
insertionSortRange :: forall s a.
(Prim a, Ord a) =>
MutablePrimArray s a -> Int -> Int -> ST s ()
insertionSortRange !MutablePrimArray 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 forall a. Ord a => a -> a -> Bool
< Int
end
    then do
      !a
a <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
C.read MutablePrimArray s a
arr Int
ix
      forall (arr :: * -> *) s a.
(Contiguous arr, Element arr a, Ord a) =>
Mutable arr s a -> a -> Int -> Int -> ST s ()
insertElement MutablePrimArray s a
arr (a
a :: a) Int
start Int
ix
      Int -> ST s ()
go (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
    else 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 ()
{-# specialize insertElement :: forall s. C.MutablePrimArray s Double -> Double -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Int -> Int -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Int64 -> Int64 -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Int32 -> Int32 -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Int16 -> Int16 -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Int8 -> Int8 -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Word -> Word -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Word64 -> Word64 -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Word32 -> Word32 -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Word16 -> Word16 -> Int -> Int -> ST s () #-}
{-# specialize insertElement :: forall s. C.MutablePrimArray s Word8 -> Word8 -> Int -> Int -> ST s () #-}
insertElement :: 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 !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 forall a. Ord a => a -> a -> Bool
> Int
start
    then do
      !a
b <- 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
arr (Int
ix forall a. Num a => a -> a -> a
- Int
1)
      if a
b forall a. Ord a => a -> a -> Bool
<= a
a
        then do
          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
arr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (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 forall a. Num a => a -> a -> a
- Int
ix))
          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
arr Int
ix a
a
        else Int -> ST s ()
go (Int
ix forall a. Num a => a -> a -> a
- Int
1)
    else do
      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
arr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (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 forall a. Num a => a -> a -> a
- Int
ix))
      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
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 ()
{-# inlineable insertionSortTaggedRange #-}
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 -> 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 forall a. Ord a => a -> a -> Bool
< Int
end
    then do
      !k
a <- 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
karr Int
ix
      !v
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
varr Int
ix
      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 forall a. Num a => a -> a -> a
+ Int
1)
    else 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 ()
{-# inlineable insertElementTagged #-}
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 ()
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 forall a. Ord a => a -> a -> Bool
> Int
start
    then do
      !k
b <- 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
karr (Int
ix forall a. Num a => a -> a -> a
- Int
1)
      if k
b forall a. Ord a => a -> a -> Bool
<= k
a
        then do
          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
karr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (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 forall a. Num a => a -> a -> a
- Int
ix))
          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
karr Int
ix k
a
          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
varr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (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 forall a. Num a => a -> a -> a
- Int
ix))
          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
varr Int
ix v
v
        else Int -> ST s ()
go (Int
ix forall a. Num a => a -> a -> a
- Int
1)
    else do
      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
karr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (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 forall a. Num a => a -> a -> a
- Int
ix))
      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
karr Int
ix k
a
      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
varr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) (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 forall a. Num a => a -> a -> a
- Int
ix))
      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
varr Int
ix v
v

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