{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Vector.Algorithms.Radix (sort, sortBy, Radix(..)) where
import Prelude hiding (read, length)
import Control.Monad
import Control.Monad.Primitive
import qualified Data.Vector.Primitive.Mutable as PV
import Data.Vector.Generic.Mutable
import Data.Vector.Algorithms.Common
import Data.Bits
import Data.Int
import Data.Word
import Foreign.Storable
class Radix e where
passes :: e -> Int
size :: e -> Int
radix :: Int -> e -> Int
instance Radix Int where
passes :: Int -> Int
passes _ = Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int)
{-# INLINE passes #-}
size :: Int -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Int -> Int
radix 0 e :: Int
e = Int
e Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 255
radix i :: Int
i e :: Int
e
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall e. Radix e => e -> Int
passes Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 = Int -> Int
radix' (Int
e Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
forall a. Bounded a => a
minBound)
| Bool
otherwise = Int -> Int
radix' Int
e
where radix' :: Int -> Int
radix' e :: Int
e = (Int
e Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` (Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 3)) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 255
{-# INLINE radix #-}
instance Radix Int8 where
passes :: Int8 -> Int
passes _ = 1
{-# INLINE passes #-}
size :: Int8 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Int8 -> Int
radix _ e :: Int8
e = 255 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
e Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` 128
{-# INLINE radix #-}
instance Radix Int16 where
passes :: Int16 -> Int
passes _ = 2
{-# INLINE passes #-}
size :: Int16 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Int16 -> Int
radix 0 e :: Int16
e = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16
e Int16 -> Int16 -> Int16
forall a. Bits a => a -> a -> a
.&. 255)
radix 1 e :: Int16
e = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Int16
e Int16 -> Int16 -> Int16
forall a. Bits a => a -> a -> a
`xor` Int16
forall a. Bounded a => a
minBound) Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
`shiftR` 8) Int16 -> Int16 -> Int16
forall a. Bits a => a -> a -> a
.&. 255)
{-# INLINE radix #-}
instance Radix Int32 where
passes :: Int32 -> Int
passes _ = 4
{-# INLINE passes #-}
size :: Int32 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Int32 -> Int
radix 0 e :: Int32
e = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
e Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. 255)
radix 1 e :: Int32
e = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int32
e Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` 8) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. 255)
radix 2 e :: Int32
e = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int32
e Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` 16) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. 255)
radix 3 e :: Int32
e = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Int32
e Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
`xor` Int32
forall a. Bounded a => a
minBound) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`shiftR` 24) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. 255)
{-# INLINE radix #-}
instance Radix Int64 where
passes :: Int64 -> Int
passes _ = 8
{-# INLINE passes #-}
size :: Int64 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Int64 -> Int
radix 0 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
e Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
radix 1 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
e Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` 8) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
radix 2 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
e Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` 16) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
radix 3 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
e Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` 24) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
radix 4 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
e Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` 32) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
radix 5 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
e Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` 40) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
radix 6 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int64
e Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` 48) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
radix 7 e :: Int64
e = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (((Int64
e Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
`xor` Int64
forall a. Bounded a => a
minBound) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` 56) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. 255)
{-# INLINE radix #-}
instance Radix Word where
passes :: Word -> Int
passes _ = Word -> Int
forall a. Storable a => a -> Int
sizeOf (Word
forall a. HasCallStack => a
undefined :: Word)
{-# INLINE passes #-}
size :: Word -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Word -> Int
radix 0 e :: Word
e = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
e Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. 255)
radix i :: Int
i e :: Word
e = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word
e Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` (Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 3)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. 255)
{-# INLINE radix #-}
instance Radix Word8 where
passes :: Word8 -> Int
passes _ = 1
{-# INLINE passes #-}
size :: Word8 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Word8 -> Int
radix _ = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE radix #-}
instance Radix Word16 where
passes :: Word16 -> Int
passes _ = 2
{-# INLINE passes #-}
size :: Word16 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Word16 -> Int
radix 0 e :: Word16
e = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
e Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 255)
radix 1 e :: Word16
e = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16
e Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` 8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 255)
{-# INLINE radix #-}
instance Radix Word32 where
passes :: Word32 -> Int
passes _ = 4
{-# INLINE passes #-}
size :: Word32 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Word32 -> Int
radix 0 e :: Word32
e = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
e Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 255)
radix 1 e :: Word32
e = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
e Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 255)
radix 2 e :: Word32
e = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
e Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 255)
radix 3 e :: Word32
e = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
e Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` 24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 255)
{-# INLINE radix #-}
instance Radix Word64 where
passes :: Word64 -> Int
passes _ = 8
{-# INLINE passes #-}
size :: Word64 -> Int
size _ = 256
{-# INLINE size #-}
radix :: Int -> Word64 -> Int
radix 0 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
e Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
radix 1 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
radix 2 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 16) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
radix 3 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 24) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
radix 4 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
radix 5 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 40) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
radix 6 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 48) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
radix 7 e :: Word64
e = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 56) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 255)
{-# INLINE radix #-}
instance (Radix i, Radix j) => Radix (i, j) where
passes :: (i, j) -> Int
passes ~(i :: i
i, j :: j
j) = i -> Int
forall e. Radix e => e -> Int
passes i
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ j -> Int
forall e. Radix e => e -> Int
passes j
j
{-# INLINE passes #-}
size :: (i, j) -> Int
size ~(i :: i
i, j :: j
j) = i -> Int
forall e. Radix e => e -> Int
size i
i Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` j -> Int
forall e. Radix e => e -> Int
size j
j
{-# INLINE size #-}
radix :: Int -> (i, j) -> Int
radix k :: Int
k ~(i :: i
i, j :: j
j) | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< j -> Int
forall e. Radix e => e -> Int
passes j
j = Int -> j -> Int
forall e. Radix e => Int -> e -> Int
radix Int
k j
j
| Bool
otherwise = Int -> i -> Int
forall e. Radix e => Int -> e -> Int
radix (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- j -> Int
forall e. Radix e => e -> Int
passes j
j) i
i
{-# INLINE radix #-}
sort :: forall e m v. (PrimMonad m, MVector v e, Radix e)
=> v (PrimState m) e -> m ()
sort :: v (PrimState m) e -> m ()
sort arr :: v (PrimState m) e
arr = Int -> Int -> (Int -> e -> Int) -> v (PrimState m) e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int -> Int -> (Int -> e -> Int) -> v (PrimState m) e -> m ()
sortBy (e -> Int
forall e. Radix e => e -> Int
passes e
e) (e -> Int
forall e. Radix e => e -> Int
size e
e) Int -> e -> Int
forall e. Radix e => Int -> e -> Int
radix v (PrimState m) e
arr
where
e :: e
e :: e
e = e
forall a. HasCallStack => a
undefined
{-# INLINABLE sort #-}
sortBy :: (PrimMonad m, MVector v e)
=> Int
-> Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> m ()
sortBy :: Int -> Int -> (Int -> e -> Int) -> v (PrimState m) e -> m ()
sortBy passes :: Int
passes size :: Int
size rdx :: Int -> e -> Int
rdx arr :: v (PrimState m) e
arr = do
v (PrimState m) e
tmp <- Int -> m (v (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
new (v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
arr)
MVector (PrimState m) Int
count <- Int -> m (MVector (PrimState m) Int)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
new Int
size
Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> m ()
radixLoop Int
passes Int -> e -> Int
rdx v (PrimState m) e
arr v (PrimState m) e
tmp MVector (PrimState m) Int
count
{-# INLINE sortBy #-}
radixLoop :: (PrimMonad m, MVector v e)
=> Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> PV.MVector (PrimState m) Int
-> m ()
radixLoop :: Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> m ()
radixLoop passes :: Int
passes rdx :: Int -> e -> Int
rdx src :: v (PrimState m) e
src dst :: v (PrimState m) e
dst count :: MVector (PrimState m) Int
count = Bool -> Int -> m ()
go Bool
False 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 :: Bool -> Int -> m ()
go swap :: Bool
swap k :: Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
passes = if Bool
swap
then (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> Int
-> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> Int
-> m ()
body Int -> e -> Int
rdx v (PrimState m) e
dst v (PrimState m) e
src MVector (PrimState m) Int
count Int
k m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Int -> m ()
go (Bool -> Bool
not Bool
swap) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
else (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> Int
-> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> Int
-> m ()
body Int -> e -> Int
rdx v (PrimState m) e
src v (PrimState m) e
dst MVector (PrimState m) Int
count Int
k m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Int -> m ()
go (Bool -> Bool
not Bool
swap) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
| Bool
otherwise = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
swap (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 v (PrimState m) e
src v (PrimState m) e
dst)
{-# INLINE radixLoop #-}
body :: (PrimMonad m, MVector v e)
=> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> PV.MVector (PrimState m) Int
-> Int
-> m ()
body :: (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> Int
-> m ()
body rdx :: Int -> e -> Int
rdx src :: v (PrimState m) e
src dst :: v (PrimState m) e
dst count :: MVector (PrimState m) Int
count k :: Int
k = do
(e -> Int)
-> v (PrimState m) e -> MVector (PrimState m) Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> Int)
-> v (PrimState m) e -> MVector (PrimState m) Int -> m ()
countLoop (Int -> e -> Int
rdx Int
k) v (PrimState m) e
src MVector (PrimState m) Int
count
MVector (PrimState m) Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Int -> m ()
accumulate MVector (PrimState m) Int
count
Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> m ()
moveLoop Int
k Int -> e -> Int
rdx v (PrimState m) e
src v (PrimState m) e
dst MVector (PrimState m) Int
count
{-# INLINE body #-}
accumulate :: (PrimMonad m)
=> PV.MVector (PrimState m) Int -> m ()
accumulate :: MVector (PrimState m) Int -> m ()
accumulate count :: MVector (PrimState m) Int
count = Int -> Int -> m ()
go 0 0
where
len :: Int
len = MVector (PrimState m) Int -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length MVector (PrimState m) Int
count
go :: Int -> Int -> m ()
go i :: Int
i acc :: Int
acc
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do Int
ci <- MVector (PrimState m) Int -> Int -> m Int
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead MVector (PrimState m) Int
count Int
i
MVector (PrimState m) Int -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite MVector (PrimState m) Int
count Int
i Int
acc
Int -> Int -> m ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ci)
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE accumulate #-}
moveLoop :: (PrimMonad m, MVector v e)
=> Int -> (Int -> e -> Int) -> v (PrimState m) e
-> v (PrimState m) e -> PV.MVector (PrimState m) Int -> m ()
moveLoop :: Int
-> (Int -> e -> Int)
-> v (PrimState m) e
-> v (PrimState m) e
-> MVector (PrimState m) Int
-> m ()
moveLoop k :: Int
k rdx :: Int -> e -> Int
rdx src :: v (PrimState m) e
src dst :: v (PrimState m) e
dst prefix :: MVector (PrimState m) Int
prefix = Int -> m ()
go 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 i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len = do e
srci <- 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
Int
pf <- 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
prefix (Int -> e -> Int
rdx Int
k e
srci)
v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
dst Int
pf e
srci
Int -> m ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE moveLoop #-}