Replace type families by GADTs for associating a monad with a mutable vector
[darcs-mirrors/vector.git] / Data / Vector / Mutable.hs
1 {-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, GADTs, FlexibleInstances #-}
2
3 module Data.Vector.Mutable ( Vector(..) )
4 where
5
6 import qualified Data.Vector.Base.Mutable as Base
7
8 import GHC.Prim ( MutableArray#,
9 newArray#, readArray#, writeArray#, sameMutableArray#, (+#) )
10
11 import GHC.ST ( ST(..) )
12
13 import GHC.Base ( Int(..) )
14
15 data Vector m a where
16 Vector :: {-# UNPACK #-} !Int
17 -> {-# UNPACK #-} !Int
18 -> MutableArray# s a
19 -> Vector (ST s) a
20
21 instance Base.Base Vector (ST s) a where
22 length (Vector _ n _) = n
23 unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#
24
25 {-# INLINE unsafeNew #-}
26 unsafeNew = unsafeNew
27
28 {-# INLINE unsafeNewWith #-}
29 unsafeNewWith = unsafeNewWith
30
31 {-# INLINE unsafeRead #-}
32 unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (readArray# arr# (i# +# j#))
33
34 {-# INLINE unsafeWrite #-}
35 unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->
36 case writeArray# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)
37 )
38
39 {-# INLINE overlaps #-}
40 overlaps (Vector i m arr1#) (Vector j n arr2#)
41 = sameMutableArray# arr1# arr2#
42 && (between i j (j+n) || between j i (i+m))
43 where
44 between x y z = x >= y && x < z
45
46 unsafeNew :: Int -> ST s (Vector (ST s) a)
47 {-# INLINE unsafeNew #-}
48 unsafeNew n = unsafeNewWith n (error "Data.Vector.Mutable: uninitialised elemen t")
49
50 unsafeNewWith :: Int -> a -> ST s (Vector (ST s) a)
51 {-# INLINE unsafeNewWith #-}
52 unsafeNewWith (I# n#) x = ST (\s# ->
53 case newArray# n# x s# of
54 (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)
55 )
56