Disable broken array copying primitives for GHC 7.6.* and earlier
[darcs-mirrors/primitive.git] / Data / Primitive / Array.hs
1 {-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-}
2
3 -- |
4 -- Module : Data.Primitive.Array
5 -- Copyright : (c) Roman Leshchinskiy 2009-2012
6 -- License : BSD-style
7 --
8 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
9 -- Portability : non-portable
10 --
11 -- Primitive boxed arrays
12 --
13
14 module Data.Primitive.Array (
15 Array(..), MutableArray(..),
16
17 newArray, readArray, writeArray, indexArray, indexArrayM,
18 unsafeFreezeArray, unsafeThawArray, sameMutableArray,
19 copyArray, copyMutableArray
20 ) where
21
22 import Control.Monad.Primitive
23
24 import GHC.Base ( Int(..) )
25 import GHC.Prim
26
27 import Data.Typeable ( Typeable )
28 import Data.Data ( Data(..) )
29 import Data.Primitive.Internal.Compat ( mkNoRepType )
30
31 -- | Boxed arrays
32 data Array a = Array (Array# a) deriving ( Typeable )
33
34 -- | Mutable boxed arrays associated with a primitive state token.
35 data MutableArray s a = MutableArray (MutableArray# s a)
36 deriving ( Typeable )
37
38 -- | Create a new mutable array of the specified size and initialise all
39 -- elements with the given value.
40 newArray :: PrimMonad m => Int -> a -> m (MutableArray (PrimState m) a)
41 {-# INLINE newArray #-}
42 newArray (I# n#) x = primitive
43 (\s# -> case newArray# n# x s# of
44 (# s'#, arr# #) -> (# s'#, MutableArray arr# #))
45
46 -- | Read a value from the array at the given index.
47 readArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m a
48 {-# INLINE readArray #-}
49 readArray (MutableArray arr#) (I# i#) = primitive (readArray# arr# i#)
50
51 -- | Write a value to the array at the given index.
52 writeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> a -> m ()
53 {-# INLINE writeArray #-}
54 writeArray (MutableArray arr#) (I# i#) x = primitive_ (writeArray# arr# i# x)
55
56 -- | Read a value from the immutable array at the given index.
57 indexArray :: Array a -> Int -> a
58 {-# INLINE indexArray #-}
59 indexArray (Array arr#) (I# i#) = case indexArray# arr# i# of (# x #) -> x
60
61 -- | Monadically read a value from the immutable array at the given index.
62 -- This allows us to be strict in the array while remaining lazy in the read
63 -- element which is very useful for collective operations. Suppose we want to
64 -- copy an array. We could do something like this:
65 --
66 -- > copy marr arr ... = do ...
67 -- > writeArray marr i (indexArray arr i) ...
68 -- > ...
69 --
70 -- But since primitive arrays are lazy, the calls to 'indexArray' will not be
71 -- evaluated. Rather, @marr@ will be filled with thunks each of which would
72 -- retain a reference to @arr@. This is definitely not what we want!
73 --
74 -- With 'indexArrayM', we can instead write
75 --
76 -- > copy marr arr ... = do ...
77 -- > x <- indexArrayM arr i
78 -- > writeArray marr i x
79 -- > ...
80 --
81 -- Now, indexing is executed immediately although the returned element is
82 -- still not evaluated.
83 --
84 indexArrayM :: Monad m => Array a -> Int -> m a
85 {-# INLINE indexArrayM #-}
86 indexArrayM (Array arr#) (I# i#)
87 = case indexArray# arr# i# of (# x #) -> return x
88
89 -- | Convert a mutable array to an immutable one without copying. The
90 -- array should not be modified after the conversion.
91 unsafeFreezeArray :: PrimMonad m => MutableArray (PrimState m) a -> m (Array a)
92 {-# INLINE unsafeFreezeArray #-}
93 unsafeFreezeArray (MutableArray arr#)
94 = primitive (\s# -> case unsafeFreezeArray# arr# s# of
95 (# s'#, arr'# #) -> (# s'#, Array arr'# #))
96
97 -- | Convert an immutable array to an mutable one without copying. The
98 -- immutable array should not be used after the conversion.
99 unsafeThawArray :: PrimMonad m => Array a -> m (MutableArray (PrimState m) a)
100 {-# INLINE unsafeThawArray #-}
101 unsafeThawArray (Array arr#)
102 = primitive (\s# -> case unsafeThawArray# arr# s# of
103 (# s'#, arr'# #) -> (# s'#, MutableArray arr'# #))
104
105 -- | Check whether the two arrays refer to the same memory block.
106 sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool
107 {-# INLINE sameMutableArray #-}
108 sameMutableArray (MutableArray arr#) (MutableArray brr#)
109 = sameMutableArray# arr# brr#
110
111 -- | Copy a slice of an immutable array to a mutable array.
112 copyArray :: PrimMonad m
113 => MutableArray (PrimState m) a -- ^ destination array
114 -> Int -- ^ offset into destination array
115 -> Array a -- ^ source array
116 -> Int -- ^ offset into source array
117 -> Int -- ^ number of elements to copy
118 -> m ()
119 {-# INLINE copyArray #-}
120 #if __GLASGOW_HASKELL__ > 706
121 -- NOTE: copyArray# and copyMutableArray# are slightly broken in GHC 7.6.* and earlier
122 copyArray (MutableArray dst#) (I# doff#) (Array src#) (I# soff#) (I# len#)
123 = primitive_ (copyArray# src# soff# dst# doff# len#)
124 #else
125 copyArray !dst !doff !src !soff !len = go 0
126 where
127 go i | i < len = do
128 x <- indexArrayM src (soff+i)
129 writeArray dst (doff+i) x
130 go (i+1)
131 | otherwise = return ()
132 #endif
133
134 -- | Copy a slice of a mutable array to another array. The two arrays may
135 -- not be the same.
136 copyMutableArray :: PrimMonad m
137 => MutableArray (PrimState m) a -- ^ destination array
138 -> Int -- ^ offset into destination array
139 -> MutableArray (PrimState m) a -- ^ source array
140 -> Int -- ^ offset into source array
141 -> Int -- ^ number of elements to copy
142 -> m ()
143 {-# INLINE copyMutableArray #-}
144 #if __GLASGOW_HASKELL__ >= 706
145 -- NOTE: copyArray# and copyMutableArray# are slightly broken in GHC 7.6.* and earlier
146 copyMutableArray (MutableArray dst#) (I# doff#)
147 (MutableArray src#) (I# soff#) (I# len#)
148 = primitive_ (copyMutableArray# src# soff# dst# doff# len#)
149 #else
150 copyMutableArray !dst !doff !src !soff !len = go 0
151 where
152 go i | i < len = do
153 x <- readArray src (soff+i)
154 writeArray dst (doff+i) x
155 go (i+1)
156 | otherwise = return ()
157 #endif
158
159 instance Typeable a => Data (Array a) where
160 toConstr _ = error "toConstr"
161 gunfold _ _ = error "gunfold"
162 dataTypeOf _ = mkNoRepType "Data.Primitive.Array.Array"
163
164 instance (Typeable s, Typeable a) => Data (MutableArray s a) where
165 toConstr _ = error "toConstr"
166 gunfold _ _ = error "gunfold"
167 dataTypeOf _ = mkNoRepType "Data.Primitive.Array.MutableArray"
168