{-# LANGUAGE Rank2Types #-}
{-# OPTIONS_GHC -XMagicHash -XUnboxedTuples #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Permute.Base
where
import Control.Monad
import Control.Monad.ST
import Foreign
import Data.IntArray ( IntArray, STIntArray )
import qualified Data.IntArray as Arr
import qualified Data.IntArray as ArrST
newtype Permute = Permute IntArray
unsafeAt :: Permute -> Int -> Int
unsafeAt (Permute p) i = Arr.unsafeAt p i
{-# INLINE unsafeAt #-}
size :: Permute -> Int
size (Permute p) = Arr.numElements p
{-# INLINE size #-}
elems :: Permute -> [Int]
elems (Permute p) = Arr.elems p
{-# INLINE elems #-}
instance Show Permute where
show p = "listPermute " ++ show (size p) ++ " " ++ show (elems p)
instance Eq Permute where
(==) p q = (size p == size q) && (elems p == elems q)
newtype STPermute s = STPermute (STIntArray s)
getSizeSTPermute :: STPermute s -> ST s Int
getSizeSTPermute (STPermute marr) = ArrST.getNumElements marr
{-# INLINE getSizeSTPermute #-}
sizeSTPermute :: STPermute s -> Int
sizeSTPermute (STPermute marr) = ArrST.numElementsSTIntArray marr
{-# INLINE sizeSTPermute #-}
newSTPermute :: Int -> ST s (STPermute s)
newSTPermute n = do
p@(STPermute marr) <- newSTPermute_ n
ArrST.writeElems marr [0 .. n-1]
return p
{-# INLINE newSTPermute #-}
newSTPermute_ :: Int -> ST s (STPermute s)
newSTPermute_ n = do
when (n < 0) $ fail "invalid size"
liftM STPermute $ ArrST.newArray_ n
{-# INLINE newSTPermute_ #-}
unsafeGetElemSTPermute :: STPermute s -> Int -> ST s Int
unsafeGetElemSTPermute (STPermute marr) i = ArrST.unsafeRead marr i
{-# INLINE unsafeGetElemSTPermute #-}
unsafeSetElemSTPermute :: STPermute s -> Int -> Int -> ST s ()
unsafeSetElemSTPermute (STPermute marr) i x = ArrST.unsafeWrite marr i x
{-# INLINE unsafeSetElemSTPermute #-}
unsafeSwapElemsSTPermute :: STPermute s -> Int -> Int -> ST s ()
unsafeSwapElemsSTPermute (STPermute marr) i j = ArrST.unsafeSwap marr i j
{-# INLINE unsafeSwapElemsSTPermute #-}
getElemsSTPermute :: STPermute s -> ST s [Int]
getElemsSTPermute (STPermute marr) = ArrST.readElems marr
{-# INLINE getElemsSTPermute #-}
setElemsSTPermute :: STPermute s -> [Int] -> ST s ()
setElemsSTPermute (STPermute marr) is = ArrST.writeElems marr is
{-# INLINE setElemsSTPermute #-}
unsafeFreezeSTPermute :: STPermute s -> ST s Permute
unsafeFreezeSTPermute (STPermute marr) =
(liftM Permute . ArrST.unsafeFreeze) marr
{-# INLINE unsafeFreezeSTPermute #-}
unsafeThawSTPermute :: Permute -> ST s (STPermute s)
unsafeThawSTPermute (Permute arr) =
(liftM STPermute . ArrST.unsafeThaw) arr
{-# INLINE unsafeThawSTPermute #-}
instance Eq (STPermute s) where
(==) (STPermute marr1) (STPermute marr2) = ArrST.sameSTIntArray marr1 marr2