module Data.SmallArray.Internal where
import Prelude hiding (length, elem)
import qualified Prelude
import Control.Exception (assert)
import Control.Monad.ST
import qualified Data.ByteArray as B
import Data.ByteArray (ByteArray, MutableByteArray)
import Data.Int
import Data.Word
import Control.DeepSeq
import qualified Data.Hashable as H
newtype Array a
= A ByteArray
newtype MArray s a
= M (MutableByteArray s)
instance NFData (Array a) where
rnf (A ary) = rnf ary
instance NFData (MArray s a) where
rnf (M ary) = rnf ary
instance (Show e, Elt e) => Show (Array e) where
show = show . toList
instance (Eq a, Elt a) => Eq (Array a) where
(==) = eqArray
instance H.Hashable (Array a) where
hash (A bArr) = B.hashByteArray bArr
eqArray :: (Eq a, Elt a) => Array a -> Array a -> Bool
eqArray a b
= let an = length a
bn = length b
in
an == bn && and [unsafeIndex a n == unsafeIndex b n | n <- [0..bn1] ]
instance (Ord a, Elt a) => Ord (Array a) where
a `compare` b
= f 0
where an = length a
bn = length b
maxLen = an `min` bn
f n | n < maxLen
= case unsafeIndex a n `compare` unsafeIndex b n of
EQ -> f (n+1)
x -> x
| an > bn
= GT
| bn > an
= LT
| otherwise
= EQ
class IArray a where
length :: a -> Int
instance Elt a => IArray (Array a) where
length = arrayLen
arrayLen :: Elt a => Array a -> Int
arrayLen a@(A arr)
= len undefined a arr
where
len :: Elt e => e -> Array e -> ByteArray -> Int
len elem _ bytes = B.length bytes `div` elemSize elem
instance Elt a => IArray (MArray s a) where
length = marrayLen
marrayLen :: Elt a => MArray s a -> Int
marrayLen a@(M arr)
= len undefined a arr
where
len :: Elt e => e -> MArray s e -> MutableByteArray s -> Int
len elem _ bytes = B.lengthM bytes `div` elemSize elem
unsafeNew :: Elt e => Int -> ST s (MArray s e)
unsafeNew n = f undefined
where f :: Elt e => e -> ST s (MArray s e)
f e = M `fmap` B.new (bytesInArray n e)
new :: Elt e => Int -> e -> ST s (MArray s e)
new n e = do
arr <- unsafeNew n
mapM_ (flip (unsafeWrite arr) e) [0 .. (n1)]
return arr
unsafeFreeze :: MArray s e -> ST s (Array e)
unsafeFreeze (M marr) = A `fmap` B.unsafeFreeze marr
run :: (forall s . ST s (MArray s e)) -> Array e
run act = runST $ act >>= unsafeFreeze
run' :: (forall s . ST s (MArray s e, a)) -> (Array e, a)
run' act = runST $ do
(marr, a) <- act
arr <- unsafeFreeze marr
return (arr, a)
empty :: Elt e => Array e
empty = run $ unsafeNew 0
toList :: Elt e => Array e -> [e]
toList arr = [arr `unsafeIndex` n | n <- [0 .. length arr 1]]
fromList :: Elt e => [e] -> Array e
fromList xs
= run $ do
arr <- unsafeNew len
mapM_ (uncurry $ unsafeWrite arr) $ zip [0..(len1)] xs
return arr
where len = Prelude.length xs
copy :: Elt e => MArray s e
-> MArray s e
-> ST s ()
copy src dest
| length dest >= length src = copy_loop 0
| otherwise = fail "Data.SmallArray.copy: array too small"
where
len = length src
copy_loop i
| i >= len = return ()
| otherwise = do unsafeRead src i >>= unsafeWrite dest i
copy_loop (i+1)
unsafeCopy :: Elt e =>
MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
unsafeCopy src sidx dest didx count =
assert (sidx + count <= length src) .
assert (didx + count <= length dest) $
copy_loop sidx didx 0
where
copy_loop !i !j !c
| c >= count = return ()
| otherwise = do unsafeRead src i >>= unsafeWrite dest j
copy_loop (i+1) (j+1) (c+1)
class Elt e where
index :: Array e -> Int -> e
index a n = check "index" a n unsafeIndex
read :: MArray s e -> Int -> ST s e
read a n = check "read" a n unsafeRead
write :: MArray s e -> Int -> e -> ST s ()
write a n = check "write" a n unsafeWrite
elemSize :: e -> Int
unsafeIndex :: Array e -> Int -> e
unsafeRead :: MArray s e -> Int -> ST s e
unsafeWrite :: MArray s e -> Int -> e -> ST s ()
bytesInArray :: Elt e => Int -> e -> Int
bytesInArray sz el = elemSize el * sz
check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
check func ary i f
| i >= 0 && i < length ary = f ary i
| otherwise = error ("Data.SmallArray." ++ func ++ ": index out of bounds")
#define deriveElt(Typ) \
instance Elt Typ where { \
elemSize = B.elemSize \
; \
; unsafeIndex (A arr) n = B.index arr n \
; \
; unsafeRead (M arr) n = B.read arr n \
; \
; unsafeWrite (M arr) n x = B.write arr n x \
; \
} \
deriveElt(Char)
deriveElt(Double)
deriveElt(Float)
deriveElt(Int)
deriveElt(Int8)
deriveElt(Int16)
deriveElt(Int32)
deriveElt(Int64)
deriveElt(Word)
deriveElt(Word8)
deriveElt(Word16)
deriveElt(Word32)
deriveElt(Word64)