{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-- ---------------------------------------------------------------------------
-- |
-- Module      : Data.Vector.Algorithms.Common
-- Copyright   : (c) 2008-2011 Dan Doel
-- Maintainer  : Dan Doel
-- Stability   : Experimental
-- Portability : Portable
--
-- Common operations and utility functions for all sorts

module Data.Vector.Algorithms.Common where

import Prelude hiding (read, length)

import Control.Monad.Primitive

import Data.Vector.Generic.Mutable
import Data.Word (Word)

import qualified Data.Vector.Primitive.Mutable as PV

-- | A type of comparisons between two values of a given type.
type Comparison e = e -> e -> Ordering

copyOffset :: (PrimMonad m, MVector v e)
           => v (PrimState m) e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
copyOffset :: v (PrimState m) e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
copyOffset v (PrimState m) e
from v (PrimState m) e
to Int
iFrom Int
iTo Int
len =
  v (PrimState m) e -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
unsafeCopy (Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
iTo Int
len v (PrimState m) e
to) (Int -> Int -> v (PrimState m) e -> v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
unsafeSlice Int
iFrom Int
len v (PrimState m) e
from)
{-# INLINE copyOffset #-}

inc :: (PrimMonad m, MVector v Int) => v (PrimState m) Int -> Int -> m Int
inc :: v (PrimState m) Int -> Int -> m Int
inc v (PrimState m) Int
arr Int
i = v (PrimState m) Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) Int
arr Int
i m Int -> (Int -> m Int) -> m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
e -> v (PrimState m) Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) Int
arr Int
i (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) m () -> m Int -> m Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
e
{-# INLINE inc #-}

-- shared bucket sorting stuff
countLoop :: (PrimMonad m, MVector v e)
          => (e -> Int)
          -> v (PrimState m) e -> PV.MVector (PrimState m) Int -> m ()
countLoop :: (e -> Int)
-> v (PrimState m) e -> MVector (PrimState m) Int -> m ()
countLoop e -> Int
rdx v (PrimState m) e
src MVector (PrimState m) Int
count = MVector (PrimState m) Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> a -> m ()
set MVector (PrimState m) Int
count Int
0 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m ()
go Int
0
 where
 len :: Int
len = v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
src
 go :: Int -> m ()
go Int
i
   | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len    = v (PrimState m) e -> Int -> m e
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
src Int
i m e -> (e -> m Int) -> m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVector (PrimState m) Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *).
(PrimMonad m, MVector v Int) =>
v (PrimState m) Int -> Int -> m Int
inc MVector (PrimState m) Int
count (Int -> m Int) -> (e -> Int) -> e -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Int
rdx m Int -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
   | Bool
otherwise  = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE countLoop #-}

midPoint :: Int -> Int -> Int
midPoint :: Int -> Int -> Int
midPoint Int
a Int
b =
  Word -> Int
toInt (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Word
toWord Int
a Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Int -> Word
toWord Int
b) Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
2
  where
    toWord :: Int -> Word
    toWord :: Int -> Word
toWord = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    toInt :: Word -> Int
    toInt :: Word -> Int
toInt = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE midPoint #-}