primitive-sort 0.1.1.0 → 0.1.2.0

raw patch · 5 files changed

+214/−93 lines, 5 filesdep ~contiguousdep ~gaugedep ~primitivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: contiguous, gauge, primitive

API changes (from Hackage documentation)

Files

• README.md +29/−1
• bench/Main.hs +13/−2
• primitive-sort.cabal +19/−19
• src/Data/Primitive/Sort.hs +127/−40
• test/Main.hs +26/−31

@@ -1,3 +1,31 @@ # primitive-sort -sorting of contiguous data structures.+Sorting of contiguous data structures. Implementation uses mergesort+and switches to insertion sort once the arrays are small. Some of the+benchmark results on a Intel Xeon CPU E3-1505M v5 2.80GHz (GHC 8.10.4):++    contiguous/Int8/unsorted/mini      time  91.59 ns  +    contiguous/Int8/unsorted/tiny      time  1.236 μs  +    contiguous/Int8/unsorted/small     time  40.68 μs  +    contiguous/Int8/unsorted/medium    time  614.1 μs  +    contiguous/Int8/unsorted/large     time  6.580 ms  +    contiguous/Int8/unsorted/gigantic  time  68.16 ms  ++Results may vary across processors, but you observe results that are 10x+slower, it's probably an issue with the compiler, and please open an issue.++## GHC Specialization Problems++Sadly, the most permissive signature for `sort` causes GHC's specialization+to break. This permissive signature is:++    sort :: (Contiguous arr, Element arr a, Ord a) => arr a -> arr a++And the less permissive variant used by this library is:++    sort :: (Prim a, Ord a) => PrimArray a -> PrimArray a++The latter works nicely with `SPECIALIZE` and `INLINEABLE`, but the former+does not work at all with these. The issue is believed to be related to the+use of an associated constraint type `Element`, which introduced coercions+that might confuse the specializer. However, this has not been confirmed.

