primitive-sort 0.1.0.0 → 0.1.1.0

raw patch · 3 files changed

+66/−347 lines, 3 filesdep ~contiguousdep ~primitivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: contiguous, primitive

API changes (from Hackage documentation)

Files

• README.md +3/−1
• primitive-sort.cabal +6/−6
• src/Data/Primitive/Sort.hs +57/−340

@@ -1,1 +1,3 @@-# mergesort+# primitive-sort++sorting of contiguous data structures.

@@ -1,6 +1,6 @@-cabal-version: 2.0+cabal-version: 2.2 name: primitive-sort-version: 0.1.0.0+version: 0.1.1.0 synopsis: Sort primitive arrays description:   This library provides a stable sorting algorithm for primitive arrays.@@ -10,7 +10,7 @@   to insertion sort on small chunks. The are also novel improvements   to increase the performance if the input array is already mostly sorted. homepage: https://github.com/andrewthad/primitive-sort-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Andrew Martin maintainer: andrew.thaddeus@gmail.com@@ -24,10 +24,10 @@   exposed-modules:     Data.Primitive.Sort   build-depends:-      base >= 0.4.9 && < 5-    , primitive >= 0.6.4.0+    , base >= 0.4.9 && < 5     , ghc-prim-    , contiguous >= 0.1 && < 0.2+    , contiguous >= 0.6 && < 0.7+    , primitive >= 0.6.4 && < 0.8   ghc-options: -O2   default-language: Haskell2010 

