    {-# LANGUAGE MultiParamTypeClasses #-}
    module Basement.Alg.Mutable
        ( inplaceSortBy
        ) where

    import           GHC.Types
    import           GHC.Prim
    import           Basement.Compat.Base
    import           Basement.Numerical.Additive
    import           Basement.Numerical.Multiplicative
    import           Basement.Types.OffsetSize
    import           Basement.PrimType
    import           Basement.Monad
    import           Basement.Alg.Class

    inplaceSortBy :: (PrimMonad prim, RandomAccess container prim ty)
                  => (ty -> ty -> Ordering)
                  -- ^ Function defining the ordering relationship
                  -> (Offset ty) -- ^ Offset to first element to sort
                  -> (CountOf ty) -- ^ Number of elements to sort
                  -> container -- ^ Data to be sorted
                  -> prim ()
    inplaceSortBy :: (ty -> ty -> Ordering)
    -> Offset ty -> CountOf ty -> container -> prim ()
    inplaceSortBy ford :: ty -> ty -> Ordering
    ford start :: Offset ty
    start len :: CountOf ty
    len mvec :: container
    mvec
        = Offset ty -> Offset ty -> prim ()
    qsort Offset ty
    start (Offset ty
    start Offset ty -> CountOf ty -> Offset ty
    forall ty. Offset ty -> CountOf ty -> Offset ty
    `offsetPlusE` CountOf ty
    len Offset ty -> Offset ty -> Offset ty
    forall a. Offset a -> Offset a -> Offset a
    `offsetSub` 1)
        where
            qsort :: Offset ty -> Offset ty -> prim ()
    qsort lo :: Offset ty
    lo hi :: Offset ty
    hi
                | Offset ty
    lo Offset ty -> Offset ty -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Offset ty
    hi  = () -> prim ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                | Bool
    otherwise = do
                    Offset ty
    p <- Offset ty -> Offset ty -> prim (Offset ty)
    partition Offset ty
    lo Offset ty
    hi
                    Offset ty -> Offset ty -> prim ()
    qsort Offset ty
    lo (Offset ty -> Offset ty
    forall a. Enum a => a -> a
    pred Offset ty
    p)
                    Offset ty -> Offset ty -> prim ()
    qsort (Offset ty
    pOffset ty -> Offset ty -> Offset ty
    forall a. Additive a => a -> a -> a
    +1) Offset ty
    hi
            pivotStrategy :: Offset ty -> Offset ty -> prim ty
    pivotStrategy (Offset low :: Int
    low) hi :: Offset ty
    hi@(Offset high :: Int
    high) = do
                let mid :: Offset ty
    mid = Int -> Offset ty
    forall ty. Int -> Offset ty
    Offset (Int -> Offset ty) -> Int -> Offset ty
    forall a b. (a -> b) -> a -> b
    $ (Int
    low Int -> Int -> Int
    forall a. Additive a => a -> a -> a
    + Int
    high) Int -> Int -> Int
    forall a. IDivisible a => a -> a -> a
    `div` 2
                ty
    pivot <- container -> Offset ty -> prim ty
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> prim ty
    read container
    mvec Offset ty
    mid
                container -> Offset ty -> prim ty
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> prim ty
    read container
    mvec Offset ty
    hi prim ty -> (ty -> prim ()) -> prim ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= container -> Offset ty -> ty -> prim ()
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> ty -> prim ()
    write container
    mvec Offset ty
    mid
                container -> Offset ty -> ty -> prim ()
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> ty -> prim ()
    write container
    mvec Offset ty
    hi ty
    pivot -- move pivot @ pivotpos := hi
                ty -> prim ty
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ty
    pivot
            partition :: Offset ty -> Offset ty -> prim (Offset ty)
    partition lo :: Offset ty
    lo hi :: Offset ty
    hi = do
                ty
    pivot <- Offset ty -> Offset ty -> prim ty
    pivotStrategy Offset ty
    lo Offset ty
    hi
                -- RETURN: index of pivot with [<pivot | pivot | >=pivot]
                -- INVARIANT: i & j are valid array indices; pivotpos==hi
                let go :: Offset ty -> Offset ty -> prim (Offset ty)
    go i :: Offset ty
    i j :: Offset ty
    j = do
                        -- INVARIANT: k <= pivotpos
                        let fw :: Offset ty -> prim (Offset ty, ty)
    fw k :: Offset ty
    k = do ty
    ak <- container -> Offset ty -> prim ty
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> prim ty
    read container
    mvec Offset ty
    k
                                      if ty -> ty -> Ordering
    ford ty
    ak ty
    pivot Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ordering
    LT
                                        then Offset ty -> prim (Offset ty, ty)
    fw (Offset ty
    kOffset ty -> Offset ty -> Offset ty
    forall a. Additive a => a -> a -> a
    +1)
                                        else (Offset ty, ty) -> prim (Offset ty, ty)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Offset ty
    k, ty
    ak)
                        (i :: Offset ty
    i, ai :: ty
    ai) <- Offset ty -> prim (Offset ty, ty)
    fw Offset ty
    i -- POST: ai >= pivot
                        -- INVARIANT: k >= i
                        let bw :: Offset ty -> prim (Offset ty, ty)
    bw k :: Offset ty
    k | Offset ty
    kOffset ty -> Offset ty -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Offset ty
    i = (Offset ty, ty) -> prim (Offset ty, ty)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Offset ty
    i, ty
    ai)
                                 | Bool
    otherwise = do ty
    ak <- container -> Offset ty -> prim ty
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> prim ty
    read container
    mvec Offset ty
    k
                                                  if ty -> ty -> Ordering
    ford ty
    ak ty
    pivot Ordering -> Ordering -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Ordering
    LT
                                                    then Offset ty -> prim (Offset ty, ty)
    bw (Offset ty -> Offset ty
    forall a. Enum a => a -> a
    pred Offset ty
    k)
                                                    else (Offset ty, ty) -> prim (Offset ty, ty)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Offset ty
    k, ty
    ak)
                        (j :: Offset ty
    j, aj :: ty
    aj) <- Offset ty -> prim (Offset ty, ty)
    bw Offset ty
    j -- POST: i==j OR (aj<pivot AND j<pivotpos)
                        -- POST: ai>=pivot AND (i==j OR aj<pivot AND (j<pivotpos))
                        if Offset ty
    i Offset ty -> Offset ty -> Bool
    forall a. Ord a => a -> a -> Bool
    < Offset ty
    j
                            then do -- (ai>=p AND aj<p) AND (i<j<pivotpos)
                                -- swap two non-pivot elements and proceed
                                container -> Offset ty -> ty -> prim ()
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> ty -> prim ()
    write container
    mvec Offset ty
    i ty
    aj
                                container -> Offset ty -> ty -> prim ()
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> ty -> prim ()
    write container
    mvec Offset ty
    j ty
    ai
                                -- POST: (ai < pivot <= aj)
                                Offset ty -> Offset ty -> prim (Offset ty)
    go (Offset ty
    iOffset ty -> Offset ty -> Offset ty
    forall a. Additive a => a -> a -> a
    +1) (Offset ty -> Offset ty
    forall a. Enum a => a -> a
    pred Offset ty
    j)
                            else do -- ai >= pivot
                                -- complete partitioning by swapping pivot to the center
                                container -> Offset ty -> ty -> prim ()
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> ty -> prim ()
    write container
    mvec Offset ty
    hi ty
    ai
                                container -> Offset ty -> ty -> prim ()
    forall container (prim :: * -> *) ty.
    RandomAccess container prim ty =>
    container -> Offset ty -> ty -> prim ()
    write container
    mvec Offset ty
    i ty
    pivot
                                Offset ty -> prim (Offset ty)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Offset ty
    i
                Offset ty -> Offset ty -> prim (Offset ty)
    go Offset ty
    lo Offset ty
    hi
    {-# INLINE inplaceSortBy #-}