@@ -20,8 +20,8 @@ main :: IO () main = defaultMain   [ bgroup "contiguous"-    [ benchType (typeRep :: TypeRep Int8) (primArrayToByteArray . Data.Primitive.Sort.sort @PrimArray @Int8 . byteArrayToPrimArray)-    , benchType (typeRep :: TypeRep Word) (primArrayToByteArray . Data.Primitive.Sort.sort @PrimArray @Word . byteArrayToPrimArray)+    [ benchType (typeRep :: TypeRep Int8) (primArrayToByteArray . sortInt8 . byteArrayToPrimArray)+    , benchType (typeRep :: TypeRep Word) (primArrayToByteArray . sortWord . byteArrayToPrimArray)     ]   , bgroup "tagged-unique"     [ bench "mini" (whnf (\(k,v) -> evalPair (Data.Primitive.Sort.sortUniqueTagged k v)) (sizedInts Mini, sizedInts Mini))@@ -29,6 +29,17 @@     , bench "small" (whnf (\(k,v) -> evalPair (Data.Primitive.Sort.sortUniqueTagged k v)) (sizedInts Small, sizedInts Small))     ]   ]++-- It is useful to have this here with inlining disabled because it+-- makes it easy to inspect Core to see if GHC's specialization is+-- working like we expect it to.+sortInt8 :: PrimArray Int8 -> PrimArray Int8+{-# noinline sortInt8 #-}+sortInt8 !x = Data.Primitive.Sort.sort @Int8 x++sortWord :: PrimArray Word -> PrimArray Word+{-# noinline sortWord #-}+sortWord !x = Data.Primitive.Sort.sort @Word x  evalPair :: (PrimArray a, PrimArray b) -> () evalPair (!_,!_) = ()

@@ -1,10 +1,9 @@ cabal-version: 2.2 name: primitive-sort-version: 0.1.1.0+version: 0.1.2.0 synopsis: Sort primitive arrays description:   This library provides a stable sorting algorithm for primitive arrays.-  When extra capabilities are available, the sort is parallelized.   .   The algorithm currently uses mergesort on large chunks and switches   to insertion sort on small chunks. The are also novel improvements@@ -28,7 +27,7 @@     , ghc-prim     , contiguous >= 0.6 && < 0.7     , primitive >= 0.6.4 && < 0.8-  ghc-options: -O2+  ghc-options: -O2 -Wall   default-language: Haskell2010  test-suite test@@ -36,18 +35,18 @@   hs-source-dirs: test   main-is: Main.hs   build-depends:-      base+    , HUnit+    , QuickCheck+    , base+    , containers+    , primitive     , primitive-sort+    , smallcheck     , tasty     , tasty-hunit-    , tasty-smallcheck     , tasty-quickcheck-    , primitive-    , containers-    , smallcheck-    , QuickCheck-    , HUnit-  ghc-options: -threaded -rtsopts -O2 -with-rtsopts=-N+    , tasty-smallcheck+  ghc-options: -threaded -rtsopts -O2 -with-rtsopts=-N1   default-language: Haskell2010  test-suite doctest@@ -55,22 +54,23 @@   hs-source-dirs: test   main-is: Doctest.hs   build-depends:-      base-    , primitive-sort-    , doctest >= 0.10     , QuickCheck+    , base+    , doctest >= 0.10+    , primitive-sort   default-language: Haskell2010  benchmark bench   type: exitcode-stdio-1.0   build-depends:-      base+    , base+    , contiguous+    , gauge >=0.2.5+    , ghc-prim+    , primitive     , primitive-sort-    , gauge     , random-    , primitive-    , ghc-prim-  ghc-options: -threaded -rtsopts -O2 -with-rtsopts=-N+  ghc-options: -threaded -rtsopts -O2 -with-rtsopts=-N1   default-language: Haskell2010   hs-source-dirs: bench   main-is: Main.hs

@@ -3,10 +3,9 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UnboxedTuples #-} -{-# OPTIONS_GHC -Wall #-}- -- | Sort primitive arrays with a stable sorting algorithm. All functions -- in this module are marked as @INLINABLE@, so they will specialize -- when used in a monomorphic setting.@@ -27,17 +26,31 @@ import Control.Applicative import GHC.Int (Int(..)) import GHC.Prim+import Data.Word+import Data.Int import Data.Primitive.Contiguous (Contiguous,ContiguousU,Mutable,Element)+import Data.Primitive (Prim,PrimArray,MutablePrimArray) import qualified Data.Primitive.Contiguous as C  -- | Sort an immutable array. Duplicate elements are preserved. -- -- >>> sort ([5,6,7,9,5,4,5,7] :: Array Int) -- fromListN 8 [4,5,5,5,6,7,7,9]-sort :: (Contiguous arr, Element arr a, Ord a)-  => arr a-  -> arr a-{-# INLINE sort #-}+sort :: (Prim a, Ord a)+  => C.PrimArray a+  -> C.PrimArray a+{-# inlineable sort #-}+{-# specialize sort :: C.PrimArray Double -> C.PrimArray Double #-}+{-# specialize sort :: C.PrimArray Int -> C.PrimArray Int #-}+{-# specialize sort :: C.PrimArray Int64 -> C.PrimArray Int64 #-}+{-# specialize sort :: C.PrimArray Int32 -> C.PrimArray Int32 #-}+{-# specialize sort :: C.PrimArray Int16 -> C.PrimArray Int16 #-}+{-# specialize sort :: C.PrimArray Int8 -> C.PrimArray Int8 #-}+{-# specialize sort :: C.PrimArray Word -> C.PrimArray Word #-}+{-# specialize sort :: C.PrimArray Word64 -> C.PrimArray Word64 #-}+{-# specialize sort :: C.PrimArray Word32 -> C.PrimArray Word32 #-}+{-# specialize sort :: C.PrimArray Word16 -> C.PrimArray Word16 #-}+{-# specialize sort :: C.PrimArray Word8 -> C.PrimArray Word8 #-} sort !src = runST $ do   let len = C.size src   dst <- C.new (C.size src)@@ -61,7 +74,7 @@   => karr k -- ^ keys   -> varr v -- ^ values   -> (karr k,varr v)-{-# INLINE sortTagged #-}+{-# inlineable sortTagged #-} sortTagged !src !srcTags = runST $ do   let len = min (C.size src) (C.size srcTags)   dst <- C.new len@@ -85,7 +98,7 @@   => karr k -- ^ keys   -> varr v -- ^ values   -> (karr k,varr v)-{-# INLINE sortUniqueTagged #-}+{-# inlineable sortUniqueTagged #-} sortUniqueTagged !src !srcTags = runST $ do   let len = min (C.size src) (C.size srcTags)   dst <- C.new len@@ -102,10 +115,21 @@ -- elements. The argument may either be modified in-place, or another -- array may be allocated and returned. The argument -- may not be reused after being passed to this function.-sortMutable :: (Contiguous arr, Element arr a, Ord a)-  => Mutable arr s a-  -> ST s (Mutable arr s a)-{-# INLINE sortMutable #-}+sortMutable :: (Prim a, Ord a)+  => MutablePrimArray s a+  -> ST s (MutablePrimArray s a)+{-# inlineable sortMutable #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Double -> ST s (C.MutablePrimArray s Double) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int -> ST s (C.MutablePrimArray s Int) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int64 -> ST s (C.MutablePrimArray s Int64) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int32 -> ST s (C.MutablePrimArray s Int32) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int16 -> ST s (C.MutablePrimArray s Int16) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Int8 -> ST s (C.MutablePrimArray s Int8) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word -> ST s (C.MutablePrimArray s Word) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word64 -> ST s (C.MutablePrimArray s Word64) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word32 -> ST s (C.MutablePrimArray s Word32) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word16 -> ST s (C.MutablePrimArray s Word16) #-}+{-# specialize sortMutable :: forall s. C.MutablePrimArray s Word8 -> ST s (C.MutablePrimArray s Word8) #-} sortMutable !dst = do   len <- C.sizeMut dst   if len < threshold@@ -124,7 +148,7 @@   => Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINE sortTaggedMutable #-}+{-# inlineable sortTaggedMutable #-} sortTaggedMutable !dst0 !dstTags0 = do   (!dst,!dstTags,!len) <- alignArrays dst0 dstTags0   sortTaggedMutableN len dst dstTags@@ -133,7 +157,7 @@   => Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v,Int)-{-# INLINE alignArrays #-}+{-# inlineable alignArrays #-} alignArrays dst0 dstTags0 = do   lenDst <- C.sizeMut dst0   lenDstTags <- C.sizeMut dstTags0@@ -152,7 +176,7 @@   => Mutable karr s k -- ^ keys   -> Mutable varr s v -- ^ values   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINE sortUniqueTaggedMutable #-}+{-# inlineable sortUniqueTaggedMutable #-} sortUniqueTaggedMutable dst0 dstTags0 = do   (!dst1,!dstTags1,!len) <- alignArrays dst0 dstTags0   (!dst2,!dstTags2) <- sortTaggedMutableN len dst1 dstTags1@@ -163,7 +187,7 @@   -> Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINE sortTaggedMutableN #-}+{-# inlineable sortTaggedMutableN #-} sortTaggedMutableN !len !dst !dstTags = if len < thresholdTagged   then do     insertionSortTaggedRange dst dstTags 0 len@@ -179,9 +203,19 @@ -- -- >>> sortUnique ([5,6,7,9,5,4,5,7] :: Array Int) -- fromListN 5 [4,5,6,7,9]-sortUnique :: (ContiguousU arr, Element arr a, Ord a)-  => arr a -> arr a-{-# INLINE sortUnique #-}+sortUnique :: (Prim a, Ord a) => PrimArray a -> PrimArray a+{-# inlineable sortUnique #-}+{-# specialize sortUnique :: C.PrimArray Double -> C.PrimArray Double #-}+{-# specialize sortUnique :: C.PrimArray Int -> C.PrimArray Int #-}+{-# specialize sortUnique :: C.PrimArray Int64 -> C.PrimArray Int64 #-}+{-# specialize sortUnique :: C.PrimArray Int32 -> C.PrimArray Int32 #-}+{-# specialize sortUnique :: C.PrimArray Int16 -> C.PrimArray Int16 #-}+{-# specialize sortUnique :: C.PrimArray Int8 -> C.PrimArray Int8 #-}+{-# specialize sortUnique :: C.PrimArray Word -> C.PrimArray Word #-}+{-# specialize sortUnique :: C.PrimArray Word64 -> C.PrimArray Word64 #-}+{-# specialize sortUnique :: C.PrimArray Word32 -> C.PrimArray Word32 #-}+{-# specialize sortUnique :: C.PrimArray Word16 -> C.PrimArray Word16 #-}+{-# specialize sortUnique :: C.PrimArray Word8 -> C.PrimArray Word8 #-} sortUnique src = runST $ do   let len = C.size src   dst <- C.new len@@ -193,10 +227,21 @@ -- element is preserved. This operation may run in-place, or it may -- need to allocate a new array, so the argument may not be reused -- after this function is applied to it. -sortUniqueMutable :: (ContiguousU arr, Element arr a, Ord a)-  => Mutable arr s a-  -> ST s (Mutable arr s a)-{-# INLINE sortUniqueMutable #-}+sortUniqueMutable :: forall s a. (Prim a, Ord a)+  => MutablePrimArray s a+  -> ST s (MutablePrimArray s a)+{-# inlineable sortUniqueMutable #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Double -> ST s (C.MutablePrimArray s Double) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int -> ST s (C.MutablePrimArray s Int) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int64 -> ST s (C.MutablePrimArray s Int64) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int32 -> ST s (C.MutablePrimArray s Int32) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int16 -> ST s (C.MutablePrimArray s Int16) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Int8 -> ST s (C.MutablePrimArray s Int8) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word -> ST s (C.MutablePrimArray s Word) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word64 -> ST s (C.MutablePrimArray s Word64) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word32 -> ST s (C.MutablePrimArray s Word32) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word16 -> ST s (C.MutablePrimArray s Word16) #-}+{-# specialize sortUniqueMutable :: forall s. C.MutablePrimArray s Word8 -> ST s (C.MutablePrimArray s Word8) #-} sortUniqueMutable marr = do   res <- sortMutable marr   uniqueMutable res@@ -206,7 +251,7 @@ -- argument may not be reused after this function is applied to it. uniqueMutable :: forall arr s a. (ContiguousU arr, Element arr a, Eq a)   => Mutable arr s a -> ST s (Mutable arr s a)-{-# INLINE uniqueMutable #-}+{-# inlineable uniqueMutable #-} uniqueMutable !marr = do   !len <- C.sizeMut marr   if len > 1@@ -244,7 +289,7 @@   -> Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINE uniqueTaggedMutableN #-}+{-# inlineable uniqueTaggedMutableN #-} uniqueTaggedMutableN !len !marr !marrTags = if len > 1   then do     !a0 <- C.read marr 0@@ -279,13 +324,24 @@         liftA2 (,) (C.resize marr reducedLen) (C.resize marrTags reducedLen)   else return (marr,marrTags) -splitMerge :: forall arr s a. (Contiguous arr, Element arr a, Ord a)-  => Mutable arr s a -- source and destination-  -> Mutable arr s a -- work array+splitMerge :: forall s a. (Prim a, Ord a)+  => MutablePrimArray s a -- source and destination+  -> MutablePrimArray s a -- work array   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINE splitMerge #-}+{-# inlineable splitMerge #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Double -> C.MutablePrimArray s Double -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int -> C.MutablePrimArray s Int -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int64 -> C.MutablePrimArray s Int64 -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int32 -> C.MutablePrimArray s Int32 -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int16 -> C.MutablePrimArray s Int16 -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Int8 -> C.MutablePrimArray s Int8 -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word -> C.MutablePrimArray s Word -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word64 -> C.MutablePrimArray s Word64 -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word32 -> C.MutablePrimArray s Word32 -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word16 -> C.MutablePrimArray s Word16 -> Int -> Int -> ST s () #-}+{-# specialize splitMerge :: forall s. C.MutablePrimArray s Word8 -> C.MutablePrimArray s Word8 -> Int -> Int -> ST s () #-} splitMerge !arr !work !start !end = if end - start < 2   then return ()   else if end - start > threshold@@ -304,7 +360,7 @@   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINE splitMergeTagged #-}+{-# inlineable splitMergeTagged #-} splitMergeTagged !arr !work !arrTags !workTags !start !end = if end - start < 2   then return ()   else if end - start > thresholdTagged@@ -317,7 +373,7 @@  unsafeQuot :: Int -> Int -> Int unsafeQuot (I# a) (I# b) = I# (quotInt# a b)-{-# INLINE unsafeQuot #-}+{-# inline unsafeQuot #-}  -- stepA assumes that we previously incremented ixA. -- Consequently, we do not need to check that ixB@@ -332,7 +388,17 @@   -> Int -- end B   -> Int -- start destination   -> ST s ()-{-# INLINE mergeNonContiguous #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Double -> C.MutablePrimArray s Double -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int -> C.MutablePrimArray s Int -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int64 -> C.MutablePrimArray s Int64 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int32 -> C.MutablePrimArray s Int32 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int16 -> C.MutablePrimArray s Int16 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Int8 -> C.MutablePrimArray s Int8 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word -> C.MutablePrimArray s Word -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word64 -> C.MutablePrimArray s Word64 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word32 -> C.MutablePrimArray s Word32 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word16 -> C.MutablePrimArray s Word16 -> Int -> Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize mergeNonContiguous :: forall s. C.MutablePrimArray s Word8 -> C.MutablePrimArray s Word8 -> Int -> Int -> Int -> Int -> Int -> ST s () #-} mergeNonContiguous !src !dst !startA !endA !startB !endB !startDst =   if startB < endB     then stepA startA startB startDst@@ -341,7 +407,7 @@       else return ()   where   continue :: Int -> Int -> Int -> ST s ()-  continue ixA ixB ixDst = do+  continue !ixA !ixB !ixDst = do     !a <- C.read src ixA     !b <- C.read src ixB     if (a :: a) <= b@@ -375,7 +441,7 @@   -> Int -- end B   -> Int -- start destination   -> ST s ()-{-# INLINE mergeNonContiguousTagged #-}+{-# inlineable mergeNonContiguousTagged #-} mergeNonContiguousTagged !src !dst !srcTags !dstTags !startA !endA !startB !endB !startDst =   if startB < endB     then stepA startA startB startDst@@ -419,12 +485,23 @@ thresholdTagged :: Int thresholdTagged = 16 -insertionSortRange :: forall arr s a. (Contiguous arr, Element arr a, Ord a)-  => Mutable arr s a+insertionSortRange :: forall s a. (Prim a, Ord a)+  => MutablePrimArray s a   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINE insertionSortRange #-}+{-# inlineable insertionSortRange #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Double -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int64 -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int32 -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int16 -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Int8 -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word64 -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word32 -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word16 -> Int -> Int -> ST s () #-}+{-# specialize insertionSortRange :: forall s. C.MutablePrimArray s Word8 -> Int -> Int -> ST s () #-} insertionSortRange !arr !start !end = go start   where   go :: Int -> ST s ()@@ -441,7 +518,17 @@   -> Int   -> Int   -> ST s ()-{-# INLINE insertElement #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Double -> Double -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Int -> Int -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Int64 -> Int64 -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Int32 -> Int32 -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Int16 -> Int16 -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Int8 -> Int8 -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Word -> Word -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Word64 -> Word64 -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Word32 -> Word32 -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Word16 -> Word16 -> Int -> Int -> ST s () #-}+{-# specialize insertElement :: forall s. C.MutablePrimArray s Word8 -> Word8 -> Int -> Int -> ST s () #-} insertElement !arr !a !start !end = go end   where   go :: Int -> ST s ()@@ -463,7 +550,7 @@   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINE insertionSortTaggedRange #-}+{-# inlineable insertionSortTaggedRange #-} insertionSortTaggedRange !karr !varr !start !end = go start   where   go :: Int -> ST s ()@@ -483,7 +570,7 @@   -> Int   -> Int   -> ST s ()-{-# INLINE insertElementTagged #-}+{-# inlineable insertElementTagged #-} insertElementTagged !karr !varr !a !v !start !end = go end   where   go :: Int -> ST s ()

@@ -8,63 +8,58 @@  {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +import Test.HUnit.Base ((@?=))+import Test.QuickCheck as Q+import Test.SmallCheck.Series (Serial(..)) import Test.Tasty import Test.Tasty.HUnit (testCase)-import Test.Tasty.SmallCheck as SC import Test.Tasty.QuickCheck as QC-import Test.QuickCheck as Q-import qualified Test.QuickCheck.Property as QP-import Type.Reflection (TypeRep,typeRep)-import qualified Test.SmallCheck.Series as SCS-import Test.HUnit.Base ((@?=))+import Test.Tasty.SmallCheck as SC -import Data.List-import Data.Word-import Data.Int-import Data.Primitive (ByteArray,Prim)-import Data.Proxy (Proxy(..))-import Control.Monad.ST (ST,runST)-import Test.SmallCheck.Series (Serial(..),Series)-import Control.Exception (Exception,toException) import Control.Applicative (liftA2)+import Control.Exception (Exception,toException)+import Control.Monad.ST (ST,runST)+import Data.Int+import Data.List import Data.Primitive (ByteArray(..),PrimArray(..),Prim,Array)+import Data.Proxy (Proxy(..))+import Data.Word+import Type.Reflection (TypeRep,typeRep) -import qualified GHC.Exts as E-import qualified GHC.OldList as L-import qualified Data.Set as S import qualified Data.Map as M import qualified Data.Primitive as P import qualified Data.Primitive.Sort--- import qualified Sort.Merge.Int8--- import qualified Sort.Merge.Word16--- import qualified Sort.Merge.Word+import qualified Data.Set as S+import qualified GHC.Exts as E+import qualified GHC.OldList as L+import qualified Test.QuickCheck.Property as QP  main :: IO () main = defaultMain $ testGroup "Sort"   [ testGroup "Contiguous"-    [ tests (typeRep :: TypeRep Int8) (primArrayToByteArray . Data.Primitive.Sort.sort @PrimArray @Int8 . byteArrayToPrimArray)-    , tests (typeRep :: TypeRep Word) (primArrayToByteArray . Data.Primitive.Sort.sort @PrimArray @Word . byteArrayToPrimArray)+    [ tests (typeRep :: TypeRep Int8) (primArrayToByteArray . Data.Primitive.Sort.sort @Int8 . byteArrayToPrimArray)+    , tests (typeRep :: TypeRep Word) (primArrayToByteArray . Data.Primitive.Sort.sort @Word . byteArrayToPrimArray)     , SC.testProperty "sortUnique == Set.toList . Set.fromList" $ \(list :: [Int]) ->-        let actual = E.toList (Data.Primitive.Sort.sortUnique (E.fromList list :: Array Int))+        let actual = E.toList (Data.Primitive.Sort.sortUnique (E.fromList list :: PrimArray Int))             expected = S.toList (S.fromList list)          in if actual == expected               then Right "unused"               else Left ("expected " ++ show expected ++ " but got " ++ show actual)     , testCase "sortTagged" $         Data.Primitive.Sort.sortTagged-          (E.fromList [2, 1, 0] :: Array Int)-          (E.fromList [True, True, False] :: Array Bool)+          (E.fromList [2, 1, 0] :: PrimArray Int)+          (E.fromList [1, 1, 0] :: PrimArray Word8)         @?=-        (E.fromList [0,1,2], E.fromList [False,True,True] :: Array Bool)+        (E.fromList [0,1,2], E.fromList [0,1,1] :: PrimArray Word8)     , testCase "sortUniqueTagged" $         Data.Primitive.Sort.sortUniqueTagged           (E.fromList [2, 1, 0] :: Array Int)-          (E.fromList [True, True, False] :: Array Bool)+          (E.fromList [1, 1, 0] :: PrimArray Word8)         @?=-        (E.fromList [0,1,2], E.fromList [False,True,True] :: Array Bool)-    , SC.testProperty "sortUniqueTagged == Map.toList . Map.fromList" $ \(list :: [(Int,Bool)]) ->-        let keys = E.fromList (map fst list) :: Array Int-            vals = E.fromList (map snd list) :: Array Bool+        (E.fromList [0,1,2], E.fromList [0,1,1] :: PrimArray Word8)+    , SC.testProperty "sortUniqueTagged == Map.toList . Map.fromList" $ \(list :: [(Int,Word8)]) ->+        let keys = E.fromList (map fst list) :: PrimArray Int+            vals = E.fromList (map snd list) :: PrimArray Word8             (actualKeys,actualVals) = Data.Primitive.Sort.sortUniqueTagged keys vals             actual = zip (E.toList actualKeys) (E.toList actualVals)             expected = M.toList (M.fromList list)