1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE TypeFamilies #-}
3
4-- ---------------------------------------------------------------------------
5-- |
6-- Module      : Data.Vector.Algorithms.Common
7-- Copyright   : (c) 2008-2011 Dan Doel
8-- Maintainer  : Dan Doel
9-- Stability   : Experimental
10-- Portability : Portable
11--
12-- Common operations and utility functions for all sorts
13
14module Data.Vector.Algorithms.Common where
15
16import Prelude hiding (read, length)
17
18import Control.Monad.Primitive
19
20import Data.Vector.Generic.Mutable
21import Data.Word (Word)
22
23import qualified Data.Vector.Primitive.Mutable as PV
24
25-- | A type of comparisons between two values of a given type.
26type Comparison e = e -> e -> Ordering
27
28copyOffset :: (PrimMonad m, MVector v e)
29           => v (PrimState m) e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
30copyOffset from to iFrom iTo len =
31  unsafeCopy (unsafeSlice iTo len to) (unsafeSlice iFrom len from)
32{-# INLINE copyOffset #-}
33
34inc :: (PrimMonad m, MVector v Int) => v (PrimState m) Int -> Int -> m Int
35inc arr i = unsafeRead arr i >>= \e -> unsafeWrite arr i (e+1) >> return e
36{-# INLINE inc #-}
37
38-- shared bucket sorting stuff
39countLoop :: (PrimMonad m, MVector v e)
40          => (e -> Int)
41          -> v (PrimState m) e -> PV.MVector (PrimState m) Int -> m ()
42countLoop rdx src count = set count 0 >> go 0
43 where
44 len = length src
45 go i
46   | i < len    = unsafeRead src i >>= inc count . rdx >> go (i+1)
47   | otherwise  = return ()
48{-# INLINE countLoop #-}
49
50midPoint :: Int -> Int -> Int
51midPoint a b =
52  toInt $ (toWord a + toWord b) `div` 2
53  where
54    toWord :: Int -> Word
55    toWord = fromIntegral
56
57    toInt :: Word -> Int
58    toInt = fromIntegral
59{-# INLINE midPoint #-}
60