{-# LANGUAGE BangPatterns #-}
module Data.Vector.Algorithms.Tim
( sort
, sortUniq
, sortBy
, sortUniqBy
) where
import Prelude hiding (length, reverse)
import Control.Monad.Primitive
import Control.Monad (when)
import Data.Bits
import Data.Vector.Generic.Mutable
import Data.Vector.Algorithms.Search ( gallopingSearchRightPBounds
, gallopingSearchLeftPBounds
)
import Data.Vector.Algorithms.Insertion (sortByBounds', Comparison)
import Data.Vector.Algorithms.Common (uniqueMutableBy)
sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
sort :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
sort = Comparison e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
sortBy Comparison e
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINABLE sort #-}
sortUniq :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m (v (PrimState m) e)
sortUniq :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m (v (PrimState m) e)
sortUniq = Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy Comparison e
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINABLE sortUniq #-}
sortBy :: (PrimMonad m, MVector v e)
=> Comparison e -> v (PrimState m) e -> m ()
sortBy :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
sortBy Comparison e
cmp v (PrimState m) e
vec
| Int
mr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = [Int] -> Int -> v (PrimState m) e -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
[Int] -> Int -> v (PrimState m) e -> m ()
iter [Int
0] Int
0 ([Char] -> v (PrimState m) e
forall a. HasCallStack => [Char] -> a
error [Char]
"no merge buffer needed!")
| Bool
otherwise = Int -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
new Int
256 m (v (PrimState m) e) -> (v (PrimState m) e -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Int -> v (PrimState m) e -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
[Int] -> Int -> v (PrimState m) e -> m ()
iter [] Int
0
where
len :: Int
len = v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
vec
mr :: Int
mr = Int -> Int
minrun Int
len
iter :: [Int] -> Int -> v (PrimState m) e -> m ()
iter [Int]
s Int
i v (PrimState m) e
tmpBuf
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = [Int] -> v (PrimState m) e -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
[Int] -> v (PrimState m) e -> m ()
performRemainingMerges [Int]
s v (PrimState m) e
v (PrimState m) e
tmpBuf
| Bool
otherwise = do (Order
order, Int
runLen) <- Comparison e -> v (PrimState m) e -> Int -> Int -> m (Order, Int)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m (Order, Int)
nextRun Comparison e
cmp v (PrimState m) e
v (PrimState m) e
vec Int
i Int
len
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Order
order Order -> Order -> Bool
forall a. Eq a => a -> a -> Bool
== Order
Descending) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m ()
reverse (v (PrimState m) e -> m ()) -> v (PrimState m) e -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
i Int
runLen v (PrimState m) e
vec
let runEnd :: Int
runEnd = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
runLen Int
mr)
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
sortByBounds' Comparison e
cmp v (PrimState m) e
v (PrimState m) e
vec Int
i (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
runLen) Int
runEnd
([Int]
s', v (PrimState m) e
tmpBuf') <- [Int] -> Int -> v (PrimState m) e -> m ([Int], v (PrimState m) e)
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
[Int] -> Int -> v (PrimState m) e -> m ([Int], v (PrimState m) e)
performMerges (Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
s) Int
runEnd v (PrimState m) e
v (PrimState m) e
tmpBuf
[Int] -> Int -> v (PrimState m) e -> m ()
iter [Int]
s' Int
runEnd v (PrimState m) e
tmpBuf'
runLengthInvariantBroken :: a -> a -> a -> a -> Bool
runLengthInvariantBroken a
a a
b a
c a
i = (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
b) Bool -> Bool -> Bool
|| (a
c a -> a -> a
forall a. Num a => a -> a -> a
- a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
c)
performMerges :: [Int] -> Int -> v (PrimState m) e -> m ([Int], v (PrimState m) e)
performMerges [Int
b,Int
a] Int
i v (PrimState m) e
tmpBuf
| Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a = Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
merge Comparison e
cmp v (PrimState m) e
v (PrimState m) e
vec Int
a Int
b Int
i v (PrimState m) e
tmpBuf m (v (PrimState m) e)
-> (v (PrimState m) e -> m ([Int], v (PrimState m) e))
-> m ([Int], v (PrimState m) e)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Int -> v (PrimState m) e -> m ([Int], v (PrimState m) e)
performMerges [Int
a] Int
i
performMerges (Int
c:Int
b:Int
a:[Int]
ss) Int
i v (PrimState m) e
tmpBuf
| Int -> Int -> Int -> Int -> Bool
forall {a}. (Ord a, Num a) => a -> a -> a -> a -> Bool
runLengthInvariantBroken Int
a Int
b Int
c Int
i =
if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a
then Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
merge Comparison e
cmp v (PrimState m) e
v (PrimState m) e
vec Int
b Int
c Int
i v (PrimState m) e
tmpBuf m (v (PrimState m) e)
-> (v (PrimState m) e -> m ([Int], v (PrimState m) e))
-> m ([Int], v (PrimState m) e)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Int -> v (PrimState m) e -> m ([Int], v (PrimState m) e)
performMerges (Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ss) Int
i
else do v (PrimState m) e
tmpBuf' <- Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
merge Comparison e
cmp v (PrimState m) e
v (PrimState m) e
vec Int
a Int
b Int
c v (PrimState m) e
tmpBuf
([Int]
ass', v (PrimState m) e
tmpBuf'') <- [Int] -> Int -> v (PrimState m) e -> m ([Int], v (PrimState m) e)
performMerges (Int
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ss) Int
c v (PrimState m) e
tmpBuf'
[Int] -> Int -> v (PrimState m) e -> m ([Int], v (PrimState m) e)
performMerges (Int
cInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ass') Int
i v (PrimState m) e
tmpBuf''
performMerges [Int]
s Int
_ v (PrimState m) e
tmpBuf = ([Int], v (PrimState m) e) -> m ([Int], v (PrimState m) e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int]
s, v (PrimState m) e
tmpBuf)
performRemainingMerges :: [Int] -> v (PrimState m) e -> m ()
performRemainingMerges (Int
b:Int
a:[Int]
ss) v (PrimState m) e
tmpBuf =
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
merge Comparison e
cmp v (PrimState m) e
v (PrimState m) e
vec Int
a Int
b Int
len v (PrimState m) e
tmpBuf m (v (PrimState m) e) -> (v (PrimState m) e -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> v (PrimState m) e -> m ()
performRemainingMerges (Int
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ss)
performRemainingMerges [Int]
_ v (PrimState m) e
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE sortBy #-}
sortUniqBy :: (PrimMonad m, MVector v e)
=> Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy Comparison e
cmp v (PrimState m) e
vec = do
Comparison e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
sortBy Comparison e
cmp v (PrimState m) e
vec
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
uniqueMutableBy Comparison e
cmp v (PrimState m) e
vec
{-# INLINE sortUniqBy #-}
minrun :: Int -> Int
minrun :: Int -> Int
minrun Int
n0 = (Int
n0 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
extra) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if (Int
lowMask Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
n0) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
1 else Int
0
where
!n1 :: Int
n1 = Int
n0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n0 Int
1
!n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n1 Int
2
!n3 :: Int
n3 = Int
n2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n2 Int
4
!n4 :: Int
n4 = Int
n3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n3 Int
8
!n5 :: Int
n5 = Int
n4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n4 Int
16
!n6 :: Int
n6 = Int
n5 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n5 Int
32
!lowMask :: Int
lowMask = Int
n6 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6
!extra :: Int
extra = Int -> Int
forall a. Bits a => a -> Int
popCount Int
lowMask
{-# INLINE minrun #-}
data Order = Ascending | Descending deriving (Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
/= :: Order -> Order -> Bool
Eq, Int -> Order -> ShowS
[Order] -> ShowS
Order -> [Char]
(Int -> Order -> ShowS)
-> (Order -> [Char]) -> ([Order] -> ShowS) -> Show Order
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Order -> ShowS
showsPrec :: Int -> Order -> ShowS
$cshow :: Order -> [Char]
show :: Order -> [Char]
$cshowList :: [Order] -> ShowS
showList :: [Order] -> ShowS
Show)
nextRun :: (PrimMonad m, MVector v e)
=> Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> m (Order, Int)
nextRun :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m (Order, Int)
nextRun Comparison e
_ v (PrimState m) e
_ Int
i Int
len | Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = (Order, Int) -> m (Order, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Ascending, Int
1)
nextRun Comparison e
cmp v (PrimState m) e
vec Int
i Int
len = do e
x <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec Int
i
e
y <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
if e
x e -> e -> Bool
`gt` e
y then e -> Int -> m (Order, Int)
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
e -> Int -> m (Order, Int)
desc e
y Int
2 else e -> Int -> m (Order, Int)
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
e -> Int -> m (Order, Int)
asc e
y Int
2
where
gt :: e -> e -> Bool
gt e
a e
b = Comparison e
cmp e
a e
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
desc :: e -> Int -> m (Order, Int)
desc e
_ !Int
k | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = (Order, Int) -> m (Order, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Descending, Int
k)
desc e
x !Int
k = do e
y <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
vec (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k)
if e
x e -> e -> Bool
`gt` e
y then e -> Int -> m (Order, Int)
desc e
y (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) else (Order, Int) -> m (Order, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Descending, Int
k)
asc :: e -> Int -> m (Order, Int)
asc e
_ !Int
k | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = (Order, Int) -> m (Order, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Ascending, Int
k)
asc e
x !Int
k = do e
y <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
vec (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k)
if e
x e -> e -> Bool
`gt` e
y then (Order, Int) -> m (Order, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Ascending, Int
k) else e -> Int -> m (Order, Int)
asc e
y (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE nextRun #-}
ensureCapacity :: (PrimMonad m, MVector v e)
=> Int -> v (PrimState m) e -> m (v (PrimState m) e)
ensureCapacity :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int -> v (PrimState m) e -> m (v (PrimState m) e)
ensureCapacity Int
l v (PrimState m) e
tmpBuf
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
tmpBuf = v (PrimState m) e -> m (v (PrimState m) e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
| Bool
otherwise = Int -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
new (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
l)
{-# INLINE ensureCapacity #-}
cloneSlice :: (PrimMonad m, MVector v e)
=> Int
-> Int
-> v (PrimState m) e
-> v (PrimState m) e
-> m (v (PrimState m) e)
cloneSlice :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int
-> Int
-> v (PrimState m) e
-> v (PrimState m) e
-> m (v (PrimState m) e)
cloneSlice Int
i Int
len v (PrimState m) e
vec v (PrimState m) e
tmpBuf = do
v (PrimState m) e
tmpBuf' <- Int -> v (PrimState m) e -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int -> v (PrimState m) e -> m (v (PrimState m) e)
ensureCapacity Int
len v (PrimState m) e
tmpBuf
v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy (Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
0 Int
len v (PrimState m) e
tmpBuf') (Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
i Int
len v (PrimState m) e
vec)
v (PrimState m) e -> m (v (PrimState m) e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf'
{-# INLINE cloneSlice #-}
minGallop :: Int
minGallop :: Int
minGallop = Int
7
{-# INLINE minGallop #-}
mergeLo :: (PrimMonad m, MVector v e)
=> Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
mergeLo :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
mergeLo Comparison e
cmp v (PrimState m) e
vec Int
l Int
m Int
u v (PrimState m) e
tempBuf' = do
v (PrimState m) e
tmpBuf <- Int
-> Int
-> v (PrimState m) e
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int
-> Int
-> v (PrimState m) e
-> v (PrimState m) e
-> m (v (PrimState m) e)
cloneSlice Int
l Int
tmpBufLen v (PrimState m) e
vec v (PrimState m) e
tempBuf'
e
vi <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
tmpBuf Int
0
e
vj <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec Int
m
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf Int
0 Int
m Int
l e
vi e
vj Int
minGallop Int
minGallop
v (PrimState m) e -> m (v (PrimState m) e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
where
gt :: e -> e -> Bool
gt e
a e
b = Comparison e
cmp e
a e
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
gte :: e -> e -> Bool
gte e
a e
b = Comparison e
cmp e
a e
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
tmpBufLen :: Int
tmpBufLen = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l
finalize :: v (PrimState m) e -> Int -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
i Int
k = do
let from :: v (PrimState m) e
from = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
i (Int
tmpBufLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) v (PrimState m) e
tmpBuf
to :: v (PrimState m) e
to = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
k (Int
tmpBufLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) v (PrimState m) e
vec
v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
v (PrimState m) e
to v (PrimState m) e
v (PrimState m) e
from
iter :: v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
_ Int
i Int
_ Int
_ e
_ e
_ Int
_ Int
_ | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tmpBufLen = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
k e
_ e
_ Int
_ Int
_ | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
u = v (PrimState m) e -> Int -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e -> Int -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
i Int
k
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
k e
_ e
vj Int
0 Int
_ = do
Int
i' <- (e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
gallopingSearchLeftPBounds (e -> e -> Bool
`gt` e
vj) v (PrimState m) e
v (PrimState m) e
tmpBuf Int
i Int
tmpBufLen
let gallopLen :: Int
gallopLen = Int
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
from :: v (PrimState m) e
from = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
i Int
gallopLen v (PrimState m) e
tmpBuf
to :: v (PrimState m) e
to = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
k Int
gallopLen v (PrimState m) e
vec
v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
v (PrimState m) e
to v (PrimState m) e
v (PrimState m) e
from
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tmpBufLen) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
e
vi' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
tmpBuf Int
i'
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf Int
i' Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
gallopLen) e
vi' e
vj Int
minGallop Int
minGallop
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
k e
vi e
_ Int
_ Int
0 = do
Int
j' <- (e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
gallopingSearchLeftPBounds (e -> e -> Bool
`gte` e
vi) v (PrimState m) e
v (PrimState m) e
vec Int
j Int
u
let gallopLen :: Int
gallopLen = Int
j' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j
from :: v (PrimState m) e
from = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
(HasCallStack, MVector v a) =>
Int -> Int -> v s a -> v s a
slice Int
j Int
gallopLen v (PrimState m) e
vec
to :: v (PrimState m) e
to = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
(HasCallStack, MVector v a) =>
Int -> Int -> v s a -> v s a
slice Int
k Int
gallopLen v (PrimState m) e
vec
v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeMove v (PrimState m) e
v (PrimState m) e
to v (PrimState m) e
v (PrimState m) e
from
if Int
j' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
u then v (PrimState m) e -> Int -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e -> Int -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
i (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gallopLen) else do
e
vj' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
vec Int
j'
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf Int
i Int
j' (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
gallopLen) e
vi e
vj' Int
minGallop Int
minGallop
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
k e
vi e
vj Int
ga Int
gb
| e
vj e -> e -> Bool
`gte` e
vi = do v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
v (PrimState m) e
vec Int
k e
vi
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tmpBufLen) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
e
vi' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
tmpBuf (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) e
vi' e
vj (Int
gaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
minGallop
| Bool
otherwise = do v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
v (PrimState m) e
vec Int
k e
vj
if Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
u then v (PrimState m) e -> Int -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e -> Int -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
i (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) else do
e
vj' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
vec (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf Int
i (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) e
vi e
vj' Int
minGallop (Int
gbInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE mergeLo #-}
mergeHi :: (PrimMonad m, MVector v e)
=> Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
mergeHi :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
mergeHi Comparison e
cmp v (PrimState m) e
vec Int
l Int
m Int
u v (PrimState m) e
tmpBuf' = do
v (PrimState m) e
tmpBuf <- Int
-> Int
-> v (PrimState m) e
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int
-> Int
-> v (PrimState m) e
-> v (PrimState m) e
-> m (v (PrimState m) e)
cloneSlice Int
m Int
tmpBufLen v (PrimState m) e
vec v (PrimState m) e
tmpBuf'
e
vi <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
e
vj <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
tmpBuf (Int
tmpBufLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
tmpBufLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
uInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) e
vi e
vj Int
minGallop Int
minGallop
v (PrimState m) e -> m (v (PrimState m) e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
where
gt :: e -> e -> Bool
gt e
a e
b = Comparison e
cmp e
a e
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
gte :: e -> e -> Bool
gte e
a e
b = Comparison e
cmp e
a e
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
tmpBufLen :: Int
tmpBufLen = Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
finalize :: v (PrimState m) e -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
j = do
let from :: v (PrimState m) e
from = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
0 (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) v (PrimState m) e
tmpBuf
to :: v (PrimState m) e
to = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
l (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) v (PrimState m) e
vec
v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
v (PrimState m) e
to v (PrimState m) e
v (PrimState m) e
from
iter :: v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
_ Int
_ Int
j Int
_ e
_ e
_ Int
_ Int
_ | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
_ e
_ e
_ Int
_ Int
_ | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l = v (PrimState m) e -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
j
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
k e
_ e
vj Int
0 Int
_ = do
Int
i' <- (e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
gallopingSearchRightPBounds (e -> e -> Bool
`gt` e
vj) v (PrimState m) e
v (PrimState m) e
vec Int
l Int
i
let gallopLen :: Int
gallopLen = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i'
from :: v (PrimState m) e
from = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
(HasCallStack, MVector v a) =>
Int -> Int -> v s a -> v s a
slice (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
vec
to :: v (PrimState m) e
to = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
(HasCallStack, MVector v a) =>
Int -> Int -> v s a -> v s a
slice (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
gallopLenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
vec
v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeMove v (PrimState m) e
v (PrimState m) e
to v (PrimState m) e
v (PrimState m) e
from
if Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l then v (PrimState m) e -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
j else do
e
vi' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
vec Int
i'
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf Int
i' Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
gallopLen) e
vi' e
vj Int
minGallop Int
minGallop
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
k e
vi e
_ Int
_ Int
0 = do
Int
j' <- (e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
gallopingSearchRightPBounds (e -> e -> Bool
`gte` e
vi) v (PrimState m) e
v (PrimState m) e
tmpBuf Int
0 Int
j
let gallopLen :: Int
gallopLen = Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j'
from :: v (PrimState m) e
from = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
(HasCallStack, MVector v a) =>
Int -> Int -> v s a -> v s a
slice (Int
j'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
tmpBuf
to :: v (PrimState m) e
to = Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
(HasCallStack, MVector v a) =>
Int -> Int -> v s a -> v s a
slice (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
gallopLenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
vec
v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
v (PrimState m) e
to v (PrimState m) e
v (PrimState m) e
from
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
e
vj' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
tmpBuf Int
j'
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf Int
i Int
j' (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
gallopLen) e
vi e
vj' Int
minGallop Int
minGallop
iter v (PrimState m) e
tmpBuf Int
i Int
j Int
k e
vi e
vj Int
ga Int
gb
| e
vi e -> e -> Bool
`gt` e
vj = do v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
v (PrimState m) e
vec Int
k e
vi
if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l then v (PrimState m) e -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ PrimState m, PrimMonad m) =>
v (PrimState m) e -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
j else do
e
vi' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
vec (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) e
vi' e
vj (Int
gaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
minGallop
| Bool
otherwise = do v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
v (PrimState m) e
vec Int
k e
vj
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
e
vj' <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
v (PrimState m) e
tmpBuf (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
v (PrimState m) e
-> Int -> Int -> Int -> e -> e -> Int -> Int -> m ()
iter v (PrimState m) e
tmpBuf Int
i (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) e
vi e
vj' Int
minGallop (Int
gbInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE mergeHi #-}
merge :: (PrimMonad m, MVector v e)
=> Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
merge :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
merge Comparison e
cmp v (PrimState m) e
vec Int
l Int
m Int
u v (PrimState m) e
tmpBuf = do
e
vm <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec Int
m
Int
l' <- (e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
gallopingSearchLeftPBounds (e -> e -> Bool
`gt` e
vm) v (PrimState m) e
vec Int
l Int
m
if Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m
then v (PrimState m) e -> m (v (PrimState m) e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
else do
e
vn <- v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
Int
u' <- (e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> Bool) -> v (PrimState m) e -> Int -> Int -> m Int
gallopingSearchRightPBounds (e -> e -> Bool
`gte` e
vn) v (PrimState m) e
vec Int
m Int
u
if Int
u' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m
then v (PrimState m) e -> m (v (PrimState m) e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
else (if (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
u'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m) then Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
mergeLo else Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e
-> v (PrimState m) e
-> Int
-> Int
-> Int
-> v (PrimState m) e
-> m (v (PrimState m) e)
mergeHi) Comparison e
cmp v (PrimState m) e
vec Int
l' Int
m Int
u' v (PrimState m) e
tmpBuf
where
gt :: e -> e -> Bool
gt e
a e
b = Comparison e
cmp e
a e
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
gte :: e -> e -> Bool
gte e
a e
b = Comparison e
cmp e
a e
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
{-# INLINE merge #-}