@@ -25,13 +25,9 @@  import Control.Monad.ST import Control.Applicative-import GHC.ST (ST(..))-import GHC.IO (IO(..)) import GHC.Int (Int(..))-import Control.Monad import GHC.Prim-import Control.Concurrent (getNumCapabilities)-import Data.Primitive.Contiguous (Contiguous,Mutable,Element)+import Data.Primitive.Contiguous (Contiguous,ContiguousU,Mutable,Element) import qualified Data.Primitive.Contiguous as C  -- | Sort an immutable array. Duplicate elements are preserved.@@ -41,11 +37,11 @@ sort :: (Contiguous arr, Element arr a, Ord a)   => arr a   -> arr a-{-# INLINABLE sort #-}+{-# INLINE sort #-} sort !src = runST $ do   let len = C.size src   dst <- C.new (C.size src)-  C.copy dst 0 src 0 len+  C.copy dst 0 (C.slice src 0 len)   res <- sortMutable dst   C.unsafeFreeze res @@ -65,13 +61,13 @@   => karr k -- ^ keys   -> varr v -- ^ values   -> (karr k,varr v)-{-# INLINABLE sortTagged #-}+{-# INLINE sortTagged #-} sortTagged !src !srcTags = runST $ do   let len = min (C.size src) (C.size srcTags)   dst <- C.new len-  C.copy dst 0 src 0 len+  C.copy dst 0 (C.slice src 0 len)   dstTags <- C.new len-  C.copy dstTags 0 srcTags 0 len+  C.copy dstTags 0 (C.slice srcTags 0 len)   (res,resTags) <- sortTaggedMutableN len dst dstTags   res' <- C.unsafeFreeze res   resTags' <- C.unsafeFreeze resTags@@ -85,17 +81,17 @@ -- -- >>> sortUniqueTagged ([5,6,7,5,5,7] :: Array Int) ([1,2,3,4,5,6] :: Array Int) -- (fromListN 3 [5,6,7],fromListN 3 [5,2,6])-sortUniqueTagged :: forall k v karr varr. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)+sortUniqueTagged :: forall k v karr varr. (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)   => karr k -- ^ keys   -> varr v -- ^ values   -> (karr k,varr v)-{-# INLINABLE sortUniqueTagged #-}+{-# INLINE sortUniqueTagged #-} sortUniqueTagged !src !srcTags = runST $ do   let len = min (C.size src) (C.size srcTags)   dst <- C.new len-  C.copy dst 0 src 0 len+  C.copy dst 0 (C.slice src 0 len)   dstTags <- C.new len-  C.copy dstTags 0 srcTags 0 len+  C.copy dstTags 0 (C.slice srcTags 0 len)   (res0,resTags0) <- sortTaggedMutableN len dst dstTags   (res1,resTags1) <- uniqueTaggedMutableN len res0 resTags0   res' <- C.unsafeFreeze res1@@ -109,47 +105,38 @@ sortMutable :: (Contiguous arr, Element arr a, Ord a)   => Mutable arr s a   -> ST s (Mutable arr s a)-{-# INLINABLE sortMutable #-}+{-# INLINE sortMutable #-} sortMutable !dst = do-  len <- C.sizeMutable dst+  len <- C.sizeMut dst   if len < threshold     then insertionSortRange dst 0 len     else do       work <- C.new len-      C.copyMutable work 0 dst 0 len -      caps <- unsafeEmbedIO getNumCapabilities-      let minElemsPerThread = 20000-          maxThreads = unsafeQuot len minElemsPerThread-          preThreads = min caps maxThreads-          threads = if preThreads == 1 then 1 else preThreads * 8-      -- I cannot understand why, but GHC's runtime does better-      -- when we let this schedule 8 times as many threads as-      -- we have capabilities. However, we only get this benefit-      -- when we actually have more than one capability.-      splitMergeParallel dst work threads 0 len+      C.copyMut work 0 (C.sliceMut dst 0 len)+      splitMerge dst work 0 len   return dst  -- | Sort an array of a key type @k@, rearranging the values of -- type @v@ according to the element they correspond to in the -- key array. The argument arrays may not be reused after they -- are passed to the function.-sortTaggedMutable :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)+sortTaggedMutable :: (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)   => Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINABLE sortTaggedMutable #-}+{-# INLINE sortTaggedMutable #-} sortTaggedMutable !dst0 !dstTags0 = do   (!dst,!dstTags,!len) <- alignArrays dst0 dstTags0   sortTaggedMutableN len dst dstTags -alignArrays :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)+alignArrays :: (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)   => Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v,Int)-{-# INLINABLE alignArrays #-}+{-# INLINE alignArrays #-} alignArrays dst0 dstTags0 = do-  lenDst <- C.sizeMutable dst0-  lenDstTags <- C.sizeMutable dstTags0+  lenDst <- C.sizeMut dst0+  lenDstTags <- C.sizeMut dstTags0   -- This cleans up mismatched lengths.   if lenDst == lenDstTags     then return (dst0,dstTags0,lenDst)@@ -161,11 +148,11 @@         dst <- C.resize dst0 lenDstTags         return (dst,dstTags0,lenDstTags) -sortUniqueTaggedMutable :: (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)+sortUniqueTaggedMutable :: (ContiguousU karr, Element karr k, Ord k, ContiguousU varr, Element varr v)   => Mutable karr s k -- ^ keys   -> Mutable varr s v -- ^ values   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINABLE sortUniqueTaggedMutable #-}+{-# INLINE sortUniqueTaggedMutable #-} sortUniqueTaggedMutable dst0 dstTags0 = do   (!dst1,!dstTags1,!len) <- alignArrays dst0 dstTags0   (!dst2,!dstTags2) <- sortTaggedMutableN len dst1 dstTags1@@ -176,20 +163,15 @@   -> Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINABLE sortTaggedMutableN #-}+{-# INLINE sortTaggedMutableN #-} sortTaggedMutableN !len !dst !dstTags = if len < thresholdTagged   then do     insertionSortTaggedRange dst dstTags 0 len     return (dst,dstTags)   else do-    work <- C.cloneMutable dst 0 len -    workTags <- C.cloneMutable dstTags 0 len -    caps <- unsafeEmbedIO getNumCapabilities-    let minElemsPerThread = 20000-        maxThreads = unsafeQuot len minElemsPerThread-        preThreads = min caps maxThreads-        threads = if preThreads == 1 then 1 else preThreads * 8-    splitMergeParallelTagged dst work dstTags workTags threads 0 len+    work <- C.cloneMut (C.sliceMut dst 0 len)+    workTags <- C.cloneMut (C.sliceMut dstTags 0 len)+    splitMergeTagged dst work dstTags workTags 0 len     return (dst,dstTags)  -- | Sort an immutable array. Only a single copy of each duplicated@@ -197,13 +179,13 @@ -- -- >>> sortUnique ([5,6,7,9,5,4,5,7] :: Array Int) -- fromListN 5 [4,5,6,7,9]-sortUnique :: (Contiguous arr, Element arr a, Ord a)+sortUnique :: (ContiguousU arr, Element arr a, Ord a)   => arr a -> arr a-{-# INLINABLE sortUnique #-}+{-# INLINE sortUnique #-} sortUnique src = runST $ do   let len = C.size src   dst <- C.new len-  C.copy dst 0 src 0 len+  C.copy dst 0 (C.slice src 0 len)   res <- sortUniqueMutable dst   C.unsafeFreeze res @@ -211,10 +193,10 @@ -- 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 :: (Contiguous arr, Element arr a, Ord a)+sortUniqueMutable :: (ContiguousU arr, Element arr a, Ord a)   => Mutable arr s a   -> ST s (Mutable arr s a)-{-# INLINABLE sortUniqueMutable #-}+{-# INLINE sortUniqueMutable #-} sortUniqueMutable marr = do   res <- sortMutable marr   uniqueMutable res@@ -222,11 +204,11 @@ -- | Discards adjacent equal elements from an array. 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.-uniqueMutable :: forall arr s a. (Contiguous arr, Element arr a, Eq a)+uniqueMutable :: forall arr s a. (ContiguousU arr, Element arr a, Eq a)   => Mutable arr s a -> ST s (Mutable arr s a)-{-# INLINABLE uniqueMutable #-}+{-# INLINE uniqueMutable #-} uniqueMutable !marr = do-  !len <- C.sizeMutable marr+  !len <- C.sizeMut marr   if len > 1     then do       !a0 <- C.read marr 0@@ -257,12 +239,12 @@           C.resize marr reducedLen     else return marr -uniqueTaggedMutableN :: forall karr varr s k v. (Contiguous karr, Element karr k, Eq k, Contiguous varr, Element varr v)+uniqueTaggedMutableN :: forall karr varr s k v. (ContiguousU karr, Element karr k, Eq k, ContiguousU varr, Element varr v)   => Int   -> Mutable karr s k   -> Mutable varr s v   -> ST s (Mutable karr s k, Mutable varr s v)-{-# INLINABLE uniqueTaggedMutableN #-}+{-# INLINE uniqueTaggedMutableN #-} uniqueTaggedMutableN !len !marr !marrTags = if len > 1   then do     !a0 <- C.read marr 0@@ -297,59 +279,13 @@         liftA2 (,) (C.resize marr reducedLen) (C.resize marrTags reducedLen)   else return (marr,marrTags) -unsafeEmbedIO :: IO a -> ST s a-unsafeEmbedIO (IO f) = ST (unsafeCoerce# f)--half :: Int -> Int-half x = unsafeQuot x 2--splitMergeParallel :: forall arr s a. (Contiguous arr, Element arr a, Ord a)-  => Mutable arr s a -- source and destination-  -> Mutable arr s a -- work array-  -> Int -- spark limit, should be power of two-  -> Int -- start-  -> Int -- end-  -> ST s ()-{-# INLINABLE splitMergeParallel #-}-splitMergeParallel !arr !work !level !start !end = if level > 1-  then if end - start < threshold-    then insertionSortRange arr start end-    else do-      let !mid = unsafeQuot (end + start) 2-          !levelDown = half level-      tandem -        (splitMergeParallel work arr levelDown start mid)-        (splitMergeParallel work arr levelDown mid end)-      mergeParallel work arr level start mid end-  else splitMerge arr work start end--splitMergeParallelTagged :: forall karr varr s k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)-  => Mutable karr s k -- source and destination-  -> Mutable karr s k -- work array-  -> Mutable varr s v -- source and destination tags-  -> Mutable varr s v -- work tags-  -> Int -- spark limit, should be power of two-  -> Int -- start-  -> Int -- end-  -> ST s ()-{-# INLINABLE splitMergeParallelTagged #-}-splitMergeParallelTagged !arr !work !arrTags !workTags !level !start !end = if level > 1-  then do-    let !mid = unsafeQuot (end + start) 2-        !levelDown = half level-    tandem -      (splitMergeParallelTagged work arr workTags arrTags levelDown start mid)-      (splitMergeParallelTagged work arr workTags arrTags levelDown mid end)-    mergeParallelTagged work arr workTags arrTags level start mid end-  else splitMergeTagged arr work arrTags workTags start end- 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   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINABLE splitMerge #-}+{-# INLINE splitMerge #-} splitMerge !arr !work !start !end = if end - start < 2   then return ()   else if end - start > threshold@@ -368,7 +304,7 @@   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINABLE splitMergeTagged #-}+{-# INLINE splitMergeTagged #-} splitMergeTagged !arr !work !arrTags !workTags !start !end = if end - start < 2   then return ()   else if end - start > thresholdTagged@@ -379,196 +315,9 @@       mergeNonContiguousTagged work arr workTags arrTags start mid mid end start     else insertionSortTaggedRange arr arrTags start end --- Precondition: threads is greater than 0-mergeParallel :: forall arr s a. (Contiguous arr, Element arr a, Ord a)-  => Mutable arr s a -- source-  -> Mutable arr s a -- dest-  -> Int -- threads-  -> Int -- start-  -> Int -- middle-  -> Int -- end-  -> ST s ()-{-# INLINABLE mergeParallel #-}-mergeParallel !src !dst !threads !start !mid !end = do-  !lock <- newLock-  let go :: Int -- previous A end-         -> Int -- previous B end-         -> Int -- how many chunk have we already iterated over-         -> ST s Int-      go !prevEndA !prevEndB !ix = -        if | prevEndA == mid && prevEndB == end -> return ix-           | prevEndA == mid -> do-               forkST_ $ do-                 let !startA = mid-                     !endA = mid-                     !startB = prevEndB-                     !endB = end-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguous src dst startA endA startB endB startDst-                 putLock lock-               go mid end (ix + 1)-           | prevEndB == end -> do-               forkST_ $ do-                 let !startA = prevEndA-                     !endA = mid-                     !startB = end-                     !endB = end-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguous src dst startA endA startB endB startDst-                 putLock lock-               go mid end (ix + 1)-           | ix == threads - 1 -> do-               forkST_ $ do-                 let !startA = prevEndA-                     !endA = mid-                     !startB = prevEndB-                     !endB = end-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguous src dst startA endA startB endB startDst-                 putLock lock-               return (ix + 1)-           | otherwise -> do-               -- We use the left half for this lookup. We could instead-               -- use both halves and take the median.-               !endElem <- C.read src (start + chunk * (ix + 1))-               !endA <- findIndexOfGtElem src (endElem :: a) prevEndA mid-               !endB <- findIndexOfGtElem src endElem prevEndB end-               forkST_ $ do-                 let !startA = prevEndA-                     !startB = prevEndB-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguous src dst startA endA startB endB startDst-                 putLock lock-               go endA endB (ix + 1)-  !endElem <- C.read src (start + chunk) -  !endA <- findIndexOfGtElem src (endElem :: a) start mid-  !endB <- findIndexOfGtElem src endElem mid end-  forkST_ $ do-    let !startA = start-        !startB = mid-        !startDst = (startA - start) + (startB - mid) + start-    mergeNonContiguous src dst startA endA startB endB startDst-    putLock lock-  total <- go endA endB 1-  replicateM_ total (takeLock lock)-  where-  !chunk = unsafeQuot (end - start) threads---- Precondition: threads is greater than 0--- This function is just a copy of mergeParallel but with--- the tags arrays passed to mergeNonContiguousTagged-mergeParallelTagged :: forall karr varr s k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)-  => Mutable karr s k -- source-  -> Mutable karr s k -- dest-  -> Mutable varr s v -- source tags-  -> Mutable varr s v -- dest tags-  -> Int -- threads-  -> Int -- start-  -> Int -- middle-  -> Int -- end-  -> ST s ()-{-# INLINABLE mergeParallelTagged #-}-mergeParallelTagged !src !dst !srcTags !dstTags !threads !start !mid !end = do-  !lock <- newLock-  let go :: Int -- previous A end-         -> Int -- previous B end-         -> Int -- how many chunk have we already iterated over-         -> ST s Int-      go !prevEndA !prevEndB !ix = -        if | prevEndA == mid && prevEndB == end -> return ix-           | prevEndA == mid -> do-               forkST_ $ do-                 let !startA = mid-                     !endA = mid-                     !startB = prevEndB-                     !endB = end-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguousTagged src dst srcTags dstTags startA endA startB endB startDst-                 putLock lock-               go mid end (ix + 1)-           | prevEndB == end -> do-               forkST_ $ do-                 let !startA = prevEndA-                     !endA = mid-                     !startB = end-                     !endB = end-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguousTagged src dst srcTags dstTags startA endA startB endB startDst-                 putLock lock-               go mid end (ix + 1)-           | ix == threads - 1 -> do-               forkST_ $ do-                 let !startA = prevEndA-                     !endA = mid-                     !startB = prevEndB-                     !endB = end-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguousTagged src dst srcTags dstTags startA endA startB endB startDst-                 putLock lock-               return (ix + 1)-           | otherwise -> do-               -- We use the left half for this lookup. We could instead-               -- use both halves and take the median.-               !endElem <- C.read src (start + chunk * (ix + 1))-               !endA <- findIndexOfGtElem src (endElem :: k) prevEndA mid-               !endB <- findIndexOfGtElem src endElem prevEndB end-               forkST_ $ do-                 let !startA = prevEndA-                     !startB = prevEndB-                     !startDst = (startA - start) + (startB - mid) + start-                 mergeNonContiguousTagged src dst srcTags dstTags startA endA startB endB startDst-                 putLock lock-               go endA endB (ix + 1)-  !endElem <- C.read src (start + chunk) -  !endA <- findIndexOfGtElem src (endElem :: k) start mid-  !endB <- findIndexOfGtElem src endElem mid end-  forkST_ $ do-    let !startA = start-        !startB = mid-        !startDst = (startA - start) + (startB - mid) + start-    mergeNonContiguousTagged src dst srcTags dstTags startA endA startB endB startDst-    putLock lock-  total <- go endA endB 1-  replicateM_ total (takeLock lock)-  where-  !chunk = unsafeQuot (end - start) threads- unsafeQuot :: Int -> Int -> Int unsafeQuot (I# a) (I# b) = I# (quotInt# a b)---- If the needle is bigger than everything in the slice--- of the array, this returns the end index (which is out--- of bounds). Callers of this function should be able--- to handle that.-findIndexOfGtElem :: forall arr s a. (Contiguous arr, Element arr a, Ord a)-  => Mutable arr s a -> a -> Int -> Int -> ST s Int-{-# INLINABLE findIndexOfGtElem #-}-findIndexOfGtElem !v !needle !start !end = go start end-  where-  go :: Int -> Int -> ST s Int-  go !lo !hi = if lo < hi-    then do-      let !mid = lo + half (hi - lo)-      !val <- C.read v mid-      if | val == needle -> gallopToGtIndex v needle (mid + 1) hi-         | val < needle -> go (mid + 1) hi-         | otherwise -> go lo mid-    else return lo---- | TODO: should probably turn this into a real galloping search-gallopToGtIndex :: forall arr s a. (Contiguous arr, Element arr a, Ord a)-  => Mutable arr s a -> a -> Int -> Int -> ST s Int-{-# INLINABLE gallopToGtIndex #-}-gallopToGtIndex !v !val !start !end = go start-  where-  go :: Int -> ST s Int-  go !ix = if ix < end-    then do-      !a <- C.read v ix-      if a > val-        then return ix-        else go (ix + 1)-    else return end+{-# INLINE unsafeQuot #-}  -- stepA assumes that we previously incremented ixA. -- Consequently, we do not need to check that ixB@@ -583,7 +332,7 @@   -> Int -- end B   -> Int -- start destination   -> ST s ()-{-# INLINABLE mergeNonContiguous #-}+{-# INLINE mergeNonContiguous #-} mergeNonContiguous !src !dst !startA !endA !startB !endB !startDst =   if startB < endB     then stepA startA startB startDst@@ -611,9 +360,9 @@     then continue ixA ixB ixDst     else finishB ixB ixDst   finishB :: Int -> Int -> ST s ()-  finishB !ixB !ixDst = C.copyMutable dst ixDst src ixB (endB - ixB)+  finishB !ixB !ixDst = C.copyMut dst ixDst (C.sliceMut src ixB (endB - ixB))   finishA :: Int -> Int -> ST s ()-  finishA !ixA !ixDst = C.copyMutable dst ixDst src ixA (endA - ixA)+  finishA !ixA !ixDst = C.copyMut dst ixDst (C.sliceMut src ixA (endA - ixA))  mergeNonContiguousTagged :: forall karr varr k v s. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)   => Mutable karr s k -- source@@ -626,7 +375,7 @@   -> Int -- end B   -> Int -- start destination   -> ST s ()-{-# INLINABLE mergeNonContiguousTagged #-}+{-# INLINE mergeNonContiguousTagged #-} mergeNonContiguousTagged !src !dst !srcTags !dstTags !startA !endA !startB !endB !startDst =   if startB < endB     then stepA startA startB startDst@@ -657,12 +406,12 @@     else finishB ixB ixDst   finishB :: Int -> Int -> ST s ()   finishB !ixB !ixDst = do-    C.copyMutable dst ixDst src ixB (endB - ixB)-    C.copyMutable dstTags ixDst srcTags ixB (endB - ixB)+    C.copyMut dst ixDst (C.sliceMut src ixB (endB - ixB))+    C.copyMut dstTags ixDst (C.sliceMut srcTags ixB (endB - ixB))   finishA :: Int -> Int -> ST s ()   finishA !ixA !ixDst = do-    C.copyMutable dst ixDst src ixA (endA - ixA)-    C.copyMutable dstTags ixDst srcTags ixA (endA - ixA)+    C.copyMut dst ixDst (C.sliceMut src ixA (endA - ixA))+    C.copyMut dstTags ixDst (C.sliceMut srcTags ixA (endA - ixA))  threshold :: Int threshold = 16@@ -675,7 +424,7 @@   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINABLE insertionSortRange #-}+{-# INLINE insertionSortRange #-} insertionSortRange !arr !start !end = go start   where   go :: Int -> ST s ()@@ -692,7 +441,7 @@   -> Int   -> Int   -> ST s ()-{-# INLINABLE insertElement #-}+{-# INLINE insertElement #-} insertElement !arr !a !start !end = go end   where   go :: Int -> ST s ()@@ -701,11 +450,11 @@       !b <- C.read arr (ix - 1)       if b <= a         then do-          C.copyMutable arr (ix + 1) arr ix (end - ix)+          C.copyMut arr (ix + 1) (C.sliceMut arr ix (end - ix))           C.write arr ix a         else go (ix - 1)     else do-      C.copyMutable arr (ix + 1) arr ix (end - ix)+      C.copyMut arr (ix + 1) (C.sliceMut arr ix (end - ix))       C.write arr ix a  insertionSortTaggedRange :: forall karr varr s k v. (Contiguous karr, Element karr k, Ord k, Contiguous varr, Element varr v)@@ -714,7 +463,7 @@   -> Int -- start   -> Int -- end   -> ST s ()-{-# INLINABLE insertionSortTaggedRange #-}+{-# INLINE insertionSortTaggedRange #-} insertionSortTaggedRange !karr !varr !start !end = go start   where   go :: Int -> ST s ()@@ -734,7 +483,7 @@   -> Int   -> Int   -> ST s ()-{-# INLINABLE insertElementTagged #-}+{-# INLINE insertElementTagged #-} insertElementTagged !karr !varr !a !v !start !end = go end   where   go :: Int -> ST s ()@@ -743,48 +492,16 @@       !b <- C.read karr (ix - 1)       if b <= a         then do-          C.copyMutable karr (ix + 1) karr ix (end - ix)+          C.copyMut karr (ix + 1) (C.sliceMut karr ix (end - ix))           C.write karr ix a-          C.copyMutable varr (ix + 1) varr ix (end - ix)+          C.copyMut varr (ix + 1) (C.sliceMut varr ix (end - ix))           C.write varr ix v         else go (ix - 1)     else do-      C.copyMutable karr (ix + 1) karr ix (end - ix)+      C.copyMut karr (ix + 1) (C.sliceMut karr ix (end - ix))       C.write karr ix a-      C.copyMutable varr (ix + 1) varr ix (end - ix)+      C.copyMut varr (ix + 1) (C.sliceMut varr ix (end - ix))       C.write varr ix v---forkST_ :: ST s a -> ST s ()-forkST_ action = ST $ \s1 -> case forkST# action s1 of-  (# s2, _ #) -> (# s2, () #)--forkST# :: a -> State# s -> (# State# s, ThreadId# #)-forkST# = unsafeCoerce# fork#--data Lock s = Lock (MVar# s ())--newLock :: ST s (Lock s)-newLock = ST $ \s1 -> case newMVar# s1 of-  (# s2, v #) -> (# s2, Lock v #)--takeLock :: Lock s -> ST s ()-takeLock (Lock mvar#) = ST $ \ s# -> takeMVar# mvar# s#--putLock  :: Lock s -> ST s ()-putLock (Lock mvar#) = ST $ \ s# ->-  case putMVar# mvar# () s# of-    s2# -> (# s2#, () #)---- | Execute the first computation on the main thread and---   the second one on another thread in parallel. Blocks---   until both are finished.-tandem :: ST s () -> ST s () -> ST s ()-tandem a b = do-  lock <- newLock-  forkST_ (b >> putLock lock)-  a-  takeLock lock  -- $setup --