Initial revision
[darcs-mirrors/vector.git] / Data / Vector / Unboxed / Unbox.hs
1 {-# LANGUAGE MagicHash, UnboxedTuples, ScopedTypeVariables #-}
2
3 module Data.Vector.Unboxed.Unbox (
4 Unbox(..), Array, MutableArray,
5
6 arraySize, newArray, unsafeFreezeArray, indexArray, readArray, writeArray
7 ) where
8
9 import GHC.Prim (
10 ByteArray#, MutableByteArray#, State#,
11 newByteArray#, unsafeFreezeByteArray#,
12
13 Int#, indexIntArray#, readIntArray#, writeIntArray#
14 )
15 import GHC.ST (
16 ST(..)
17 )
18 import GHC.Base (
19 Int(..)
20 )
21 import Data.Array.Base (
22 wORD_SCALE )
23
24 data Array a = Array ByteArray#
25 data MutableArray s a = MutableArray (MutableByteArray# s)
26
27 class Unbox a where
28 arraySize# :: a -> Int# -> Int#
29 indexArray# :: ByteArray# -> Int# -> a
30 readArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
31 writeArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
32
33 instance Unbox Int where
34 arraySize# _ = wORD_SCALE
35 indexArray# arr# i# = I# (indexIntArray# arr# i#)
36 readArray# arr# i# s# = case readIntArray# arr# i# s# of
37 (# s1#, n# #) -> (# s1#, I# n# #)
38 writeArray# arr# i# (I# n#) s# = writeIntArray# arr# i# n# s#
39
40 arraySize :: Unbox a => a -> Int -> Int
41 {-# INLINE arraySize #-}
42 arraySize a (I# i#) = I# (arraySize# a i#)
43
44 newArray :: forall s a. Unbox a => Int -> ST s (MutableArray s a)
45 {-# INLINE newArray #-}
46 newArray (I# n#) = ST $ \s# ->
47 case newByteArray# (arraySize# (undefined :: a) n#) s# of
48 (# s2#, arr# #) -> (# s2#, MutableArray arr# #)
49
50 unsafeFreezeArray :: Unbox a => MutableArray s a -> ST s (Array a)
51 {-# INLINE unsafeFreezeArray #-}
52 unsafeFreezeArray (MutableArray arr#) = ST $ \s# ->
53 case unsafeFreezeByteArray# arr# s# of
54 (# s2, frozen# #) -> (# s2, Array frozen# #)
55
56 indexArray :: Unbox a => Array a -> Int -> a
57 {-# INLINE indexArray #-}
58 indexArray (Array arr#) (I# i#) = indexArray# arr# i#
59
60 readArray :: Unbox a => MutableArray s a -> Int -> ST s a
61 {-# INLINE readArray #-}
62 readArray (MutableArray arr#) (I# i#) = ST $ readArray# arr# i#
63
64 writeArray :: Unbox a => MutableArray s a -> Int -> a -> ST s ()
65 {-# INLINE writeArray #-}
66 writeArray (MutableArray arr#) (I# i#) x = ST $ \s# ->
67 case writeArray# arr# i# x s# of s2# -> (# s2#, () #)
68