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