module Z.Data.Vector.Sort (
mergeSort
, mergeSortBy
, mergeTileSize
, insertSort
, insertSortBy
, Down(..)
, radixSort
, Radix(..)
, RadixDown(..)
, mergeDupAdjacent
, mergeDupAdjacentLeft
, mergeDupAdjacentRight
, mergeDupAdjacentBy
) where
import Control.Monad
import Control.Monad.ST
import Data.Bits
import Data.Int
import Data.Ord (Down (..))
import Data.Word
import Prelude hiding (splitAt)
import Z.Data.Array
import Z.Data.Array.Unaligned
import Z.Data.Vector.Base
import Z.Data.Vector.Extra
mergeSort :: forall v a. (Vec v a, Ord a) => v a -> v a
{-# INLINABLE mergeSort #-}
mergeSort :: v a -> v a
mergeSort = (a -> a -> Ordering) -> v a -> v a
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
mergeSortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
mergeSortBy :: forall v a. Vec v a => (a -> a -> Ordering) -> v a -> v a
{-# INLINE mergeSortBy #-}
mergeSortBy :: (a -> a -> Ordering) -> v a -> v a
mergeSortBy a -> a -> Ordering
cmp vec :: v a
vec@(Vec IArray v a
_ Int
_ Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mergeTileSize = (a -> a -> Ordering) -> v a -> v a
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
insertSortBy a -> a -> Ordering
cmp v a
vec
| Bool
otherwise = (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do
MArr (IArray v) s a
w1 <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
l
MArr (IArray v) s a
w2 <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
l
v a -> Int -> MArr (IArray v) s a -> ST s ()
forall s. v a -> Int -> MArr (IArray v) s a -> ST s ()
firstPass v a
vec Int
0 MArr (IArray v) s a
w1
IArray v a
w <- MArr (IArray v) s a
-> MArr (IArray v) s a -> Int -> ST s (IArray v a)
forall s.
MArr (IArray v) s a
-> MArr (IArray v) s a -> Int -> ST s (IArray v a)
mergePass MArr (IArray v) s a
w1 MArr (IArray v) s a
w2 Int
mergeTileSize
v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
w Int
0 Int
l)
where
firstPass :: forall s. v a -> Int -> MArr (IArray v) s a -> ST s ()
{-# INLINABLE firstPass #-}
firstPass :: v a -> Int -> MArr (IArray v) s a -> ST s ()
firstPass !v a
v !Int
i !MArr (IArray v) s a
marr
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
let (v a
v',v a
rest) = Int -> v a -> (v a, v a)
forall (v :: * -> *) a. Vec v a => Int -> v a -> (v a, v a)
splitAt Int
mergeTileSize v a
v
(a -> a -> Ordering)
-> v a -> Int -> MArr (IArray v) s a -> ST s ()
forall (v :: * -> *) a s.
Vec v a =>
(a -> a -> Ordering)
-> v a -> Int -> MArr (IArray v) s a -> ST s ()
insertSortToMArr a -> a -> Ordering
cmp v a
v' Int
i MArr (IArray v) s a
marr
v a -> Int -> MArr (IArray v) s a -> ST s ()
forall s. v a -> Int -> MArr (IArray v) s a -> ST s ()
firstPass v a
rest (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
mergeTileSize) MArr (IArray v) s a
marr
mergePass :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> ST s (IArray v a)
{-# INLINABLE mergePass #-}
mergePass :: MArr (IArray v) s a
-> MArr (IArray v) s a -> Int -> ST s (IArray v a)
mergePass !MArr (IArray v) s a
w1 !MArr (IArray v) s a
w2 !Int
blockSiz
| Int
blockSiz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
w1
| Bool
otherwise = do
MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> ST s ()
forall s.
MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> ST s ()
mergeLoop MArr (IArray v) s a
w1 MArr (IArray v) s a
w2 Int
blockSiz Int
0
MArr (IArray v) s a
-> MArr (IArray v) s a -> Int -> ST s (IArray v a)
forall s.
MArr (IArray v) s a
-> MArr (IArray v) s a -> Int -> ST s (IArray v a)
mergePass MArr (IArray v) s a
w2 MArr (IArray v) s a
w1 (Int
blockSizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
mergeLoop :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> ST s ()
{-# INLINABLE mergeLoop #-}
mergeLoop :: MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> ST s ()
mergeLoop !MArr (IArray v) s a
src !MArr (IArray v) s a
target !Int
blockSiz !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
blockSiz =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
then () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else MArr (IArray v) s a
-> Int -> MArr (IArray v) s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
copyMutableArr MArr (IArray v) s a
target Int
i MArr (IArray v) s a
src Int
i (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)
| Bool
otherwise = do
let !mergeEnd :: Int
mergeEnd = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
blockSizInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
blockSiz) Int
l
MArr (IArray v) s a
-> MArr (IArray v) s a
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
forall s.
MArr (IArray v) s a
-> MArr (IArray v) s a
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
mergeBlock MArr (IArray v) s a
src MArr (IArray v) s a
target (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
blockSiz) Int
mergeEnd Int
i (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
blockSiz) Int
i
MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> ST s ()
forall s.
MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> ST s ()
mergeLoop MArr (IArray v) s a
src MArr (IArray v) s a
target Int
blockSiz Int
mergeEnd
mergeBlock :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> Int -> Int -> Int -> ST s ()
{-# INLINABLE mergeBlock #-}
mergeBlock :: MArr (IArray v) s a
-> MArr (IArray v) s a
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
mergeBlock !MArr (IArray v) s a
src !MArr (IArray v) s a
target !Int
leftEnd !Int
rightEnd !Int
i !Int
j !Int
k = do
a
lv <- MArr (IArray v) s a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MArr (IArray v) s a
src Int
i
a
rv <- MArr (IArray v) s a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MArr (IArray v) s a
src Int
j
case a
rv a -> a -> Ordering
`cmp` a
lv of
Ordering
LT -> do
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
target Int
k a
rv
let !j' :: Int
j' = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
!k' :: Int
k' = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
if Int
j' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rightEnd
then MArr (IArray v) s a
-> Int -> MArr (IArray v) s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
copyMutableArr MArr (IArray v) s a
target Int
k' MArr (IArray v) s a
src Int
i (Int
leftEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
else MArr (IArray v) s a
-> MArr (IArray v) s a
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
forall s.
MArr (IArray v) s a
-> MArr (IArray v) s a
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
mergeBlock MArr (IArray v) s a
src MArr (IArray v) s a
target Int
leftEnd Int
rightEnd Int
i Int
j' Int
k'
Ordering
_ -> do
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
target Int
k a
lv
let !i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
!k' :: Int
k' = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
if Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
leftEnd
then MArr (IArray v) s a
-> Int -> MArr (IArray v) s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
copyMutableArr MArr (IArray v) s a
target Int
k' MArr (IArray v) s a
src Int
j (Int
rightEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j)
else MArr (IArray v) s a
-> MArr (IArray v) s a
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
forall s.
MArr (IArray v) s a
-> MArr (IArray v) s a
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s ()
mergeBlock MArr (IArray v) s a
src MArr (IArray v) s a
target Int
leftEnd Int
rightEnd Int
i' Int
j Int
k'
mergeTileSize :: Int
{-# INLINE mergeTileSize #-}
mergeTileSize :: Int
mergeTileSize = Int
8
insertSort :: (Vec v a, Ord a) => v a -> v a
{-# INLINE insertSort #-}
insertSort :: v a -> v a
insertSort = (a -> a -> Ordering) -> v a -> v a
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
insertSortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
insertSortBy :: Vec v a => (a -> a -> Ordering) -> v a -> v a
{-# INLINE insertSortBy #-}
insertSortBy :: (a -> a -> Ordering) -> v a -> v a
insertSortBy a -> a -> Ordering
cmp v :: v a
v@(Vec IArray v a
_ Int
_ Int
l) | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = v a
v
| Bool
otherwise = Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
l ((a -> a -> Ordering)
-> v a -> Int -> MArr (IArray v) s a -> ST s ()
forall (v :: * -> *) a s.
Vec v a =>
(a -> a -> Ordering)
-> v a -> Int -> MArr (IArray v) s a -> ST s ()
insertSortToMArr a -> a -> Ordering
cmp v a
v Int
0)
insertSortToMArr :: Vec v a
=> (a -> a -> Ordering)
-> v a
-> Int
-> MArr (IArray v) s a
-> ST s ()
{-# INLINE insertSortToMArr #-}
insertSortToMArr :: (a -> a -> Ordering)
-> v a -> Int -> MArr (IArray v) s a -> ST s ()
insertSortToMArr a -> a -> Ordering
cmp (Vec IArray v a
arr Int
s Int
l) Int
moff MArr (IArray v) s a
marr = Int -> ST s ()
go Int
s
where
!end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
!doff :: Int
doff = Int
moffInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s
go :: Int -> ST s ()
go !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
(# a
x #) -> do a -> Int -> ST s ()
insert a
x (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
doff)
Int -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
insert :: a -> Int -> ST s ()
insert !a
temp !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
moff = do
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
moff a
temp
| Bool
otherwise = do
a
x <- MArr (IArray v) s a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MArr (IArray v) s a
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
case a
temp a -> a -> Ordering
`cmp` a
x of
Ordering
LT -> do
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
i a
x
a -> Int -> ST s ()
insert a
temp (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
Ordering
_ -> MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
i a
temp
class Radix a where
bucketSize :: a -> Int
passes :: a -> Int
radixLSB :: a -> Int
radix :: Int -> a -> Int
radixMSB :: a -> Int
instance Radix Int8 where
{-# INLINE bucketSize #-};
bucketSize :: Int8 -> Int
bucketSize Int8
_ = Int
256
{-# INLINE passes #-}
passes :: Int8 -> Int
passes Int8
_ = Int
1
{-# INLINE radixLSB #-}
radixLSB :: Int8 -> Int
radixLSB Int8
a = Int
255 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
128
{-# INLINE radix #-}
radix :: Int -> Int8 -> Int
radix Int
_ Int8
a = Int
255 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
128
{-# INLINE radixMSB #-}
radixMSB :: Int8 -> Int
radixMSB Int8
a = Int
255 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
128
#define MULTI_BYTES_INT_RADIX(T) \
{-# INLINE bucketSize #-}; \
bucketSize _ = 256; \
{-# INLINE passes #-}; \
passes _ = sizeOf (undefined :: T); \
{-# INLINE radixLSB #-}; \
radixLSB a = fromIntegral (255 .&. a); \
{-# INLINE radix #-}; \
radix i a = fromIntegral (a `unsafeShiftR` (i `unsafeShiftL` 3)) .&. 255; \
{-# INLINE radixMSB #-}; \
radixMSB a = fromIntegral ((a `xor` minBound) `unsafeShiftR` ((passes a-1) `unsafeShiftL` 3)) .&. 255
instance Radix Int where MULTI_BYTES_INT_RADIX(Int)
instance Radix Int16 where MULTI_BYTES_INT_RADIX(Int16)
instance Radix Int32 where MULTI_BYTES_INT_RADIX(Int32)
instance Radix Int64 where MULTI_BYTES_INT_RADIX(Int64)
instance Radix Word8 where
{-# INLINE bucketSize #-};
bucketSize :: Word8 -> Int
bucketSize Word8
_ = Int
256
{-# INLINE passes #-}
passes :: Word8 -> Int
passes Word8
_ = Int
1
{-# INLINE radixLSB #-}
radixLSB :: Word8 -> Int
radixLSB = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE radix #-}
radix :: Int -> Word8 -> Int
radix Int
_ = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE radixMSB #-}
radixMSB :: Word8 -> Int
radixMSB = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
#define MULTI_BYTES_WORD_RADIX(T) \
{-# INLINE bucketSize #-}; \
bucketSize _ = 256; \
{-# INLINE passes #-}; \
passes _ = sizeOf (undefined :: T); \
{-# INLINE radixLSB #-}; \
radixLSB a = fromIntegral (255 .&. a); \
{-# INLINE radix #-}; \
radix i a = fromIntegral (a `unsafeShiftR` (i `unsafeShiftL` 3)) .&. 255; \
{-# INLINE radixMSB #-}; \
radixMSB a = fromIntegral (a `unsafeShiftR` ((passes a-1) `unsafeShiftL` 3)) .&. 255
instance Radix Word where MULTI_BYTES_INT_RADIX(Word)
instance Radix Word16 where MULTI_BYTES_INT_RADIX(Word16)
instance Radix Word32 where MULTI_BYTES_INT_RADIX(Word32)
instance Radix Word64 where MULTI_BYTES_INT_RADIX(Word64)
newtype RadixDown a = RadixDown a deriving (Int -> RadixDown a -> ShowS
[RadixDown a] -> ShowS
RadixDown a -> String
(Int -> RadixDown a -> ShowS)
-> (RadixDown a -> String)
-> ([RadixDown a] -> ShowS)
-> Show (RadixDown a)
forall a. Show a => Int -> RadixDown a -> ShowS
forall a. Show a => [RadixDown a] -> ShowS
forall a. Show a => RadixDown a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RadixDown a] -> ShowS
$cshowList :: forall a. Show a => [RadixDown a] -> ShowS
show :: RadixDown a -> String
$cshow :: forall a. Show a => RadixDown a -> String
showsPrec :: Int -> RadixDown a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RadixDown a -> ShowS
Show, RadixDown a -> RadixDown a -> Bool
(RadixDown a -> RadixDown a -> Bool)
-> (RadixDown a -> RadixDown a -> Bool) -> Eq (RadixDown a)
forall a. Eq a => RadixDown a -> RadixDown a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RadixDown a -> RadixDown a -> Bool
$c/= :: forall a. Eq a => RadixDown a -> RadixDown a -> Bool
== :: RadixDown a -> RadixDown a -> Bool
$c== :: forall a. Eq a => RadixDown a -> RadixDown a -> Bool
Eq)
deriving newtype (Addr# -> Int# -> RadixDown a
Addr# -> Int# -> Int# -> RadixDown a -> State# s -> State# s
Addr# -> Int# -> State# s -> (# State# s, RadixDown a #)
Addr# -> Int# -> RadixDown a -> State# s -> State# s
ByteArray# -> Int# -> RadixDown a
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
MutableByteArray# s
-> Int# -> Int# -> RadixDown a -> State# s -> State# s
RadixDown a -> Int#
(RadixDown a -> Int#)
-> (RadixDown a -> Int#)
-> (ByteArray# -> Int# -> RadixDown a)
-> (forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #))
-> (forall s.
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s)
-> (forall s.
MutableByteArray# s
-> Int# -> Int# -> RadixDown a -> State# s -> State# s)
-> (Addr# -> Int# -> RadixDown a)
-> (forall s.
Addr# -> Int# -> State# s -> (# State# s, RadixDown a #))
-> (forall s. Addr# -> Int# -> RadixDown a -> State# s -> State# s)
-> (forall s.
Addr# -> Int# -> Int# -> RadixDown a -> State# s -> State# s)
-> Prim (RadixDown a)
forall s.
Addr# -> Int# -> Int# -> RadixDown a -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, RadixDown a #)
forall s. Addr# -> Int# -> RadixDown a -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> RadixDown a -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
forall s.
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
forall a. Prim a => Addr# -> Int# -> RadixDown a
forall a. Prim a => ByteArray# -> Int# -> RadixDown a
forall a. Prim a => RadixDown a -> Int#
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> RadixDown a -> State# s -> State# s
forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, RadixDown a #)
forall a s.
Prim a =>
Addr# -> Int# -> RadixDown a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> Int# -> RadixDown a -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: Addr# -> Int# -> Int# -> RadixDown a -> State# s -> State# s
$csetOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> Int# -> RadixDown a -> State# s -> State# s
writeOffAddr# :: Addr# -> Int# -> RadixDown a -> State# s -> State# s
$cwriteOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> RadixDown a -> State# s -> State# s
readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, RadixDown a #)
$creadOffAddr# :: forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, RadixDown a #)
indexOffAddr# :: Addr# -> Int# -> RadixDown a
$cindexOffAddr# :: forall a. Prim a => Addr# -> Int# -> RadixDown a
setByteArray# :: MutableByteArray# s
-> Int# -> Int# -> RadixDown a -> State# s -> State# s
$csetByteArray# :: forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> Int# -> RadixDown a -> State# s -> State# s
writeByteArray# :: MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
$cwriteByteArray# :: forall a s.
Prim a =>
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
readByteArray# :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
$creadByteArray# :: forall a s.
Prim a =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
indexByteArray# :: ByteArray# -> Int# -> RadixDown a
$cindexByteArray# :: forall a. Prim a => ByteArray# -> Int# -> RadixDown a
alignment# :: RadixDown a -> Int#
$calignment# :: forall a. Prim a => RadixDown a -> Int#
sizeOf# :: RadixDown a -> Int#
$csizeOf# :: forall a. Prim a => RadixDown a -> Int#
Prim, UnalignedSize (RadixDown a)
ByteArray# -> Int# -> RadixDown a
ByteArray# -> Int -> RadixDown a
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
MutableByteArray# RealWorld -> Int -> IO (RadixDown a)
MutableByteArray# RealWorld -> Int -> RadixDown a -> IO ()
UnalignedSize (RadixDown a)
-> (ByteArray# -> Int# -> RadixDown a)
-> (forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #))
-> (forall s.
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s)
-> (MutableByteArray# RealWorld -> Int -> IO (RadixDown a))
-> (MutableByteArray# RealWorld -> Int -> RadixDown a -> IO ())
-> (ByteArray# -> Int -> RadixDown a)
-> Unaligned (RadixDown a)
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
forall s.
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
forall a. Unaligned a => UnalignedSize (RadixDown a)
forall a. Unaligned a => ByteArray# -> Int# -> RadixDown a
forall a. Unaligned a => ByteArray# -> Int -> RadixDown a
forall a.
Unaligned a =>
MutableByteArray# RealWorld -> Int -> IO (RadixDown a)
forall a.
Unaligned a =>
MutableByteArray# RealWorld -> Int -> RadixDown a -> IO ()
forall a s.
Unaligned a =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
forall a s.
Unaligned a =>
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
forall a.
UnalignedSize a
-> (ByteArray# -> Int# -> a)
-> (forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (MutableByteArray# RealWorld -> Int -> IO a)
-> (MutableByteArray# RealWorld -> Int -> a -> IO ())
-> (ByteArray# -> Int -> a)
-> Unaligned a
indexBA :: ByteArray# -> Int -> RadixDown a
$cindexBA :: forall a. Unaligned a => ByteArray# -> Int -> RadixDown a
pokeMBA :: MutableByteArray# RealWorld -> Int -> RadixDown a -> IO ()
$cpokeMBA :: forall a.
Unaligned a =>
MutableByteArray# RealWorld -> Int -> RadixDown a -> IO ()
peekMBA :: MutableByteArray# RealWorld -> Int -> IO (RadixDown a)
$cpeekMBA :: forall a.
Unaligned a =>
MutableByteArray# RealWorld -> Int -> IO (RadixDown a)
writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
$cwriteWord8ArrayAs# :: forall a s.
Unaligned a =>
MutableByteArray# s -> Int# -> RadixDown a -> State# s -> State# s
readWord8ArrayAs# :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
$creadWord8ArrayAs# :: forall a s.
Unaligned a =>
MutableByteArray# s
-> Int# -> State# s -> (# State# s, RadixDown a #)
indexWord8ArrayAs# :: ByteArray# -> Int# -> RadixDown a
$cindexWord8ArrayAs# :: forall a. Unaligned a => ByteArray# -> Int# -> RadixDown a
unalignedSize :: UnalignedSize (RadixDown a)
$cunalignedSize :: forall a. Unaligned a => UnalignedSize (RadixDown a)
Unaligned)
instance Radix a => Radix (RadixDown a) where
{-# INLINE bucketSize #-}
bucketSize :: RadixDown a -> Int
bucketSize (RadixDown a
a) = a -> Int
forall a. Radix a => a -> Int
bucketSize a
a
{-# INLINE passes #-}
passes :: RadixDown a -> Int
passes (RadixDown a
a) = a -> Int
forall a. Radix a => a -> Int
passes a
a
{-# INLINE radixLSB #-}
radixLSB :: RadixDown a -> Int
radixLSB (RadixDown a
a) = a -> Int
forall a. Radix a => a -> Int
bucketSize a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Radix a => a -> Int
radixLSB a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
{-# INLINE radix #-}
radix :: Int -> RadixDown a -> Int
radix Int
i (RadixDown a
a) = a -> Int
forall a. Radix a => a -> Int
bucketSize a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> a -> Int
forall a. Radix a => Int -> a -> Int
radix Int
i a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
{-# INLINE radixMSB #-}
radixMSB :: RadixDown a -> Int
radixMSB (RadixDown a
a) = a -> Int
forall a. Radix a => a -> Int
bucketSize a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Radix a => a -> Int
radixMSB a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
radixSort :: forall v a. (Vec v a, Radix a) => v a -> v a
{-# INLINABLE radixSort #-}
radixSort :: v a -> v a
radixSort v :: v a
v@(Vec IArray v a
arr Int
s Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = v a
v
| Bool
otherwise = (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do
MutablePrimArray s Int
bucket <- Int -> Int -> ST s (MArr PrimArray s Int)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> a -> m (MArr arr s a)
newArrWith Int
buktSiz Int
0 :: ST s (MutablePrimArray s Int)
MArr (IArray v) s a
w1 <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
l :: ST s (MArr (IArray v) s a)
IArray v a -> MutablePrimArray s Int -> Int -> ST s ()
forall s. IArray v a -> MutablePrimArray s Int -> Int -> ST s ()
firstCountPass IArray v a
arr MutablePrimArray s Int
bucket Int
s
MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
accumBucket MutablePrimArray s Int
bucket Int
buktSiz Int
0 Int
0
IArray v a
-> Int -> MutablePrimArray s Int -> MArr (IArray v) s a -> ST s ()
forall s.
IArray v a
-> Int -> MutablePrimArray s Int -> MArr (IArray v) s a -> ST s ()
firstMovePass IArray v a
arr Int
s MutablePrimArray s Int
bucket MArr (IArray v) s a
w1
IArray v a
w <- if Int
passSiz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
w1
else do
MArr (IArray v) s a
w2 <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
l :: ST s (MArr (IArray v) s a)
MArr (IArray v) s a
-> MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> Int
-> ST s (IArray v a)
forall s.
MArr (IArray v) s a
-> MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> Int
-> ST s (IArray v a)
radixLoop MArr (IArray v) s a
w1 MArr (IArray v) s a
w2 MutablePrimArray s Int
bucket Int
buktSiz Int
1
v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
w Int
0 Int
l)
where
passSiz :: Int
passSiz = a -> Int
forall a. Radix a => a -> Int
passes (a
forall a. HasCallStack => a
undefined :: a)
buktSiz :: Int
buktSiz = a -> Int
forall a. Radix a => a -> Int
bucketSize (a
forall a. HasCallStack => a
undefined :: a)
!end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
{-# INLINABLE firstCountPass #-}
firstCountPass :: forall s. IArray v a -> MutablePrimArray s Int -> Int -> ST s ()
firstCountPass :: IArray v a -> MutablePrimArray s Int -> Int -> ST s ()
firstCountPass !IArray v a
arr' !MutablePrimArray s Int
bucket !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr' Int
i of
(# a
x #) -> do
let !r :: Int
r = a -> Int
forall a. Radix a => a -> Int
radixLSB a
x
Int
c <- MArr PrimArray s Int -> Int -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r
MArr PrimArray s Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
IArray v a -> MutablePrimArray s Int -> Int -> ST s ()
forall s. IArray v a -> MutablePrimArray s Int -> Int -> ST s ()
firstCountPass IArray v a
arr' MutablePrimArray s Int
bucket (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINABLE accumBucket #-}
accumBucket :: forall s. MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
accumBucket :: MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
accumBucket !MutablePrimArray s Int
bucket !Int
bsiz !Int
i !Int
acc
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bsiz = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Int
c <- MArr PrimArray s Int -> Int -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
i
MArr PrimArray s Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
i Int
acc
MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
accumBucket MutablePrimArray s Int
bucket Int
bsiz (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
accInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c)
{-# INLINABLE firstMovePass #-}
firstMovePass :: forall s. IArray v a -> Int -> MutablePrimArray s Int -> MArr (IArray v) s a -> ST s ()
firstMovePass :: IArray v a
-> Int -> MutablePrimArray s Int -> MArr (IArray v) s a -> ST s ()
firstMovePass !IArray v a
arr' !Int
i !MutablePrimArray s Int
bucket !MArr (IArray v) s a
w
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr' Int
i of
(# a
x #) -> do
let !r :: Int
r = a -> Int
forall a. Radix a => a -> Int
radixLSB a
x
Int
c <- MArr PrimArray s Int -> Int -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r
MArr PrimArray s Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
w Int
c a
x
IArray v a
-> Int -> MutablePrimArray s Int -> MArr (IArray v) s a -> ST s ()
forall s.
IArray v a
-> Int -> MutablePrimArray s Int -> MArr (IArray v) s a -> ST s ()
firstMovePass IArray v a
arr' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MutablePrimArray s Int
bucket MArr (IArray v) s a
w
{-# INLINABLE radixLoop #-}
radixLoop :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> Int -> ST s ((IArray v) a)
radixLoop :: MArr (IArray v) s a
-> MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> Int
-> ST s (IArray v a)
radixLoop !MArr (IArray v) s a
w1 !MArr (IArray v) s a
w2 !MutablePrimArray s Int
bucket !Int
bsiz !Int
pass
| Int
pass Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
passSizInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = do
MArr PrimArray s Int -> Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> Int -> a -> m ()
setArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
0 Int
bsiz Int
0
MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> ST s ()
forall s.
MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> ST s ()
lastCountPass MArr (IArray v) s a
w1 MutablePrimArray s Int
bucket Int
0
MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
accumBucket MutablePrimArray s Int
bucket Int
bsiz Int
0 Int
0
MArr (IArray v) s a
-> MutablePrimArray s Int -> MArr (IArray v) s a -> Int -> ST s ()
forall s.
MArr (IArray v) s a
-> MutablePrimArray s Int -> MArr (IArray v) s a -> Int -> ST s ()
lastMovePass MArr (IArray v) s a
w1 MutablePrimArray s Int
bucket MArr (IArray v) s a
w2 Int
0
MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
w2
| Bool
otherwise = do
MArr PrimArray s Int -> Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> Int -> a -> m ()
setArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
0 Int
bsiz Int
0
MArr (IArray v) s a
-> MutablePrimArray s Int -> Int -> Int -> ST s ()
forall s.
MArr (IArray v) s a
-> MutablePrimArray s Int -> Int -> Int -> ST s ()
countPass MArr (IArray v) s a
w1 MutablePrimArray s Int
bucket Int
pass Int
0
MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
forall s. MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()
accumBucket MutablePrimArray s Int
bucket Int
bsiz Int
0 Int
0
MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> MArr (IArray v) s a
-> Int
-> ST s ()
forall s.
MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> MArr (IArray v) s a
-> Int
-> ST s ()
movePass MArr (IArray v) s a
w1 MutablePrimArray s Int
bucket Int
pass MArr (IArray v) s a
w2 Int
0
MArr (IArray v) s a
-> MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> Int
-> ST s (IArray v a)
forall s.
MArr (IArray v) s a
-> MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> Int
-> ST s (IArray v a)
radixLoop MArr (IArray v) s a
w2 MArr (IArray v) s a
w1 MutablePrimArray s Int
bucket Int
bsiz (Int
passInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINABLE countPass #-}
countPass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> Int -> ST s ()
countPass :: MArr (IArray v) s a
-> MutablePrimArray s Int -> Int -> Int -> ST s ()
countPass !MArr (IArray v) s a
marr !MutablePrimArray s Int
bucket !Int
pass !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
a
x <- MArr (IArray v) s a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MArr (IArray v) s a
marr Int
i
let !r :: Int
r = Int -> a -> Int
forall a. Radix a => Int -> a -> Int
radix Int
pass a
x
Int
c <- MArr PrimArray s Int -> Int -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r
MArr PrimArray s Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
MArr (IArray v) s a
-> MutablePrimArray s Int -> Int -> Int -> ST s ()
forall s.
MArr (IArray v) s a
-> MutablePrimArray s Int -> Int -> Int -> ST s ()
countPass MArr (IArray v) s a
marr MutablePrimArray s Int
bucket Int
pass (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINABLE movePass #-}
movePass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> MArr (IArray v) s a -> Int -> ST s ()
movePass :: MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> MArr (IArray v) s a
-> Int
-> ST s ()
movePass !MArr (IArray v) s a
src !MutablePrimArray s Int
bucket !Int
pass !MArr (IArray v) s a
target !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
a
x <- MArr (IArray v) s a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MArr (IArray v) s a
src Int
i
let !r :: Int
r = Int -> a -> Int
forall a. Radix a => Int -> a -> Int
radix Int
pass a
x
Int
c <- MArr PrimArray s Int -> Int -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r
MArr PrimArray s Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
target Int
c a
x
MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> MArr (IArray v) s a
-> Int
-> ST s ()
forall s.
MArr (IArray v) s a
-> MutablePrimArray s Int
-> Int
-> MArr (IArray v) s a
-> Int
-> ST s ()
movePass MArr (IArray v) s a
src MutablePrimArray s Int
bucket Int
pass MArr (IArray v) s a
target (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINABLE lastCountPass #-}
lastCountPass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> ST s ()
lastCountPass :: MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> ST s ()
lastCountPass !MArr (IArray v) s a
marr !MutablePrimArray s Int
bucket !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
a
x <- MArr (IArray v) s a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MArr (IArray v) s a
marr Int
i
let !r :: Int
r = a -> Int
forall a. Radix a => a -> Int
radixMSB a
x
Int
c <- MArr PrimArray s Int -> Int -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r
MArr PrimArray s Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> ST s ()
forall s.
MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> ST s ()
lastCountPass MArr (IArray v) s a
marr MutablePrimArray s Int
bucket (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINABLE lastMovePass #-}
lastMovePass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> MArr (IArray v) s a -> Int -> ST s ()
lastMovePass :: MArr (IArray v) s a
-> MutablePrimArray s Int -> MArr (IArray v) s a -> Int -> ST s ()
lastMovePass !MArr (IArray v) s a
src !MutablePrimArray s Int
bucket !MArr (IArray v) s a
target !Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
a
x <- MArr (IArray v) s a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MArr (IArray v) s a
src Int
i
let !r :: Int
r = a -> Int
forall a. Radix a => a -> Int
radixMSB a
x
Int
c <- MArr PrimArray s Int -> Int -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m a
readArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r
MArr PrimArray s Int -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MutablePrimArray s Int
MArr PrimArray s Int
bucket Int
r (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
target Int
c a
x
MArr (IArray v) s a
-> MutablePrimArray s Int -> MArr (IArray v) s a -> Int -> ST s ()
forall s.
MArr (IArray v) s a
-> MutablePrimArray s Int -> MArr (IArray v) s a -> Int -> ST s ()
lastMovePass MArr (IArray v) s a
src MutablePrimArray s Int
bucket MArr (IArray v) s a
target (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
mergeDupAdjacent :: forall v a. (Vec v a, Eq a) => v a -> v a
{-# INLINE mergeDupAdjacent #-}
mergeDupAdjacent :: v a -> v a
mergeDupAdjacent = (a -> a -> Bool) -> (a -> a -> a) -> v a -> v a
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Bool) -> (a -> a -> a) -> v a -> v a
mergeDupAdjacentBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) a -> a -> a
forall a b. a -> b -> a
const
mergeDupAdjacentLeft :: forall v a. Vec v a
=> (a -> a -> Bool)
-> v a
-> v a
mergeDupAdjacentLeft :: (a -> a -> Bool) -> v a -> v a
mergeDupAdjacentLeft a -> a -> Bool
eq = (a -> a -> Bool) -> (a -> a -> a) -> v a -> v a
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Bool) -> (a -> a -> a) -> v a -> v a
mergeDupAdjacentBy a -> a -> Bool
eq a -> a -> a
forall a b. a -> b -> a
const
{-# INLINE mergeDupAdjacentLeft #-}
mergeDupAdjacentRight :: forall v a. Vec v a
=> (a -> a -> Bool)
-> v a
-> v a
{-# INLINE mergeDupAdjacentRight #-}
mergeDupAdjacentRight :: (a -> a -> Bool) -> v a -> v a
mergeDupAdjacentRight a -> a -> Bool
eq = (a -> a -> Bool) -> (a -> a -> a) -> v a -> v a
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Bool) -> (a -> a -> a) -> v a -> v a
mergeDupAdjacentBy a -> a -> Bool
eq (\ a
_ a
x -> a
x)
mergeDupAdjacentBy :: forall v a. Vec v a
=> (a -> a -> Bool)
-> (a -> a -> a)
-> v a -> v a
{-# INLINABLE mergeDupAdjacentBy #-}
mergeDupAdjacentBy :: (a -> a -> Bool) -> (a -> a -> a) -> v a -> v a
mergeDupAdjacentBy a -> a -> Bool
eq a -> a -> a
merger v :: v a
v@(Vec IArray v a
arr Int
s Int
l)
| Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = v a
forall (v :: * -> *) a. Vec v a => v a
empty
| Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = v a
v
| Bool
otherwise =
let i :: Int
i = Int -> a -> Int
findFirstDup (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (IArray v a -> Int -> a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> a
indexArr IArray v a
arr Int
s)
in if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end
then v a
v
else Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
createN Int
l ((forall s. MArr (IArray v) s a -> ST s Int) -> v a)
-> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
forall a b. (a -> b) -> a -> b
$ \ MArr (IArray v) s a
marr -> do
let noDupLen :: Int
noDupLen = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
noDupLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (MArr (IArray v) s a -> Int -> IArray v a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr (IArray v) s a
marr Int
0 IArray v a
arr Int
s Int
noDupLen)
a
x0 <- IArray v a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray v a
arr Int
i
a
x1 <- IArray v a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray v a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
let !x' :: a
x' = a -> a -> a
merger a
x0 a
x1
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
noDupLen a
x'
MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
forall s. MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
go MArr (IArray v) s a
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) (Int
noDupLenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x'
where
!end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
findFirstDup :: Int -> a -> Int
findFirstDup :: Int -> a -> Int
findFirstDup !Int
i !a
x
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Int
i
| Bool
otherwise =
let !x' :: a
x' = IArray v a -> Int -> a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> a
indexArr IArray v a
arr Int
i
in if a
x' a -> a -> Bool
`eq` a
x
then (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
else Int -> a -> Int
findFirstDup (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x'
go :: forall s. MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
go :: MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
go !MArr (IArray v) s a
marr !Int
i !Int
j !a
x
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
j
| Bool
otherwise = do
a
x' <- IArray v a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray v a
arr Int
i
if a
x a -> a -> Bool
`eq` a
x'
then do
let !x'' :: a
x'' = a -> a -> a
merger a
x a
x'
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
x''
MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
forall s. MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
go MArr (IArray v) s a
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j a
x''
else do
MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
j a
x'
MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
forall s. MArr (IArray v) s a -> Int -> Int -> a -> ST s Int
go MArr (IArray v) s a
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
x'