    {-# 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 :: forall (prim :: * -> *) container ty.
    (PrimMonad prim, RandomAccess container prim ty) =>
    (ty -> ty -> Ordering)
    -> Offset ty -> CountOf ty -> container -> prim ()
    inplaceSortBy ty -> ty -> Ordering
    ford Offset ty
    start CountOf ty
    len 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` Offset ty
    1)
        where
            qsort :: Offset ty -> Offset ty -> prim ()
    qsort Offset ty
    lo Offset ty
    hi
                | Offset ty
    lo Offset ty -> Offset ty -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Offset ty
    hi  = () -> prim ()
    forall a. a -> prim a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                | Bool
    otherwise = do
                    p <- Offset ty -> Offset ty -> prim (Offset ty)
    partition Offset ty
    lo Offset ty
    hi
                    qsort lo (pred p)
                    qsort (p+1) hi
            pivotStrategy :: Offset ty -> Offset ty -> prim ty
    pivotStrategy (Offset Int
    low) hi :: Offset ty
    hi@(Offset 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` Int
    2
                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
                read mvec hi >>= write mvec mid
                write mvec hi pivot -- move pivot @ pivotpos := hi
                pure pivot
            partition :: Offset ty -> Offset ty -> prim (Offset ty)
    partition Offset ty
    lo Offset ty
    hi = do
                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
    i Offset ty
    j = do
                        -- INVARIANT: k <= pivotpos
                        let fw :: Offset ty -> prim (Offset ty, ty)
    fw Offset ty
    k = do 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 ford ak pivot == LT
                                        then fw (k+1)
                                        else pure (k, ak)
                        (i, ai) <- Offset ty -> prim (Offset ty, ty)
    fw Offset ty
    i -- POST: ai >= pivot
                        -- INVARIANT: k >= i
                        let bw 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 a. a -> prim a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Offset ty
    i, ty
    ai)
                                 | Bool
    otherwise = do 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 ford ak pivot /= LT
                                                    then bw (pred k)
                                                    else pure (k, ak)
                        (j, aj) <- bw j -- POST: i==j OR (aj<pivot AND j<pivotpos)
                        -- POST: ai>=pivot AND (i==j OR aj<pivot AND (j<pivotpos))
                        if i < j
                            then do -- (ai>=p AND aj<p) AND (i<j<pivotpos)
                                -- swap two non-pivot elements and proceed
                                write mvec i aj
                                write mvec j ai
                                -- POST: (ai < pivot <= aj)
                                go (i+1) (pred j)
                            else do -- ai >= pivot
                                -- complete partitioning by swapping pivot to the center
                                write mvec hi ai
                                write mvec i pivot
                                pure i
                go lo hi
    {-# INLINE inplaceSortBy #-}