{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module DataSketches.Quantiles.RelativeErrorQuantile.Internal.DoubleBuffer
( DoubleBuffer
, Capacity
, GrowthIncrement
, SpaceAtBottom
, DoubleIsNonFiniteException(..)
, mkBuffer
, copyBuffer
, append
, ensureCapacity
, getCountWithCriterion
, getEvensOrOdds
, (!)
, growthIncrement
, spaceAtBottom
, getCapacity
, getCount
, getSpace
, getVector
, isEmpty
, isSorted
, sort
, mergeSortIn
, trimCount
) where
import DataSketches.Quantiles.RelativeErrorQuantile.Types
( Criterion )
import Control.Monad ( unless, when )
import Control.Monad.Primitive ( PrimMonad(PrimState) )
import Data.Primitive.MutVar
( newMutVar, readMutVar, writeMutVar, MutVar )
import qualified Data.Vector.Unboxed as UVector
import qualified Data.Vector.Unboxed.Mutable as MUVector
import DataSketches.Core.Internal.URef
( URef, newURef, readURef, writeURef, modifyURef )
import Data.Vector.Algorithms.Intro (sortByBounds)
import GHC.Stack ( HasCallStack )
import System.IO.Unsafe ()
import qualified DataSketches.Quantiles.RelativeErrorQuantile.Internal.InequalitySearch as IS
import Control.Exception ( Exception, throw )
import DataSketches.Core.Snapshot ( TakeSnapshot(..) )
data DoubleBuffer s = DoubleBuffer
{ DoubleBuffer s -> MutVar s (MVector s Double)
vec :: {-# UNPACK #-} !(MutVar s (MUVector.MVector s Double))
, DoubleBuffer s -> URef s Int
count :: {-# UNPACK #-} !(URef s Int)
, DoubleBuffer s -> URef s Bool
sorted :: {-# UNPACK #-} !(URef s Bool)
, DoubleBuffer s -> Int
growthIncrement :: {-# UNPACK #-} !Int
, DoubleBuffer s -> Bool
spaceAtBottom :: !Bool
}
data DoubleBufferSnapshot = DoubleBufferSnapshot
{ DoubleBufferSnapshot -> Vector Double
dbSnapshotVec :: UVector.Vector Double
, DoubleBufferSnapshot -> Int
dbSnapshotCount :: !Int
, DoubleBufferSnapshot -> Bool
dbSnapshotSorted :: !Bool
, DoubleBufferSnapshot -> Int
dbSnapshotGrowthIncrement :: !Int
, DoubleBufferSnapshot -> Bool
dbSnapshotSpaceAtBottom :: !Bool
} deriving (Int -> DoubleBufferSnapshot -> ShowS
[DoubleBufferSnapshot] -> ShowS
DoubleBufferSnapshot -> String
(Int -> DoubleBufferSnapshot -> ShowS)
-> (DoubleBufferSnapshot -> String)
-> ([DoubleBufferSnapshot] -> ShowS)
-> Show DoubleBufferSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DoubleBufferSnapshot] -> ShowS
$cshowList :: [DoubleBufferSnapshot] -> ShowS
show :: DoubleBufferSnapshot -> String
$cshow :: DoubleBufferSnapshot -> String
showsPrec :: Int -> DoubleBufferSnapshot -> ShowS
$cshowsPrec :: Int -> DoubleBufferSnapshot -> ShowS
Show)
instance TakeSnapshot DoubleBuffer where
type Snapshot DoubleBuffer = DoubleBufferSnapshot
takeSnapshot :: DoubleBuffer (PrimState m) -> m (Snapshot DoubleBuffer)
takeSnapshot DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} = Vector Double -> Int -> Bool -> Int -> Bool -> DoubleBufferSnapshot
DoubleBufferSnapshot
(Vector Double
-> Int -> Bool -> Int -> Bool -> DoubleBufferSnapshot)
-> m (Vector Double)
-> m (Int -> Bool -> Int -> Bool -> DoubleBufferSnapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutVar (PrimState m) (MVector (PrimState m) Double)
-> m (MVector (PrimState m) Double)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (MVector (PrimState m) Double)
vec m (MVector (PrimState m) Double)
-> (MVector (PrimState m) Double -> m (Vector Double))
-> m (Vector Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector (PrimState m) Double -> m (Vector Double)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
UVector.freeze)
m (Int -> Bool -> Int -> Bool -> DoubleBufferSnapshot)
-> m Int -> m (Bool -> Int -> Bool -> DoubleBufferSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> URef (PrimState m) Int -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef URef (PrimState m) Int
count
m (Bool -> Int -> Bool -> DoubleBufferSnapshot)
-> m Bool -> m (Int -> Bool -> DoubleBufferSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> URef (PrimState m) Bool -> m Bool
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef URef (PrimState m) Bool
sorted
m (Int -> Bool -> DoubleBufferSnapshot)
-> m Int -> m (Bool -> DoubleBufferSnapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
growthIncrement
m (Bool -> DoubleBufferSnapshot)
-> m Bool -> m DoubleBufferSnapshot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
spaceAtBottom
type Capacity = Int
type GrowthIncrement = Int
type SpaceAtBottom = Bool
mkBuffer :: PrimMonad m => Capacity -> GrowthIncrement -> SpaceAtBottom -> m (DoubleBuffer (PrimState m))
mkBuffer :: Int -> Int -> Bool -> m (DoubleBuffer (PrimState m))
mkBuffer Int
capacity_ Int
growthIncrement Bool
spaceAtBottom = do
MutVar (PrimState m) (MVector (PrimState m) Double)
vec <- MVector (PrimState m) Double
-> m (MutVar (PrimState m) (MVector (PrimState m) Double))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (MVector (PrimState m) Double
-> m (MutVar (PrimState m) (MVector (PrimState m) Double)))
-> m (MVector (PrimState m) Double)
-> m (MutVar (PrimState m) (MVector (PrimState m) Double))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> m (MVector (PrimState m) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MUVector.new Int
capacity_
URef (PrimState m) Int
count <- Int -> m (URef (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef Int
0
URef (PrimState m) Bool
sorted <- Bool -> m (URef (PrimState m) Bool)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef Bool
True
DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m)))
-> DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m))
forall a b. (a -> b) -> a -> b
$ DoubleBuffer :: forall s.
MutVar s (MVector s Double)
-> URef s Int -> URef s Bool -> Int -> Bool -> DoubleBuffer s
DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
spaceAtBottom :: Bool
growthIncrement :: Int
..}
copyBuffer :: PrimMonad m => DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m))
copyBuffer :: DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m))
copyBuffer buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} = do
MutVar (PrimState m) (MVector (PrimState m) Double)
vec <- MVector (PrimState m) Double
-> m (MutVar (PrimState m) (MVector (PrimState m) Double))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar (MVector (PrimState m) Double
-> m (MutVar (PrimState m) (MVector (PrimState m) Double)))
-> m (MVector (PrimState m) Double)
-> m (MutVar (PrimState m) (MVector (PrimState m) Double))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVector (PrimState m) Double -> m (MVector (PrimState m) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> m (MVector (PrimState m) a)
MUVector.clone (MVector (PrimState m) Double -> m (MVector (PrimState m) Double))
-> m (MVector (PrimState m) Double)
-> m (MVector (PrimState m) Double)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
buf
URef (PrimState m) Int
count <- Int -> m (URef (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef (Int -> m (URef (PrimState m) Int))
-> m Int -> m (URef (PrimState m) Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
URef (PrimState m) Bool
sorted <- Bool -> m (URef (PrimState m) Bool)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef (Bool -> m (URef (PrimState m) Bool))
-> m Bool -> m (URef (PrimState m) Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< URef (PrimState m) Bool -> m Bool
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef URef (PrimState m) Bool
sorted
DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m)))
-> DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m))
forall a b. (a -> b) -> a -> b
$ DoubleBuffer :: forall s.
MutVar s (MVector s Double)
-> URef s Int -> URef s Bool -> Int -> Bool -> DoubleBuffer s
DoubleBuffer {Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
spaceAtBottom :: Bool
growthIncrement :: Int
..}
append :: PrimMonad m => DoubleBuffer (PrimState m) -> Double -> m ()
append :: DoubleBuffer (PrimState m) -> Double -> m ()
append buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} Double
x = do
DoubleBuffer (PrimState m) -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> Int -> m ()
ensureSpace DoubleBuffer (PrimState m)
buf Int
1
Int
index <- if Bool
spaceAtBottom
then
(\Int
capacity_ Int
count_ -> Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
(Int -> Int -> Int) -> m Int -> m (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf
m (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
else URef (PrimState m) Int -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef URef (PrimState m) Int
count
URef (PrimState m) Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef URef (PrimState m) Int
count (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
buf m (MVector (PrimState m) Double)
-> (MVector (PrimState m) Double -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVector (PrimState m) Double
vec -> MVector (PrimState m) Double -> Int -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) Double
vec Int
index Double
x
URef (PrimState m) Bool -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef URef (PrimState m) Bool
sorted Bool
False
{-# SCC append #-}
ensureSpace :: PrimMonad m => DoubleBuffer (PrimState m) -> Int -> m ()
ensureSpace :: DoubleBuffer (PrimState m) -> Int -> m ()
ensureSpace buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} Int
space = do
Int
count_ <- URef (PrimState m) Int -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef URef (PrimState m) Int
count
Int
capacity_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf
let notEnoughSpace :: Bool
notEnoughSpace = Int
count_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
space Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
capacity_
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notEnoughSpace (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let newCap :: Int
newCap = Int
count_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
space Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
growthIncrement
DoubleBuffer (PrimState m) -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> Int -> m ()
ensureCapacity DoubleBuffer (PrimState m)
buf Int
newCap
getVector :: (PrimMonad m, PrimState m ~ s) => DoubleBuffer s -> m (MUVector.MVector s Double)
getVector :: DoubleBuffer s -> m (MVector s Double)
getVector = MutVar s (MVector s Double) -> m (MVector s Double)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (MutVar s (MVector s Double) -> m (MVector s Double))
-> (DoubleBuffer s -> MutVar s (MVector s Double))
-> DoubleBuffer s
-> m (MVector s Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoubleBuffer s -> MutVar s (MVector s Double)
forall s. DoubleBuffer s -> MutVar s (MVector s Double)
vec
{-# INLINE getVector #-}
getCapacity :: PrimMonad m => DoubleBuffer (PrimState m) -> m Int
getCapacity :: DoubleBuffer (PrimState m) -> m Int
getCapacity = (MVector (PrimState m) Double -> Int)
-> m (MVector (PrimState m) Double) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) Double -> Int
forall a s. Unbox a => MVector s a -> Int
MUVector.length (m (MVector (PrimState m) Double) -> m Int)
-> (DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double))
-> DoubleBuffer (PrimState m)
-> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector
{-# INLINE getCapacity #-}
ensureCapacity :: PrimMonad m => DoubleBuffer (PrimState m) -> Int -> m ()
ensureCapacity :: DoubleBuffer (PrimState m) -> Int -> m ()
ensureCapacity buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} Int
newCapacity = do
Int
capacity_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newCapacity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
capacity_) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Int
count_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
(Int
srcPos, Int
destPos) <- if Bool
spaceAtBottom
then do
(Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count_, Int
newCapacity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count_)
else (Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0)
MVector (PrimState m) Double
oldVec <- DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
buf
MVector (PrimState m) Double
newVec <- Int -> m (MVector (PrimState m) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MUVector.new Int
newCapacity
MVector (PrimState m) Double
-> MVector (PrimState m) Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MUVector.unsafeCopy
(Int
-> Int
-> MVector (PrimState m) Double
-> MVector (PrimState m) Double
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MUVector.slice Int
destPos Int
count_ MVector (PrimState m) Double
newVec)
(Int
-> Int
-> MVector (PrimState m) Double
-> MVector (PrimState m) Double
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MUVector.slice Int
srcPos Int
count_ MVector (PrimState m) Double
oldVec)
MutVar (PrimState m) (MVector (PrimState m) Double)
-> MVector (PrimState m) Double -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar MutVar (PrimState m) (MVector (PrimState m) Double)
vec MVector (PrimState m) Double
newVec
{-# SCC ensureCapacity #-}
newtype DoubleIsNonFiniteException = DoubleIsNonFiniteException Double
deriving (Int -> DoubleIsNonFiniteException -> ShowS
[DoubleIsNonFiniteException] -> ShowS
DoubleIsNonFiniteException -> String
(Int -> DoubleIsNonFiniteException -> ShowS)
-> (DoubleIsNonFiniteException -> String)
-> ([DoubleIsNonFiniteException] -> ShowS)
-> Show DoubleIsNonFiniteException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DoubleIsNonFiniteException] -> ShowS
$cshowList :: [DoubleIsNonFiniteException] -> ShowS
show :: DoubleIsNonFiniteException -> String
$cshow :: DoubleIsNonFiniteException -> String
showsPrec :: Int -> DoubleIsNonFiniteException -> ShowS
$cshowsPrec :: Int -> DoubleIsNonFiniteException -> ShowS
Show, DoubleIsNonFiniteException -> DoubleIsNonFiniteException -> Bool
(DoubleIsNonFiniteException -> DoubleIsNonFiniteException -> Bool)
-> (DoubleIsNonFiniteException
-> DoubleIsNonFiniteException -> Bool)
-> Eq DoubleIsNonFiniteException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoubleIsNonFiniteException -> DoubleIsNonFiniteException -> Bool
$c/= :: DoubleIsNonFiniteException -> DoubleIsNonFiniteException -> Bool
== :: DoubleIsNonFiniteException -> DoubleIsNonFiniteException -> Bool
$c== :: DoubleIsNonFiniteException -> DoubleIsNonFiniteException -> Bool
Eq)
instance Exception DoubleIsNonFiniteException
getCountWithCriterion :: PrimMonad m => DoubleBuffer (PrimState m) -> Double -> Criterion -> m Int
getCountWithCriterion :: DoubleBuffer (PrimState m) -> Double -> Criterion -> m Int
getCountWithCriterion buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} Double
value Criterion
criterion = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
value Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
value) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ DoubleIsNonFiniteException -> m ()
forall a e. Exception e => e -> a
throw (DoubleIsNonFiniteException -> m ())
-> DoubleIsNonFiniteException -> m ()
forall a b. (a -> b) -> a -> b
$ Double -> DoubleIsNonFiniteException
DoubleIsNonFiniteException Double
value
DoubleBuffer (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m ()
sort DoubleBuffer (PrimState m)
buf
Int
count_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
MVector (PrimState m) Double
vec <- DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
buf
(Int
low, Int
high) <- if Bool
spaceAtBottom
then do
Int
capacity_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf
(Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count_, Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else (Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
count_)
Int
ix <- Criterion
-> MVector (PrimState m) Double -> Int -> Int -> Double -> m Int
forall s (m :: * -> *) (v :: * -> * -> *) a.
(InequalitySearch s, PrimMonad m, MVector v a, Ord a) =>
s -> v (PrimState m) a -> Int -> Int -> a -> m Int
IS.find Criterion
criterion MVector (PrimState m) Double
vec Int
low Int
high Double
value
Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! if Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== MVector (PrimState m) Double -> Int
forall a s. Unbox a => MVector s a -> Int
MUVector.length MVector (PrimState m) Double
vec
then Int
0
else Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
low Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
getEvensOrOdds :: PrimMonad m => DoubleBuffer (PrimState m) -> Int -> Int -> Bool -> m (DoubleBuffer (PrimState m))
getEvensOrOdds :: DoubleBuffer (PrimState m)
-> Int -> Int -> Bool -> m (DoubleBuffer (PrimState m))
getEvensOrOdds buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} Int
startOffset Int
endOffset Bool
odds = do
(Int
start, Int
end) <- if Bool
spaceAtBottom
then do
Int
basis <- (-) (Int -> Int -> Int) -> m Int -> m (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf m (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
(Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
basis Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
startOffset, Int
basis Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
endOffset)
else (Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
startOffset, Int
endOffset)
DoubleBuffer (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m ()
sort DoubleBuffer (PrimState m)
buf
let range :: Int
range = Int
endOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startOffset
MVector (PrimState m) Double
vec <- DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
buf
MVector (PrimState m) Double
out <- Int -> m (MVector (PrimState m) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MUVector.new (Int
range Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
MVector (PrimState m) Double
-> MVector (PrimState m) Double
-> Int
-> Int
-> m (DoubleBuffer (PrimState m))
go MVector (PrimState m) Double
vec MVector (PrimState m) Double
out Int
start Int
0
where
odd :: Int
odd = if Bool
odds then Int
1 else Int
0
go :: MVector (PrimState m) Double
-> MVector (PrimState m) Double
-> Int
-> Int
-> m (DoubleBuffer (PrimState m))
go MVector (PrimState m) Double
vec !MVector (PrimState m) Double
out !Int
i !Int
j = if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MVector (PrimState m) Double -> Int
forall a s. Unbox a => MVector s a -> Int
MUVector.length MVector (PrimState m) Double
out
then do
MVector (PrimState m) Double -> Int -> Double -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) Double
out Int
j (Double -> m ()) -> m Double -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVector (PrimState m) Double -> Int -> m Double
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.unsafeRead MVector (PrimState m) Double
vec (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
odd)
MVector (PrimState m) Double
-> MVector (PrimState m) Double
-> Int
-> Int
-> m (DoubleBuffer (PrimState m))
go MVector (PrimState m) Double
vec MVector (PrimState m) Double
out (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else do
URef (PrimState m) Int
count <- Int -> m (URef (PrimState m) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef (MVector (PrimState m) Double -> Int
forall a s. Unbox a => MVector s a -> Int
MUVector.length MVector (PrimState m) Double
out)
URef (PrimState m) Bool
sorted <- Bool -> m (URef (PrimState m) Bool)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
a -> m (URef (PrimState m) a)
newURef Bool
True
MutVar (PrimState m) (MVector (PrimState m) Double)
vec <- MVector (PrimState m) Double
-> m (MutVar (PrimState m) (MVector (PrimState m) Double))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar MVector (PrimState m) Double
out
DoubleBuffer (PrimState m) -> m (DoubleBuffer (PrimState m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure DoubleBuffer :: forall s.
MutVar s (MVector s Double)
-> URef s Int -> URef s Bool -> Int -> Bool -> DoubleBuffer s
DoubleBuffer
{ vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
vec = MutVar (PrimState m) (MVector (PrimState m) Double)
vec
, count :: URef (PrimState m) Int
count = URef (PrimState m) Int
count
, sorted :: URef (PrimState m) Bool
sorted = URef (PrimState m) Bool
sorted
, growthIncrement :: Int
growthIncrement = Int
0
, spaceAtBottom :: Bool
spaceAtBottom = Bool
spaceAtBottom
}
{-# SCC getEvensOrOdds #-}
(!) :: PrimMonad m => DoubleBuffer (PrimState m) -> Int -> m Double
(!) DoubleBuffer (PrimState m)
buf Int
offset = do
Int
index <- if DoubleBuffer (PrimState m) -> Bool
forall s. DoubleBuffer s -> Bool
spaceAtBottom DoubleBuffer (PrimState m)
buf
then do
Int
capacity_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf
Int
count_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset
else Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
offset
MVector (PrimState m) Double
vec <- DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
buf
MVector (PrimState m) Double -> Int -> m Double
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) Double
vec Int
index
getCount :: PrimMonad m => DoubleBuffer (PrimState m) -> m Int
getCount :: DoubleBuffer (PrimState m) -> m Int
getCount = URef (PrimState m) Int -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Int -> m Int)
-> (DoubleBuffer (PrimState m) -> URef (PrimState m) Int)
-> DoubleBuffer (PrimState m)
-> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoubleBuffer (PrimState m) -> URef (PrimState m) Int
forall s. DoubleBuffer s -> URef s Int
count
getSpace :: PrimMonad m => DoubleBuffer (PrimState m) -> m Int
getSpace :: DoubleBuffer (PrimState m) -> m Int
getSpace buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} = (-) (Int -> Int -> Int) -> m Int -> m (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf m (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
isEmpty :: PrimMonad m => DoubleBuffer (PrimState m) -> m Bool
isEmpty :: DoubleBuffer (PrimState m) -> m Bool
isEmpty DoubleBuffer (PrimState m)
buf = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> m Int -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
isSorted :: PrimMonad m => DoubleBuffer (PrimState m) -> m Bool
isSorted :: DoubleBuffer (PrimState m) -> m Bool
isSorted = URef (PrimState m) Bool -> m Bool
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> m a
readURef (URef (PrimState m) Bool -> m Bool)
-> (DoubleBuffer (PrimState m) -> URef (PrimState m) Bool)
-> DoubleBuffer (PrimState m)
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DoubleBuffer (PrimState m) -> URef (PrimState m) Bool
forall s. DoubleBuffer s -> URef s Bool
sorted
sort :: PrimMonad m => DoubleBuffer (PrimState m) -> m ()
sort :: DoubleBuffer (PrimState m) -> m ()
sort buf :: DoubleBuffer (PrimState m)
buf@DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} = do
Bool
sorted_ <- DoubleBuffer (PrimState m) -> m Bool
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Bool
isSorted DoubleBuffer (PrimState m)
buf
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sorted_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Int
capacity_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
buf
Int
count_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
buf
let (Int
start, Int
end) = if Bool
spaceAtBottom
then (Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count_, Int
capacity_)
else (Int
0, Int
count_)
MVector (PrimState m) Double
vec <- DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
buf
Comparison Double
-> MVector (PrimState m) Double -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
sortByBounds Comparison Double
forall a. Ord a => a -> a -> Ordering
compare MVector (PrimState m) Double
vec Int
start Int
end
URef (PrimState m) Bool -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef URef (PrimState m) Bool
sorted Bool
True
{-# SCC sort #-}
mergeSortIn :: (PrimMonad m, HasCallStack) => DoubleBuffer (PrimState m) -> DoubleBuffer (PrimState m) -> m ()
mergeSortIn :: DoubleBuffer (PrimState m) -> DoubleBuffer (PrimState m) -> m ()
mergeSortIn DoubleBuffer (PrimState m)
this DoubleBuffer (PrimState m)
bufIn = do
DoubleBuffer (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m ()
sort DoubleBuffer (PrimState m)
this
DoubleBuffer (PrimState m) -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m ()
sort DoubleBuffer (PrimState m)
bufIn
MVector (PrimState m) Double
thatBuf <- DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
bufIn
Int
bufInLen <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
bufIn
DoubleBuffer (PrimState m) -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> Int -> m ()
ensureSpace DoubleBuffer (PrimState m)
this Int
bufInLen
Int
count_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCount DoubleBuffer (PrimState m)
this
let totalLength :: Int
totalLength = Int
count_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bufInLen
MVector (PrimState m) Double
thisBuf <- DoubleBuffer (PrimState m) -> m (MVector (PrimState m) Double)
forall (m :: * -> *) s.
(PrimMonad m, PrimState m ~ s) =>
DoubleBuffer s -> m (MVector s Double)
getVector DoubleBuffer (PrimState m)
this
if DoubleBuffer (PrimState m) -> Bool
forall s. DoubleBuffer s -> Bool
spaceAtBottom DoubleBuffer (PrimState m)
this
then do
Int
capacity_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
this
Int
bufInCapacity_ <- DoubleBuffer (PrimState m) -> m Int
forall (m :: * -> *).
PrimMonad m =>
DoubleBuffer (PrimState m) -> m Int
getCapacity DoubleBuffer (PrimState m)
bufIn
DoubleBufferSnapshot
inSs <- DoubleBuffer (PrimState m) -> m (Snapshot DoubleBuffer)
forall (a :: * -> *) (m :: * -> *).
(TakeSnapshot a, PrimMonad m) =>
a (PrimState m) -> m (Snapshot a)
takeSnapshot DoubleBuffer (PrimState m)
bufIn
let i :: Int
i = Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count_
let j :: Int
j = Int
bufInCapacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bufInLen
let targetStart :: Int
targetStart = Int
capacity_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
totalLength
let k :: Int
k = Int
targetStart
MVector (PrimState m) Double
-> MVector (PrimState m) Double
-> Int
-> Int
-> Int
-> Int
-> Int
-> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Ord a) =>
MVector (PrimState m) a
-> MVector (PrimState m) a
-> Int
-> Int
-> Int
-> Int
-> Int
-> m ()
mergeUpwards MVector (PrimState m) Double
thisBuf MVector (PrimState m) Double
thatBuf Int
capacity_ Int
bufInCapacity_ Int
i Int
j Int
k
else do
let i :: Int
i = Int
count_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
let j :: Int
j = Int
bufInLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
let k :: Int
k = Int
totalLength
MVector (PrimState m) Double
-> MVector (PrimState m) Double -> Int -> Int -> Int -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a, Ord a) =>
MVector (PrimState m) a
-> MVector (PrimState m) a -> Int -> Int -> Int -> m ()
mergeDownwards MVector (PrimState m) Double
thisBuf MVector (PrimState m) Double
thatBuf Int
i Int
j (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
URef (PrimState m) Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef (DoubleBuffer (PrimState m) -> URef (PrimState m) Int
forall s. DoubleBuffer s -> URef s Int
count DoubleBuffer (PrimState m)
this) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bufInLen)
URef (PrimState m) Bool -> Bool -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> a -> m ()
writeURef (DoubleBuffer (PrimState m) -> URef (PrimState m) Bool
forall s. DoubleBuffer s -> URef s Bool
sorted DoubleBuffer (PrimState m)
this) Bool
True
() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
mergeUpwards :: MVector (PrimState m) a
-> MVector (PrimState m) a
-> Int
-> Int
-> Int
-> Int
-> Int
-> m ()
mergeUpwards MVector (PrimState m) a
thisBuf MVector (PrimState m) a
thatBuf Int
capacity_ Int
bufInCapacity_ = Int -> Int -> Int -> m ()
go
where
go :: Int -> Int -> Int -> m ()
go !Int
i !Int
j !Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
capacity_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capacity_ Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufInCapacity_ = do
a
iVal <- MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thisBuf Int
i
a
jVal <- MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thatBuf Int
j
if a
iVal a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
jVal
then MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k a
iVal m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Int -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
j (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k a
jVal m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Int -> m ()
go Int
i (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capacity_ = do
MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thisBuf Int
i
Int -> Int -> Int -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
j (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufInCapacity_ = do
MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thatBuf Int
j
Int -> Int -> Int -> m ()
go Int
i (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
mergeDownwards :: MVector (PrimState m) a
-> MVector (PrimState m) a -> Int -> Int -> Int -> m ()
mergeDownwards MVector (PrimState m) a
thisBuf MVector (PrimState m) a
thatBuf !Int
i !Int
j !Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = do
a
iVal <- MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thisBuf Int
i
a
jVal <- MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thatBuf Int
j
if a
iVal a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
jVal
then do
MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k a
iVal m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Int -> m ()
continue (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
j (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
else do
MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k a
jVal m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Int -> m ()
continue Int
i (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = do
MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thisBuf Int
i
Int -> Int -> Int -> m ()
continue (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
j (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = do
MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MUVector.unsafeWrite MVector (PrimState m) a
thisBuf Int
k (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MUVector.read MVector (PrimState m) a
thatBuf Int
j
Int -> Int -> Int -> m ()
continue Int
i (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
continue :: Int -> Int -> Int -> m ()
continue = MVector (PrimState m) a
-> MVector (PrimState m) a -> Int -> Int -> Int -> m ()
mergeDownwards MVector (PrimState m) a
thisBuf MVector (PrimState m) a
thatBuf
{-# SCC mergeSortIn #-}
trimCount :: PrimMonad m => DoubleBuffer (PrimState m) -> Int -> m ()
trimCount :: DoubleBuffer (PrimState m) -> Int -> m ()
trimCount DoubleBuffer{Bool
Int
MutVar (PrimState m) (MVector (PrimState m) Double)
URef (PrimState m) Bool
URef (PrimState m) Int
spaceAtBottom :: Bool
growthIncrement :: Int
sorted :: URef (PrimState m) Bool
count :: URef (PrimState m) Int
vec :: MutVar (PrimState m) (MVector (PrimState m) Double)
sorted :: forall s. DoubleBuffer s -> URef s Bool
count :: forall s. DoubleBuffer s -> URef s Int
vec :: forall s. DoubleBuffer s -> MutVar s (MVector s Double)
spaceAtBottom :: forall s. DoubleBuffer s -> Bool
growthIncrement :: forall s. DoubleBuffer s -> Int
..} Int
newCount = URef (PrimState m) Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
URef (PrimState m) a -> (a -> a) -> m ()
modifyURef URef (PrimState m) Int
count (\Int
oldCount -> if Int
newCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
oldCount then Int
newCount else Int
oldCount)