{-# LANGUAGE BangPatterns #-}
module Data.Vector.Algorithms.Tim
( sort
, sortBy
) 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)
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 = forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
sortBy forall a. Ord a => a -> a -> Ordering
compare
{-# INLINABLE sort #-}
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 forall a. Eq a => a -> a -> Bool
== Int
len = [Int] -> Int -> v (PrimState m) e -> m ()
iter [Int
0] Int
0 (forall a. HasCallStack => [Char] -> a
error [Char]
"no merge buffer needed!")
| Bool
otherwise = forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
new Int
256 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> Int -> v (PrimState m) e -> m ()
iter [] Int
0
where
len :: Int
len = 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 forall a. Ord a => a -> a -> Bool
>= Int
len = [Int] -> v (PrimState m) e -> m ()
performRemainingMerges [Int]
s v (PrimState m) e
tmpBuf
| Bool
otherwise = do (Order
order, Int
runLen) <- 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
vec Int
i Int
len
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Order
order forall a. Eq a => a -> a -> Bool
== Order
Descending) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m ()
reverse forall a b. (a -> b) -> a -> b
$ 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 = forall a. Ord a => a -> a -> a
min Int
len (Int
i forall a. Num a => a -> a -> a
+ forall a. Ord a => a -> a -> a
max Int
runLen Int
mr)
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
vec Int
i (Int
iforall 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)
performMerges (Int
i forall a. a -> [a] -> [a]
: [Int]
s) Int
runEnd 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 forall a. Num a => a -> a -> a
- a
a forall a. Ord a => a -> a -> Bool
<= a
i forall a. Num a => a -> a -> a
- a
b) Bool -> Bool -> Bool
|| (a
c forall a. Num a => a -> a -> a
- a
b forall a. Ord a => a -> a -> Bool
<= a
i 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 forall a. Num a => a -> a -> a
- Int
b forall a. Ord a => a -> a -> Bool
>= Int
b forall a. Num a => a -> a -> a
- Int
a = 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
a Int
b Int
i v (PrimState m) e
tmpBuf 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
| forall {a}. (Ord a, Num a) => a -> a -> a -> a -> Bool
runLengthInvariantBroken Int
a Int
b Int
c Int
i =
if Int
i forall a. Num a => a -> a -> a
- Int
c forall a. Ord a => a -> a -> Bool
<= Int
b forall a. Num a => a -> a -> a
- Int
a
then 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
b Int
c Int
i v (PrimState m) e
tmpBuf 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
bforall a. a -> [a] -> [a]
:Int
aforall a. a -> [a] -> [a]
:[Int]
ss) Int
i
else do v (PrimState m) e
tmpBuf' <- 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
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
aforall 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
cforall a. a -> [a] -> [a]
:[Int]
ass') Int
i v (PrimState m) e
tmpBuf''
performMerges [Int]
s Int
_ v (PrimState m) e
tmpBuf = 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 =
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
a Int
b Int
len v (PrimState m) e
tmpBuf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Int] -> v (PrimState m) e -> m ()
performRemainingMerges (Int
aforall a. a -> [a] -> [a]
:[Int]
ss)
performRemainingMerges [Int]
_ v (PrimState m) e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE sortBy #-}
minrun :: Int -> Int
minrun :: Int -> Int
minrun Int
n0 = (Int
n0 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
extra) forall a. Num a => a -> a -> a
+ if (Int
lowMask forall a. Bits a => a -> a -> a
.&. Int
n0) forall a. Ord a => a -> a -> Bool
> Int
0 then Int
1 else Int
0
where
!n1 :: Int
n1 = Int
n0 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n0 Int
1
!n2 :: Int
n2 = Int
n1 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n1 Int
2
!n3 :: Int
n3 = Int
n2 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n2 Int
4
!n4 :: Int
n4 = Int
n3 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n3 Int
8
!n5 :: Int
n5 = Int
n4 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n4 Int
16
!n6 :: Int
n6 = Int
n5 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n5 Int
32
!lowMask :: Int
lowMask = Int
n6 forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6
!extra :: Int
extra = forall a. Bits a => a -> Int
popCount Int
lowMask
{-# INLINE minrun #-}
data Order = Ascending | Descending deriving (Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Int -> Order -> ShowS
[Order] -> ShowS
Order -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> [Char]
$cshow :: Order -> [Char]
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> 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
iforall a. Num a => a -> a -> a
+Int
1 forall a. Ord a => a -> a -> Bool
>= Int
len = 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 <- 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 <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
iforall a. Num a => a -> a -> a
+Int
1)
if e
x e -> e -> Bool
`gt` e
y then e -> Int -> m (Order, Int)
desc e
y Int
2 else 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 forall a. Eq a => a -> a -> Bool
== Ordering
GT
desc :: e -> Int -> m (Order, Int)
desc e
_ !Int
k | Int
i forall a. Num a => a -> a -> a
+ Int
k forall a. Ord a => a -> a -> Bool
>= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Descending, Int
k)
desc e
x !Int
k = do e
y <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
iforall 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
kforall a. Num a => a -> a -> a
+Int
1) else 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 forall a. Num a => a -> a -> a
+ Int
k forall a. Ord a => a -> a -> Bool
>= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Ascending, Int
k)
asc e
x !Int
k = do e
y <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
iforall a. Num a => a -> a -> a
+Int
k)
if e
x e -> e -> Bool
`gt` e
y then forall (m :: * -> *) a. Monad m => a -> m a
return (Order
Ascending, Int
k) else e -> Int -> m (Order, Int)
asc e
y (Int
kforall 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 forall a. Ord a => a -> a -> Bool
<= forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
tmpBuf = forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
| Bool
otherwise = forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
new (Int
2forall 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' <- 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
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy (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') (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)
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 <- 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 <- 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 <- 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 ()
iter v (PrimState m) e
tmpBuf Int
0 Int
m Int
l e
vi e
vj Int
minGallop Int
minGallop
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 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 forall a. Eq a => a -> a -> Bool
/= Ordering
LT
tmpBufLen :: Int
tmpBufLen = Int
m 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 = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
i (Int
tmpBufLenforall a. Num a => a -> a -> a
-Int
i) v (PrimState m) e
tmpBuf
to :: v (PrimState m) e
to = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
k (Int
tmpBufLenforall a. Num a => a -> a -> a
-Int
i) v (PrimState m) e
vec
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
to 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 forall a. Ord a => a -> a -> Bool
>= Int
tmpBufLen = 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 forall a. Ord a => a -> a -> Bool
>= Int
u = 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' <- 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
tmpBuf Int
i Int
tmpBufLen
let gallopLen :: Int
gallopLen = Int
i' forall a. Num a => a -> a -> a
- Int
i
from :: v (PrimState m) e
from = 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 = 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
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
to v (PrimState m) e
from
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i' forall a. Ord a => a -> a -> Bool
< Int
tmpBufLen) forall a b. (a -> b) -> a -> b
$ do
e
vi' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead 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
kforall 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' <- 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
vec Int
j Int
u
let gallopLen :: Int
gallopLen = Int
j' forall a. Num a => a -> a -> a
- Int
j
from :: v (PrimState m) e
from = forall (v :: * -> * -> *) a s.
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 = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
slice Int
k Int
gallopLen v (PrimState m) e
vec
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeMove v (PrimState m) e
to v (PrimState m) e
from
if Int
j' forall a. Ord a => a -> a -> Bool
>= Int
u then v (PrimState m) e -> Int -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
i (Int
k forall a. Num a => a -> a -> a
+ Int
gallopLen) else do
e
vj' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead 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
kforall 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 forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
vec Int
k e
vi
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
< Int
tmpBufLen) forall a b. (a -> b) -> a -> b
$ do
e
vi' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
tmpBuf (Int
iforall 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
iforall a. Num a => a -> a -> a
+Int
1) Int
j (Int
kforall a. Num a => a -> a -> a
+Int
1) e
vi' e
vj (Int
gaforall a. Num a => a -> a -> a
-Int
1) Int
minGallop
| Bool
otherwise = do forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
vec Int
k e
vj
if Int
j forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
>= Int
u then v (PrimState m) e -> Int -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
i (Int
k forall a. Num a => a -> a -> a
+ Int
1) else do
e
vj' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
jforall 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
jforall a. Num a => a -> a -> a
+Int
1) (Int
kforall a. Num a => a -> a -> a
+Int
1) e
vi e
vj' Int
minGallop (Int
gbforall 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 <- 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 <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
mforall a. Num a => a -> a -> a
-Int
1)
e
vj <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
tmpBuf (Int
tmpBufLenforall 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
mforall a. Num a => a -> a -> a
-Int
1) (Int
tmpBufLenforall a. Num a => a -> a -> a
-Int
1) (Int
uforall a. Num a => a -> a -> a
-Int
1) e
vi e
vj Int
minGallop Int
minGallop
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 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 forall a. Eq a => a -> a -> Bool
/= Ordering
LT
tmpBufLen :: Int
tmpBufLen = Int
u 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 = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
0 (Int
jforall a. Num a => a -> a -> a
+Int
1) v (PrimState m) e
tmpBuf
to :: v (PrimState m) e
to = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
l (Int
jforall a. Num a => a -> a -> a
+Int
1) v (PrimState m) e
vec
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
to 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 forall a. Ord a => a -> a -> Bool
< Int
0 = 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 forall a. Ord a => a -> a -> Bool
< Int
l = 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' <- 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
vec Int
l Int
i
let gallopLen :: Int
gallopLen = Int
i forall a. Num a => a -> a -> a
- Int
i'
from :: v (PrimState m) e
from = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
slice (Int
i'forall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
vec
to :: v (PrimState m) e
to = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
slice (Int
kforall a. Num a => a -> a -> a
-Int
gallopLenforall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
vec
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeMove v (PrimState m) e
to v (PrimState m) e
from
if Int
i' forall a. Ord a => a -> a -> Bool
< Int
l then v (PrimState m) e -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
j else do
e
vi' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead 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
kforall 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' <- 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
tmpBuf Int
0 Int
j
let gallopLen :: Int
gallopLen = Int
j forall a. Num a => a -> a -> a
- Int
j'
from :: v (PrimState m) e
from = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
slice (Int
j'forall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
tmpBuf
to :: v (PrimState m) e
to = forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
slice (Int
kforall a. Num a => a -> a -> a
-Int
gallopLenforall a. Num a => a -> a -> a
+Int
1) Int
gallopLen v (PrimState m) e
vec
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy v (PrimState m) e
to v (PrimState m) e
from
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j' forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
e
vj' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead 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
kforall 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 forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
vec Int
k e
vi
if Int
i forall a. Num a => a -> a -> a
- Int
1 forall a. Ord a => a -> a -> Bool
< Int
l then v (PrimState m) e -> Int -> m ()
finalize v (PrimState m) e
tmpBuf Int
j else do
e
vi' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
iforall 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
iforall a. Num a => a -> a -> a
-Int
1) Int
j (Int
kforall a. Num a => a -> a -> a
-Int
1) e
vi' e
vj (Int
gaforall a. Num a => a -> a -> a
-Int
1) Int
minGallop
| Bool
otherwise = do forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
vec Int
k e
vj
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
j forall a. Num a => a -> a -> a
- Int
1 forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ do
e
vj' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
tmpBuf (Int
jforall 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
jforall a. Num a => a -> a -> a
-Int
1) (Int
kforall a. Num a => a -> a -> a
-Int
1) e
vi e
vj' Int
minGallop (Int
gbforall 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 <- 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' <- 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' forall a. Ord a => a -> a -> Bool
>= Int
m
then forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
else do
e
vn <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
vec (Int
mforall a. Num a => a -> a -> a
-Int
1)
Int
u' <- 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' forall a. Ord a => a -> a -> Bool
<= Int
m
then forall (m :: * -> *) a. Monad m => a -> m a
return v (PrimState m) e
tmpBuf
else (if (Int
mforall a. Num a => a -> a -> a
-Int
l') forall a. Ord a => a -> a -> Bool
<= (Int
u'forall a. Num a => a -> a -> a
-Int
m) then 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 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 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 forall a. Eq a => a -> a -> Bool
/= Ordering
LT
{-# INLINE merge #-}