{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module DataSketches.Quantiles.RelativeErrorQuantile.Internal.DoubleBuffer
  ( DoubleBuffer
  , Capacity
  , GrowthIncrement
  , SpaceAtBottom
  , DoubleIsNonFiniteException(..)
  , mkBuffer
  , copyBuffer
  , append
  , ensureCapacity
  , getCountWithCriterion
  , getEvensOrOdds
  , (!) -- getItem
  , growthIncrement
  , spaceAtBottom
  , getCapacity
  , getCount
  , getSpace
  , getVector
  , isEmpty
  , isSorted
  , sort
  , mergeSortIn
  , trimCount
  ) where

import DataSketches.Quantiles.RelativeErrorQuantile.Types
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.Reader.Class
import Data.Primitive.MutVar
import qualified Data.Vector.Unboxed as UVector
import qualified Data.Vector.Unboxed.Mutable as MUVector
import DataSketches.Quantiles.RelativeErrorQuantile.Internal.URef
import Data.Vector.Algorithms.Intro (sortByBounds)
import Data.Vector.Algorithms.Search
import GHC.Prim
import GHC.Stack
import System.IO.Unsafe ()
import qualified DataSketches.Quantiles.RelativeErrorQuantile.Internal.InequalitySearch as IS
import Control.Exception

-- | A special buffer of floats specifically designed to support the ReqCompactor class.
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
  }

instance TakeSnapshot DoubleBuffer where
  data Snapshot DoubleBuffer = DoubleBufferSnapshot
    { Snapshot DoubleBuffer -> Vector Double
dbSnapshotVec :: UVector.Vector Double
    , Snapshot DoubleBuffer -> Int
dbSnapshotCount :: !Int
    , Snapshot DoubleBuffer -> Bool
dbSnapshotSorted :: !Bool
    , Snapshot DoubleBuffer -> Int
dbSnapshotGrowthIncrement :: !Int
    , Snapshot DoubleBuffer -> Bool
dbSnapshotSpaceAtBottom :: !Bool
    }
  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 -> Snapshot DoubleBuffer
DoubleBufferSnapshot
    (Vector Double
 -> Int -> Bool -> Int -> Bool -> Snapshot DoubleBuffer)
-> m (Vector Double)
-> m (Int -> Bool -> Int -> Bool -> Snapshot DoubleBuffer)
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 -> Snapshot DoubleBuffer)
-> m Int -> m (Bool -> Int -> Bool -> Snapshot DoubleBuffer)
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 -> Snapshot DoubleBuffer)
-> m Bool -> m (Int -> Bool -> Snapshot DoubleBuffer)
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 -> Snapshot DoubleBuffer)
-> m Int -> m (Bool -> Snapshot DoubleBuffer)
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 -> Snapshot DoubleBuffer)
-> m Bool -> m (Snapshot DoubleBuffer)
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

deriving instance Show (Snapshot DoubleBuffer)

type Capacity = Int
type GrowthIncrement = Int
type SpaceAtBottom = Bool

-- | Constructs an new empty FloatBuffer with an initial capacity specified by
-- the <code>capacity</code> argument.
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
..}

-- | Appends the given item to the active array and increments the active count.
-- This will expand the array if necessary.
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 #-}

-- | Ensures that the capacity of this FloatBuffer is at least newCapacity.
-- If newCapacity &lt; capacity(), no action is taken.
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

-- data EvensOrOdds = Evens | Odds

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

-- | Sorts the active region
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 #-}

-- | Merges the incoming sorted buffer into this sorted buffer.
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 -- scan up, insert at bottom
      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
      Snapshot DoubleBuffer
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 -- scan down, insert at top
      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
          -- for loop ended
          | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
capacity_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          -- both valid
          | 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)
          -- i is valid
          | 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)
          -- j is valid
          | 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)
          -- neither is valid, break;
          | 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
      -- for loop ended
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      -- both valid
      | 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)
      -- neither is valid, break;
      | 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)