From 80bb471767f67bc9718d0411f5f413e64740d851 Mon Sep 17 00:00:00 2001
From: toyboot4e <toyboot4e@gmail.com>
Date: Sun, 2 Feb 2025 15:25:42 +0900
Subject: [PATCH 1/2] Add `INLINE` to `nub` functions

`nubMutBy` is marked as `INLINABLE`, but change it if `INLINE` is
faster
---
 src/Data/Vector/Algorithms.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Data/Vector/Algorithms.hs b/src/Data/Vector/Algorithms.hs
index 4041a2a..d0948ca 100644
--- a/src/Data/Vector/Algorithms.hs
+++ b/src/Data/Vector/Algorithms.hs
@@ -18,6 +18,7 @@ import qualified Data.Vector.Algorithms.Search  as S
 -- | The `nub` function which removes duplicate elements from a vector.
 nub :: forall v e . (V.Vector v e, Ord e) => v e -> v e
 nub = nubBy compare
+{-# INLINE nub #-}
 
 -- | A version of `nub` with a custom comparison predicate.
 --
@@ -31,6 +32,7 @@ nubBy cmp vec = runST $ do
   destMV <- nubByMut sortUniqBy cmp mv
   v <- V.unsafeFreeze destMV
   pure (V.force v)
+{-# INLINE nubBy #-}
 
 -- | The `nubByMut` function takes in an in-place sort algorithm
 -- and uses it to do a de-deduplicated sort. It then uses this to
@@ -72,3 +74,4 @@ nubByMut alg cmp inp = do
               go (srcInd + 1) (destInd + 1)
   go 0 0
   pure dest
+{-# INLINABLE nubByMut #-}

From 05296e78da411ddf7edb73ed33a0c8f90f0bdb4a Mon Sep 17 00:00:00 2001
From: toyboot4e <toyboot4e@gmail.com>
Date: Sun, 2 Feb 2025 15:26:39 +0900
Subject: [PATCH 2/2] Fix to use `INLINE` for `sort` and `sortUniq`

---
 src/Data/Vector/Algorithms/AmericanFlag.hs | 4 ++--
 src/Data/Vector/Algorithms/Heap.hs         | 4 ++--
 src/Data/Vector/Algorithms/Insertion.hs    | 4 ++--
 src/Data/Vector/Algorithms/Intro.hs        | 4 ++--
 src/Data/Vector/Algorithms/Merge.hs        | 4 ++--
 src/Data/Vector/Algorithms/Radix.hs        | 2 +-
 src/Data/Vector/Algorithms/Tim.hs          | 4 ++--
 7 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/Data/Vector/Algorithms/AmericanFlag.hs b/src/Data/Vector/Algorithms/AmericanFlag.hs
index 478d4df..4463b91 100644
--- a/src/Data/Vector/Algorithms/AmericanFlag.hs
+++ b/src/Data/Vector/Algorithms/AmericanFlag.hs
@@ -244,7 +244,7 @@ sort :: forall e m v. (PrimMonad m, MVector v e, Lexicographic e, Ord e)
 sort v = sortBy compare terminate (size p) index v
  where p :: Proxy e
        p = Proxy
-{-# INLINABLE sort #-}
+{-# INLINE sort #-}
 
 -- | A variant on `sort` that returns a vector of unique elements.
 sortUniq :: forall e m v. (PrimMonad m, MVector v e, Lexicographic e, Ord e)
@@ -252,7 +252,7 @@ sortUniq :: forall e m v. (PrimMonad m, MVector v e, Lexicographic e, Ord e)
 sortUniq v = sortUniqBy compare terminate (size p) index v
  where p :: Proxy e
        p = Proxy
-{-# INLINABLE sortUniq #-}
+{-# INLINE sortUniq #-}
 
 -- | A fully parameterized version of the sorting algorithm. Again, this
 -- function takes both radix information and a comparison, because the
diff --git a/src/Data/Vector/Algorithms/Heap.hs b/src/Data/Vector/Algorithms/Heap.hs
index 7f15c43..a5b6254 100644
--- a/src/Data/Vector/Algorithms/Heap.hs
+++ b/src/Data/Vector/Algorithms/Heap.hs
@@ -56,12 +56,12 @@ import qualified Data.Vector.Algorithms.Optimal as O
 -- | Sorts an entire array using the default ordering.
 sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
 sort = sortBy compare
-{-# INLINABLE sort #-}
+{-# INLINE sort #-}
 
 -- | A variant on `sort` that returns a vector of unique elements.
 sortUniq :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m (v (PrimState m) e)
 sortUniq = sortUniqBy compare
-{-# INLINABLE sortUniq #-}
+{-# INLINE sortUniq #-}
 
 -- | Sorts an entire array using a custom ordering.
 sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m ()
diff --git a/src/Data/Vector/Algorithms/Insertion.hs b/src/Data/Vector/Algorithms/Insertion.hs
index b3ff189..f65cbaa 100644
--- a/src/Data/Vector/Algorithms/Insertion.hs
+++ b/src/Data/Vector/Algorithms/Insertion.hs
@@ -36,12 +36,12 @@ import qualified Data.Vector.Algorithms.Optimal as O
 -- | Sorts an entire array using the default comparison for the type
 sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
 sort = sortBy compare
-{-# INLINABLE sort #-}
+{-# INLINE sort #-}
 
 -- | A variant on `sort` that returns a vector of unique elements.
 sortUniq :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m (v (PrimState m) e)
 sortUniq = sortUniqBy compare
-{-# INLINABLE sortUniq #-}
+{-# INLINE sortUniq #-}
 
 -- | Sorts an entire array using a given comparison
 sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m ()
diff --git a/src/Data/Vector/Algorithms/Intro.hs b/src/Data/Vector/Algorithms/Intro.hs
index 465d61f..a50d7ff 100644
--- a/src/Data/Vector/Algorithms/Intro.hs
+++ b/src/Data/Vector/Algorithms/Intro.hs
@@ -67,12 +67,12 @@ import qualified Data.Vector.Algorithms.Heap      as H
 -- | Sorts an entire array using the default ordering.
 sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
 sort = sortBy compare
-{-# INLINABLE sort #-}
+{-# INLINE sort #-}
 
 -- | A variant on `sort` that returns a vector of unique elements.
 sortUniq :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m (v (PrimState m) e)
 sortUniq = sortUniqBy compare
-{-# INLINABLE sortUniq #-}
+{-# INLINE sortUniq #-}
 
 -- | A variant on `sortBy` which returns a vector of unique elements.
 sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m ()
diff --git a/src/Data/Vector/Algorithms/Merge.hs b/src/Data/Vector/Algorithms/Merge.hs
index 417988f..7fcc595 100644
--- a/src/Data/Vector/Algorithms/Merge.hs
+++ b/src/Data/Vector/Algorithms/Merge.hs
@@ -37,12 +37,12 @@ import qualified Data.Vector.Algorithms.Insertion as I
 -- | Sorts an array using the default comparison.
 sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
 sort = sortBy compare
-{-# INLINABLE sort #-}
+{-# INLINE sort #-}
 
 -- | A variant on `sort` that returns a vector of unique elements.
 sortUniq :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m (v (PrimState m) e)
 sortUniq = sortUniqBy compare
-{-# INLINABLE sortUniq #-}
+{-# INLINE sortUniq #-}
 
 -- | Sorts an array using a custom comparison.
 sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m ()
diff --git a/src/Data/Vector/Algorithms/Radix.hs b/src/Data/Vector/Algorithms/Radix.hs
index 5579dab..5913f90 100644
--- a/src/Data/Vector/Algorithms/Radix.hs
+++ b/src/Data/Vector/Algorithms/Radix.hs
@@ -186,7 +186,7 @@ sort arr = sortBy (passes e) (size e) radix arr
  where
  e :: e
  e = undefined
-{-# INLINABLE sort #-}
+{-# INLINE sort #-}
 
 -- | Radix sorts an array using custom radix information
 -- requires the number of passes to fully sort the array,
diff --git a/src/Data/Vector/Algorithms/Tim.hs b/src/Data/Vector/Algorithms/Tim.hs
index 0ab3ef2..dc8d370 100644
--- a/src/Data/Vector/Algorithms/Tim.hs
+++ b/src/Data/Vector/Algorithms/Tim.hs
@@ -113,12 +113,12 @@ import Data.Vector.Algorithms.Common (uniqueMutableBy)
 -- | Sorts an array using the default comparison.
 sort :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m ()
 sort = sortBy compare
-{-# INLINABLE sort #-}
+{-# INLINE sort #-}
 
 -- | A variant on `sort` that returns a vector of unique elements.
 sortUniq :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> m (v (PrimState m) e)
 sortUniq = sortUniqBy compare
-{-# INLINABLE sortUniq #-}
+{-# INLINE sortUniq #-}
 
 -- | Sorts an array using a custom comparison.
 sortBy :: (PrimMonad m, MVector v e)