[project @ 2001-07-31 13:28:58 by simonmar]
[packages/random.git] / Data / Array / Base.hs
1 {-# OPTIONS -monly-3-regs #-}
2 -----------------------------------------------------------------------------
3 --
4 -- Module : Data.Array.Base
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/core/LICENSE)
7 --
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : non-portable
11 --
12 -- $Id: Base.hs,v 1.2 2001/07/31 13:28:58 simonmar Exp $
13 --
14 -- Basis for IArray and MArray. Not intended for external consumption;
15 -- use IArray or MArray instead.
16 --
17 -----------------------------------------------------------------------------
18
19 module Data.Array.Base where
20
21 import Prelude
22
23 import Data.Ix ( Ix, range, index, rangeSize )
24
25 #ifdef __GLASGOW_HASKELL__
26 import GHC.Arr ( STArray, unsafeIndex )
27 import qualified GHC.Arr
28 import GHC.ST ( ST(..), runST )
29 import GHC.Base
30 import GHC.Word ( Word(..) )
31 import GHC.Ptr ( Ptr(..), FunPtr(..) )
32 import GHC.Float ( Float(..), Double(..) )
33 import GHC.Stable ( StablePtr(..) )
34 import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
35 import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
36 #endif
37
38 import Data.Dynamic
39 #include "Dynamic.h"
40
41 -----------------------------------------------------------------------------
42 -- Class of immutable arrays
43
44 class HasBounds a where
45 bounds :: Ix i => a i e -> (i,i)
46
47 class HasBounds a => IArray a e where
48 unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e
49 unsafeAt :: Ix i => a i e -> Int -> e
50 unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e
51 unsafeAccum :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e
52 unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e
53
54 unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze)
55 unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze)
56 unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze)
57
58 {-# INLINE unsafeReplaceST #-}
59 unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e)
60 unsafeReplaceST arr ies = do
61 marr <- thaw arr
62 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
63 return marr
64
65 {-# INLINE unsafeAccumST #-}
66 unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e)
67 unsafeAccumST f arr ies = do
68 marr <- thaw arr
69 sequence_ [do
70 old <- unsafeRead marr i
71 unsafeWrite marr i (f old new)
72 | (i, new) <- ies]
73 return marr
74
75 {-# INLINE unsafeAccumArrayST #-}
76 unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e)
77 unsafeAccumArrayST f e (l,u) ies = do
78 marr <- newArray (l,u) e
79 sequence_ [do
80 old <- unsafeRead marr i
81 unsafeWrite marr i (f old new)
82 | (i, new) <- ies]
83 return marr
84
85 {-# INLINE array #-}
86 array :: (IArray a e, Ix i) => (i,i) -> [(i, e)] -> a i e
87 array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
88
89 -- Since unsafeFreeze is not guaranteed to be only a cast, we will
90 -- use unsafeArray and zip instead of a specialized loop to implement
91 -- listArray, unlike Array.listArray, even though it generates some
92 -- unnecessary heap allocation. Will use the loop only when we have
93 -- fast unsafeFreeze, namely for Array and UArray (well, they cover
94 -- almost all cases).
95
96 {-# INLINE listArray #-}
97 listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e
98 listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
99
100 {-# INLINE listArrayST #-}
101 listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e)
102 listArrayST (l,u) es = do
103 marr <- newArray_ (l,u)
104 let n = rangeSize (l,u)
105 let fillFromList i xs | i == n = return ()
106 | otherwise = case xs of
107 [] -> return ()
108 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
109 fillFromList 0 es
110 return marr
111
112 {-# RULES
113 "listArray/Array" listArray =
114 \lu es -> runST (listArrayST lu es >>= GHC.Arr.unsafeFreezeSTArray)
115 #-}
116
117 {-# INLINE listUArrayST #-}
118 listUArrayST :: (MArray (STUArray s) e (ST s), Ix i)
119 => (i,i) -> [e] -> ST s (STUArray s i e)
120 listUArrayST (l,u) es = do
121 marr <- newArray_ (l,u)
122 let n = rangeSize (l,u)
123 let fillFromList i xs | i == n = return ()
124 | otherwise = case xs of
125 [] -> return ()
126 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
127 fillFromList 0 es
128 return marr
129
130 -- I don't know how to write a single rule for listUArrayST, because
131 -- the type looks like constrained over 's', which runST doesn't
132 -- like. In fact all MArray (STUArray s) instances are polymorphic
133 -- wrt. 's', but runST can't know that.
134
135 -- I would like to write a rule for listUArrayST (or listArray or
136 -- whatever) applied to unpackCString#. Unfortunately unpackCString#
137 -- calls seem to be floated out, then floated back into the middle
138 -- of listUArrayST, so I was not able to do this.
139
140 {-# RULES
141 "listArray/UArray/Bool" listArray = \lu (es :: [Bool]) ->
142 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
143 "listArray/UArray/Char" listArray = \lu (es :: [Char]) ->
144 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
145 "listArray/UArray/Int" listArray = \lu (es :: [Int]) ->
146 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
147 "listArray/UArray/Word" listArray = \lu (es :: [Word]) ->
148 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
149 "listArray/UArray/Ptr" listArray = \lu (es :: [Ptr a]) ->
150 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
151 "listArray/UArray/FunPtr" listArray = \lu (es :: [FunPtr a]) ->
152 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
153 "listArray/UArray/Float" listArray = \lu (es :: [Float]) ->
154 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
155 "listArray/UArray/Double" listArray = \lu (es :: [Double]) ->
156 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
157 "listArray/UArray/StablePtr" listArray = \lu (es :: [StablePtr a]) ->
158 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
159 "listArray/UArray/Int8" listArray = \lu (es :: [Int8]) ->
160 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
161 "listArray/UArray/Int16" listArray = \lu (es :: [Int16]) ->
162 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
163 "listArray/UArray/Int32" listArray = \lu (es :: [Int32]) ->
164 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
165 "listArray/UArray/Int64" listArray = \lu (es :: [Int64]) ->
166 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
167 "listArray/UArray/Word8" listArray = \lu (es :: [Word8]) ->
168 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
169 "listArray/UArray/Word16" listArray = \lu (es :: [Word16]) ->
170 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
171 "listArray/UArray/Word32" listArray = \lu (es :: [Word32]) ->
172 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
173 "listArray/UArray/Word64" listArray = \lu (es :: [Word64]) ->
174 runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
175 #-}
176
177 {-# INLINE (!) #-}
178 (!) :: (IArray a e, Ix i) => a i e -> i -> e
179 arr ! i | (l,u) <- bounds arr = unsafeAt arr (index (l,u) i)
180
181 {-# INLINE indices #-}
182 indices :: (HasBounds a, Ix i) => a i e -> [i]
183 indices arr | (l,u) <- bounds arr = range (l,u)
184
185 {-# INLINE elems #-}
186 elems :: (IArray a e, Ix i) => a i e -> [e]
187 elems arr | (l,u) <- bounds arr =
188 [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
189
190 {-# INLINE assocs #-}
191 assocs :: (IArray a e, Ix i) => a i e -> [(i, e)]
192 assocs arr | (l,u) <- bounds arr =
193 [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
194
195 {-# INLINE accumArray #-}
196 accumArray :: (IArray a e, Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(i, e')] -> a i e
197 accumArray f init (l,u) ies =
198 unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
199
200 {-# INLINE (//) #-}
201 (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e
202 arr // ies | (l,u) <- bounds arr =
203 unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
204
205 {-# INLINE accum #-}
206 accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e
207 accum f arr ies | (l,u) <- bounds arr =
208 unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
209
210 {-# INLINE amap #-}
211 amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e
212 amap f arr | (l,u) <- bounds arr =
213 unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
214
215 {-# INLINE ixmap #-}
216 ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e
217 ixmap (l,u) f arr =
218 unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
219
220 -----------------------------------------------------------------------------
221 -- Normal polymorphic arrays
222
223 instance HasBounds GHC.Arr.Array where
224 {-# INLINE bounds #-}
225 bounds = GHC.Arr.bounds
226
227 instance IArray GHC.Arr.Array e where
228 {-# INLINE unsafeArray #-}
229 unsafeArray = GHC.Arr.unsafeArray
230 {-# INLINE unsafeAt #-}
231 unsafeAt = GHC.Arr.unsafeAt
232 {-# INLINE unsafeReplace #-}
233 unsafeReplace = GHC.Arr.unsafeReplace
234 {-# INLINE unsafeAccum #-}
235 unsafeAccum = GHC.Arr.unsafeAccum
236 {-# INLINE unsafeAccumArray #-}
237 unsafeAccumArray = GHC.Arr.unsafeAccumArray
238
239 -----------------------------------------------------------------------------
240 -- Flat unboxed arrays
241
242 data UArray i e = UArray !i !i ByteArray#
243
244 INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
245
246 instance HasBounds UArray where
247 {-# INLINE bounds #-}
248 bounds (UArray l u _) = (l,u)
249
250 {-# INLINE unsafeArrayUArray #-}
251 unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
252 => (i,i) -> [(Int, e)] -> ST s (UArray i e)
253 unsafeArrayUArray (l,u) ies = do
254 marr <- newArray_ (l,u)
255 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
256 unsafeFreezeSTUArray marr
257
258 {-# INLINE unsafeFreezeSTUArray #-}
259 unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e)
260 unsafeFreezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
261 case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) ->
262 (# s2#, UArray l u arr# #) }
263
264 {-# INLINE unsafeReplaceUArray #-}
265 unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i)
266 => UArray i e -> [(Int, e)] -> ST s (UArray i e)
267 unsafeReplaceUArray arr ies = do
268 marr <- thawSTUArray arr
269 sequence_ [unsafeWrite marr i e | (i, e) <- ies]
270 unsafeFreezeSTUArray marr
271
272 {-# INLINE unsafeAccumUArray #-}
273 unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i)
274 => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e)
275 unsafeAccumUArray f arr ies = do
276 marr <- thawSTUArray arr
277 sequence_ [do
278 old <- unsafeRead marr i
279 unsafeWrite marr i (f old new)
280 | (i, new) <- ies]
281 unsafeFreezeSTUArray marr
282
283 {-# INLINE unsafeAccumArrayUArray #-}
284 unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
285 => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e)
286 unsafeAccumArrayUArray f init (l,u) ies = do
287 marr <- newArray (l,u) init
288 sequence_ [do
289 old <- unsafeRead marr i
290 unsafeWrite marr i (f old new)
291 | (i, new) <- ies]
292 unsafeFreezeSTUArray marr
293
294 {-# INLINE eqUArray #-}
295 eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool
296 eqUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
297 if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
298 l1 == l2 && u1 == u2 &&
299 and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
300
301 {-# INLINE cmpUArray #-}
302 cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering
303 cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
304
305 {-# INLINE cmpIntUArray #-}
306 cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering
307 cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
308 if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
309 if rangeSize (l2,u2) == 0 then GT else
310 case compare l1 l2 of
311 EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
312 other -> other
313 where
314 cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
315 EQ -> rest
316 other -> other
317
318 {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
319
320 showsUArray :: (IArray UArray e, Ix i, Show i, Show e)
321 => Int -> UArray i e -> ShowS
322 showsUArray p a =
323 showParen (p > 9) $
324 showString "array " .
325 shows (bounds a) .
326 showChar ' ' .
327 shows (assocs a)
328
329 -----------------------------------------------------------------------------
330 -- Flat unboxed arrays: instances
331
332 instance IArray UArray Bool where
333 {-# INLINE unsafeArray #-}
334 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
335 {-# INLINE unsafeAt #-}
336 unsafeAt (UArray _ _ arr#) (I# i#) =
337 (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
338 `neWord#` int2Word# 0#
339 {-# INLINE unsafeReplace #-}
340 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
341 {-# INLINE unsafeAccum #-}
342 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
343 {-# INLINE unsafeAccumArray #-}
344 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
345
346 instance IArray UArray Char where
347 {-# INLINE unsafeArray #-}
348 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
349 {-# INLINE unsafeAt #-}
350 unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
351 {-# INLINE unsafeReplace #-}
352 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
353 {-# INLINE unsafeAccum #-}
354 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
355 {-# INLINE unsafeAccumArray #-}
356 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
357
358 instance IArray UArray Int where
359 {-# INLINE unsafeArray #-}
360 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
361 {-# INLINE unsafeAt #-}
362 unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
363 {-# INLINE unsafeReplace #-}
364 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
365 {-# INLINE unsafeAccum #-}
366 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
367 {-# INLINE unsafeAccumArray #-}
368 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
369
370 instance IArray UArray Word where
371 {-# INLINE unsafeArray #-}
372 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
373 {-# INLINE unsafeAt #-}
374 unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
375 {-# INLINE unsafeReplace #-}
376 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
377 {-# INLINE unsafeAccum #-}
378 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
379 {-# INLINE unsafeAccumArray #-}
380 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
381
382 instance IArray UArray (Ptr a) where
383 {-# INLINE unsafeArray #-}
384 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
385 {-# INLINE unsafeAt #-}
386 unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
387 {-# INLINE unsafeReplace #-}
388 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
389 {-# INLINE unsafeAccum #-}
390 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
391 {-# INLINE unsafeAccumArray #-}
392 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
393
394 instance IArray UArray (FunPtr a) where
395 {-# INLINE unsafeArray #-}
396 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
397 {-# INLINE unsafeAt #-}
398 unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
399 {-# INLINE unsafeReplace #-}
400 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
401 {-# INLINE unsafeAccum #-}
402 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
403 {-# INLINE unsafeAccumArray #-}
404 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
405
406 instance IArray UArray Float where
407 {-# INLINE unsafeArray #-}
408 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
409 {-# INLINE unsafeAt #-}
410 unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
411 {-# INLINE unsafeReplace #-}
412 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
413 {-# INLINE unsafeAccum #-}
414 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
415 {-# INLINE unsafeAccumArray #-}
416 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
417
418 instance IArray UArray Double where
419 {-# INLINE unsafeArray #-}
420 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
421 {-# INLINE unsafeAt #-}
422 unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
423 {-# INLINE unsafeReplace #-}
424 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
425 {-# INLINE unsafeAccum #-}
426 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
427 {-# INLINE unsafeAccumArray #-}
428 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
429
430 instance IArray UArray (StablePtr a) where
431 {-# INLINE unsafeArray #-}
432 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
433 {-# INLINE unsafeAt #-}
434 unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
435 {-# INLINE unsafeReplace #-}
436 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
437 {-# INLINE unsafeAccum #-}
438 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
439 {-# INLINE unsafeAccumArray #-}
440 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
441
442 instance IArray UArray Int8 where
443 {-# INLINE unsafeArray #-}
444 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
445 {-# INLINE unsafeAt #-}
446 unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
447 {-# INLINE unsafeReplace #-}
448 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
449 {-# INLINE unsafeAccum #-}
450 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
451 {-# INLINE unsafeAccumArray #-}
452 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
453
454 instance IArray UArray Int16 where
455 {-# INLINE unsafeArray #-}
456 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
457 {-# INLINE unsafeAt #-}
458 unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
459 {-# INLINE unsafeReplace #-}
460 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
461 {-# INLINE unsafeAccum #-}
462 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
463 {-# INLINE unsafeAccumArray #-}
464 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
465
466 instance IArray UArray Int32 where
467 {-# INLINE unsafeArray #-}
468 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
469 {-# INLINE unsafeAt #-}
470 unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
471 {-# INLINE unsafeReplace #-}
472 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
473 {-# INLINE unsafeAccum #-}
474 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
475 {-# INLINE unsafeAccumArray #-}
476 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
477
478 instance IArray UArray Int64 where
479 {-# INLINE unsafeArray #-}
480 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
481 {-# INLINE unsafeAt #-}
482 unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
483 {-# INLINE unsafeReplace #-}
484 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
485 {-# INLINE unsafeAccum #-}
486 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
487 {-# INLINE unsafeAccumArray #-}
488 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
489
490 instance IArray UArray Word8 where
491 {-# INLINE unsafeArray #-}
492 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
493 {-# INLINE unsafeAt #-}
494 unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
495 {-# INLINE unsafeReplace #-}
496 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
497 {-# INLINE unsafeAccum #-}
498 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
499 {-# INLINE unsafeAccumArray #-}
500 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
501
502 instance IArray UArray Word16 where
503 {-# INLINE unsafeArray #-}
504 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
505 {-# INLINE unsafeAt #-}
506 unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
507 {-# INLINE unsafeReplace #-}
508 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
509 {-# INLINE unsafeAccum #-}
510 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
511 {-# INLINE unsafeAccumArray #-}
512 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
513
514 instance IArray UArray Word32 where
515 {-# INLINE unsafeArray #-}
516 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
517 {-# INLINE unsafeAt #-}
518 unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
519 {-# INLINE unsafeReplace #-}
520 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
521 {-# INLINE unsafeAccum #-}
522 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
523 {-# INLINE unsafeAccumArray #-}
524 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
525
526 instance IArray UArray Word64 where
527 {-# INLINE unsafeArray #-}
528 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
529 {-# INLINE unsafeAt #-}
530 unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
531 {-# INLINE unsafeReplace #-}
532 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
533 {-# INLINE unsafeAccum #-}
534 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
535 {-# INLINE unsafeAccumArray #-}
536 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
537
538 instance Ix ix => Eq (UArray ix Bool) where
539 (==) = eqUArray
540
541 instance Ix ix => Eq (UArray ix Char) where
542 (==) = eqUArray
543
544 instance Ix ix => Eq (UArray ix Int) where
545 (==) = eqUArray
546
547 instance Ix ix => Eq (UArray ix Word) where
548 (==) = eqUArray
549
550 instance Ix ix => Eq (UArray ix (Ptr a)) where
551 (==) = eqUArray
552
553 instance Ix ix => Eq (UArray ix (FunPtr a)) where
554 (==) = eqUArray
555
556 instance Ix ix => Eq (UArray ix Float) where
557 (==) = eqUArray
558
559 instance Ix ix => Eq (UArray ix Double) where
560 (==) = eqUArray
561
562 instance Ix ix => Eq (UArray ix (StablePtr a)) where
563 (==) = eqUArray
564
565 instance Ix ix => Eq (UArray ix Int8) where
566 (==) = eqUArray
567
568 instance Ix ix => Eq (UArray ix Int16) where
569 (==) = eqUArray
570
571 instance Ix ix => Eq (UArray ix Int32) where
572 (==) = eqUArray
573
574 instance Ix ix => Eq (UArray ix Int64) where
575 (==) = eqUArray
576
577 instance Ix ix => Eq (UArray ix Word8) where
578 (==) = eqUArray
579
580 instance Ix ix => Eq (UArray ix Word16) where
581 (==) = eqUArray
582
583 instance Ix ix => Eq (UArray ix Word32) where
584 (==) = eqUArray
585
586 instance Ix ix => Eq (UArray ix Word64) where
587 (==) = eqUArray
588
589 instance Ix ix => Ord (UArray ix Bool) where
590 compare = cmpUArray
591
592 instance Ix ix => Ord (UArray ix Char) where
593 compare = cmpUArray
594
595 instance Ix ix => Ord (UArray ix Int) where
596 compare = cmpUArray
597
598 instance Ix ix => Ord (UArray ix Word) where
599 compare = cmpUArray
600
601 instance Ix ix => Ord (UArray ix (Ptr a)) where
602 compare = cmpUArray
603
604 instance Ix ix => Ord (UArray ix (FunPtr a)) where
605 compare = cmpUArray
606
607 instance Ix ix => Ord (UArray ix Float) where
608 compare = cmpUArray
609
610 instance Ix ix => Ord (UArray ix Double) where
611 compare = cmpUArray
612
613 instance Ix ix => Ord (UArray ix Int8) where
614 compare = cmpUArray
615
616 instance Ix ix => Ord (UArray ix Int16) where
617 compare = cmpUArray
618
619 instance Ix ix => Ord (UArray ix Int32) where
620 compare = cmpUArray
621
622 instance Ix ix => Ord (UArray ix Int64) where
623 compare = cmpUArray
624
625 instance Ix ix => Ord (UArray ix Word8) where
626 compare = cmpUArray
627
628 instance Ix ix => Ord (UArray ix Word16) where
629 compare = cmpUArray
630
631 instance Ix ix => Ord (UArray ix Word32) where
632 compare = cmpUArray
633
634 instance Ix ix => Ord (UArray ix Word64) where
635 compare = cmpUArray
636
637 instance (Ix ix, Show ix) => Show (UArray ix Bool) where
638 showsPrec = showsUArray
639
640 instance (Ix ix, Show ix) => Show (UArray ix Char) where
641 showsPrec = showsUArray
642
643 instance (Ix ix, Show ix) => Show (UArray ix Int) where
644 showsPrec = showsUArray
645
646 instance (Ix ix, Show ix) => Show (UArray ix Word) where
647 showsPrec = showsUArray
648
649 instance (Ix ix, Show ix) => Show (UArray ix Float) where
650 showsPrec = showsUArray
651
652 instance (Ix ix, Show ix) => Show (UArray ix Double) where
653 showsPrec = showsUArray
654
655 instance (Ix ix, Show ix) => Show (UArray ix Int8) where
656 showsPrec = showsUArray
657
658 instance (Ix ix, Show ix) => Show (UArray ix Int16) where
659 showsPrec = showsUArray
660
661 instance (Ix ix, Show ix) => Show (UArray ix Int32) where
662 showsPrec = showsUArray
663
664 instance (Ix ix, Show ix) => Show (UArray ix Int64) where
665 showsPrec = showsUArray
666
667 instance (Ix ix, Show ix) => Show (UArray ix Word8) where
668 showsPrec = showsUArray
669
670 instance (Ix ix, Show ix) => Show (UArray ix Word16) where
671 showsPrec = showsUArray
672
673 instance (Ix ix, Show ix) => Show (UArray ix Word32) where
674 showsPrec = showsUArray
675
676 instance (Ix ix, Show ix) => Show (UArray ix Word64) where
677 showsPrec = showsUArray
678
679 -----------------------------------------------------------------------------
680 -- Mutable arrays
681
682 {-# NOINLINE arrEleBottom #-}
683 arrEleBottom :: a
684 arrEleBottom = error "MArray: undefined array element"
685
686 class (HasBounds a, Monad m) => MArray a e m where
687 newArray :: Ix i => (i,i) -> e -> m (a i e)
688 newArray_ :: Ix i => (i,i) -> m (a i e)
689 unsafeRead :: Ix i => a i e -> Int -> m e
690 unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
691
692 newArray (l,u) init = do
693 marr <- newArray_ (l,u)
694 sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
695 return marr
696
697 newArray_ (l,u) = newArray (l,u) arrEleBottom
698
699 -- newArray takes an initialiser which all elements of
700 -- the newly created array are initialised to. newArray_ takes
701 -- no initialiser, it is assumed that the array is initialised with
702 -- "undefined" values.
703
704 -- why not omit newArray_? Because in the unboxed array case we would
705 -- like to omit the initialisation altogether if possible. We can't do
706 -- this for boxed arrays, because the elements must all have valid values
707 -- at all times in case of garbage collection.
708
709 -- why not omit newArray? Because in the boxed case, we can omit the
710 -- default initialisation with undefined values if we *do* know the
711 -- initial value and it is constant for all elements.
712
713 {-# INLINE newListArray #-}
714 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
715 newListArray (l,u) es = do
716 marr <- newArray_ (l,u)
717 let n = rangeSize (l,u)
718 let fillFromList i xs | i == n = return ()
719 | otherwise = case xs of
720 [] -> return ()
721 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
722 fillFromList 0 es
723 return marr
724
725 {-# INLINE readArray #-}
726 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
727 readArray marr i | (l,u) <- bounds marr =
728 unsafeRead marr (index (l,u) i)
729
730 {-# INLINE writeArray #-}
731 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
732 writeArray marr i e | (l,u) <- bounds marr =
733 unsafeWrite marr (index (l,u) i) e
734
735 {-# INLINE getElems #-}
736 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
737 getElems marr | (l,u) <- bounds marr =
738 sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
739
740 {-# INLINE getAssocs #-}
741 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
742 getAssocs marr | (l,u) <- bounds marr =
743 sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
744 | i <- range (l,u)]
745
746 {-# INLINE mapArray #-}
747 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
748 mapArray f marr | (l,u) <- bounds marr = do
749 marr' <- newArray_ (l,u)
750 sequence_ [do
751 e <- unsafeRead marr i
752 unsafeWrite marr' i (f e)
753 | i <- [0 .. rangeSize (l,u) - 1]]
754 return marr'
755
756 {-# INLINE mapIndices #-}
757 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
758 mapIndices (l,u) f marr = do
759 marr' <- newArray_ (l,u)
760 sequence_ [do
761 e <- readArray marr (f i)
762 unsafeWrite marr' (unsafeIndex (l,u) i) e
763 | i <- range (l,u)]
764 return marr'
765
766 -----------------------------------------------------------------------------
767 -- Polymorphic non-strict mutable arrays (ST monad)
768
769 instance HasBounds (STArray s) where
770 {-# INLINE bounds #-}
771 bounds = GHC.Arr.boundsSTArray
772
773 instance MArray (STArray s) e (ST s) where
774 {-# INLINE newArray #-}
775 newArray = GHC.Arr.newSTArray
776 {-# INLINE unsafeRead #-}
777 unsafeRead = GHC.Arr.unsafeReadSTArray
778 {-# INLINE unsafeWrite #-}
779 unsafeWrite = GHC.Arr.unsafeWriteSTArray
780
781 -----------------------------------------------------------------------------
782 -- Typeable instance for STArray
783
784 sTArrayTc :: TyCon
785 sTArrayTc = mkTyCon "STArray"
786
787 instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where
788 typeOf a = mkAppTy sTArrayTc [typeOf ((undefined :: STArray a b c -> a) a),
789 typeOf ((undefined :: STArray a b c -> b) a),
790 typeOf ((undefined :: STArray a b c -> c) a)]
791
792 -----------------------------------------------------------------------------
793 -- Flat unboxed mutable arrays (ST monad)
794
795 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
796
797 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
798
799 instance HasBounds (STUArray s) where
800 {-# INLINE bounds #-}
801 bounds (STUArray l u _) = (l,u)
802
803 instance MArray (STUArray s) Bool (ST s) where
804 {-# INLINE newArray #-}
805 newArray (l,u) init = ST $ \s1# ->
806 case rangeSize (l,u) of { I# n# ->
807 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
808 case bOOL_WORD_SCALE n# of { n'# ->
809 let loop i# s3# | i# ==# n'# = s3#
810 | otherwise =
811 case writeWordArray# marr# i# e# s3# of { s4# ->
812 loop (i# +# 1#) s4# } in
813 case loop 0# s2# of { s3# ->
814 (# s3#, STUArray l u marr# #) }}}}
815 where
816 W# e# = if init then maxBound else 0
817 {-# INLINE newArray_ #-}
818 newArray_ (l,u) = ST $ \s1# ->
819 case rangeSize (l,u) of { I# n# ->
820 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
821 (# s2#, STUArray l u marr# #) }}
822 {-# INLINE unsafeRead #-}
823 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
824 case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
825 (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
826 {-# INLINE unsafeWrite #-}
827 unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
828 case bOOL_INDEX i# of { j# ->
829 case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
830 case if e then old# `or#` bOOL_BIT i#
831 else old# `and#` bOOL_NOT_BIT i# of { e# ->
832 case writeWordArray# marr# j# e# s2# of { s3# ->
833 (# s3#, () #) }}}}
834
835 instance MArray (STUArray s) Char (ST s) where
836 {-# INLINE newArray_ #-}
837 newArray_ (l,u) = ST $ \s1# ->
838 case rangeSize (l,u) of { I# n# ->
839 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
840 (# s2#, STUArray l u marr# #) }}
841 {-# INLINE unsafeRead #-}
842 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
843 case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
844 (# s2#, C# e# #) }
845 {-# INLINE unsafeWrite #-}
846 unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
847 case writeWideCharArray# marr# i# e# s1# of { s2# ->
848 (# s2#, () #) }
849
850 instance MArray (STUArray s) Int (ST s) where
851 {-# INLINE newArray_ #-}
852 newArray_ (l,u) = ST $ \s1# ->
853 case rangeSize (l,u) of { I# n# ->
854 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
855 (# s2#, STUArray l u marr# #) }}
856 {-# INLINE unsafeRead #-}
857 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
858 case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
859 (# s2#, I# e# #) }
860 {-# INLINE unsafeWrite #-}
861 unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
862 case writeIntArray# marr# i# e# s1# of { s2# ->
863 (# s2#, () #) }
864
865 instance MArray (STUArray s) Word (ST s) where
866 {-# INLINE newArray_ #-}
867 newArray_ (l,u) = ST $ \s1# ->
868 case rangeSize (l,u) of { I# n# ->
869 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
870 (# s2#, STUArray l u marr# #) }}
871 {-# INLINE unsafeRead #-}
872 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
873 case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
874 (# s2#, W# e# #) }
875 {-# INLINE unsafeWrite #-}
876 unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
877 case writeWordArray# marr# i# e# s1# of { s2# ->
878 (# s2#, () #) }
879
880 instance MArray (STUArray s) (Ptr a) (ST s) where
881 {-# INLINE newArray_ #-}
882 newArray_ (l,u) = ST $ \s1# ->
883 case rangeSize (l,u) of { I# n# ->
884 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
885 (# s2#, STUArray l u marr# #) }}
886 {-# INLINE unsafeRead #-}
887 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
888 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
889 (# s2#, Ptr e# #) }
890 {-# INLINE unsafeWrite #-}
891 unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
892 case writeAddrArray# marr# i# e# s1# of { s2# ->
893 (# s2#, () #) }
894
895 instance MArray (STUArray s) (FunPtr a) (ST s) where
896 {-# INLINE newArray_ #-}
897 newArray_ (l,u) = ST $ \s1# ->
898 case rangeSize (l,u) of { I# n# ->
899 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
900 (# s2#, STUArray l u marr# #) }}
901 {-# INLINE unsafeRead #-}
902 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
903 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
904 (# s2#, FunPtr e# #) }
905 {-# INLINE unsafeWrite #-}
906 unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
907 case writeAddrArray# marr# i# e# s1# of { s2# ->
908 (# s2#, () #) }
909
910 instance MArray (STUArray s) Float (ST s) where
911 {-# INLINE newArray_ #-}
912 newArray_ (l,u) = ST $ \s1# ->
913 case rangeSize (l,u) of { I# n# ->
914 case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
915 (# s2#, STUArray l u marr# #) }}
916 {-# INLINE unsafeRead #-}
917 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
918 case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
919 (# s2#, F# e# #) }
920 {-# INLINE unsafeWrite #-}
921 unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
922 case writeFloatArray# marr# i# e# s1# of { s2# ->
923 (# s2#, () #) }
924
925 instance MArray (STUArray s) Double (ST s) where
926 {-# INLINE newArray_ #-}
927 newArray_ (l,u) = ST $ \s1# ->
928 case rangeSize (l,u) of { I# n# ->
929 case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
930 (# s2#, STUArray l u marr# #) }}
931 {-# INLINE unsafeRead #-}
932 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
933 case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
934 (# s2#, D# e# #) }
935 {-# INLINE unsafeWrite #-}
936 unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
937 case writeDoubleArray# marr# i# e# s1# of { s2# ->
938 (# s2#, () #) }
939
940 instance MArray (STUArray s) (StablePtr a) (ST s) where
941 {-# INLINE newArray_ #-}
942 newArray_ (l,u) = ST $ \s1# ->
943 case rangeSize (l,u) of { I# n# ->
944 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
945 (# s2#, STUArray l u marr# #) }}
946 {-# INLINE unsafeRead #-}
947 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
948 case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
949 (# s2# , StablePtr e# #) }
950 {-# INLINE unsafeWrite #-}
951 unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
952 case writeStablePtrArray# marr# i# e# s1# of { s2# ->
953 (# s2#, () #) }
954
955 instance MArray (STUArray s) Int8 (ST s) where
956 {-# INLINE newArray_ #-}
957 newArray_ (l,u) = ST $ \s1# ->
958 case rangeSize (l,u) of { I# n# ->
959 case newByteArray# n# s1# of { (# s2#, marr# #) ->
960 (# s2#, STUArray l u marr# #) }}
961 {-# INLINE unsafeRead #-}
962 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
963 case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
964 (# s2#, I8# e# #) }
965 {-# INLINE unsafeWrite #-}
966 unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
967 case writeInt8Array# marr# i# e# s1# of { s2# ->
968 (# s2#, () #) }
969
970 instance MArray (STUArray s) Int16 (ST s) where
971 {-# INLINE newArray_ #-}
972 newArray_ (l,u) = ST $ \s1# ->
973 case rangeSize (l,u) of { I# n# ->
974 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
975 (# s2#, STUArray l u marr# #) }}
976 {-# INLINE unsafeRead #-}
977 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
978 case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
979 (# s2#, I16# e# #) }
980 {-# INLINE unsafeWrite #-}
981 unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
982 case writeInt16Array# marr# i# e# s1# of { s2# ->
983 (# s2#, () #) }
984
985 instance MArray (STUArray s) Int32 (ST s) where
986 {-# INLINE newArray_ #-}
987 newArray_ (l,u) = ST $ \s1# ->
988 case rangeSize (l,u) of { I# n# ->
989 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
990 (# s2#, STUArray l u marr# #) }}
991 {-# INLINE unsafeRead #-}
992 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
993 case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
994 (# s2#, I32# e# #) }
995 {-# INLINE unsafeWrite #-}
996 unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
997 case writeInt32Array# marr# i# e# s1# of { s2# ->
998 (# s2#, () #) }
999
1000 instance MArray (STUArray s) Int64 (ST s) where
1001 {-# INLINE newArray_ #-}
1002 newArray_ (l,u) = ST $ \s1# ->
1003 case rangeSize (l,u) of { I# n# ->
1004 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1005 (# s2#, STUArray l u marr# #) }}
1006 {-# INLINE unsafeRead #-}
1007 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1008 case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1009 (# s2#, I64# e# #) }
1010 {-# INLINE unsafeWrite #-}
1011 unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1012 case writeInt64Array# marr# i# e# s1# of { s2# ->
1013 (# s2#, () #) }
1014
1015 instance MArray (STUArray s) Word8 (ST s) where
1016 {-# INLINE newArray_ #-}
1017 newArray_ (l,u) = ST $ \s1# ->
1018 case rangeSize (l,u) of { I# n# ->
1019 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1020 (# s2#, STUArray l u marr# #) }}
1021 {-# INLINE unsafeRead #-}
1022 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1023 case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1024 (# s2#, W8# e# #) }
1025 {-# INLINE unsafeWrite #-}
1026 unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1027 case writeWord8Array# marr# i# e# s1# of { s2# ->
1028 (# s2#, () #) }
1029
1030 instance MArray (STUArray s) Word16 (ST s) where
1031 {-# INLINE newArray_ #-}
1032 newArray_ (l,u) = ST $ \s1# ->
1033 case rangeSize (l,u) of { I# n# ->
1034 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1035 (# s2#, STUArray l u marr# #) }}
1036 {-# INLINE unsafeRead #-}
1037 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1038 case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1039 (# s2#, W16# e# #) }
1040 {-# INLINE unsafeWrite #-}
1041 unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1042 case writeWord16Array# marr# i# e# s1# of { s2# ->
1043 (# s2#, () #) }
1044
1045 instance MArray (STUArray s) Word32 (ST s) where
1046 {-# INLINE newArray_ #-}
1047 newArray_ (l,u) = ST $ \s1# ->
1048 case rangeSize (l,u) of { I# n# ->
1049 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1050 (# s2#, STUArray l u marr# #) }}
1051 {-# INLINE unsafeRead #-}
1052 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1053 case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1054 (# s2#, W32# e# #) }
1055 {-# INLINE unsafeWrite #-}
1056 unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1057 case writeWord32Array# marr# i# e# s1# of { s2# ->
1058 (# s2#, () #) }
1059
1060 instance MArray (STUArray s) Word64 (ST s) where
1061 {-# INLINE newArray_ #-}
1062 newArray_ (l,u) = ST $ \s1# ->
1063 case rangeSize (l,u) of { I# n# ->
1064 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1065 (# s2#, STUArray l u marr# #) }}
1066 {-# INLINE unsafeRead #-}
1067 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1068 case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1069 (# s2#, W64# e# #) }
1070 {-# INLINE unsafeWrite #-}
1071 unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1072 case writeWord64Array# marr# i# e# s1# of { s2# ->
1073 (# s2#, () #) }
1074
1075 -----------------------------------------------------------------------------
1076 -- Translation between elements and bytes
1077
1078 #include "config.h"
1079
1080 bOOL_SCALE, bOOL_WORD_SCALE,
1081 wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1082 bOOL_SCALE n# = (n# +# last#) `iShiftRA#` 3#
1083 where I# last# = SIZEOF_VOID_P * 8 - 1
1084 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1085 where I# last# = SIZEOF_VOID_P * 8 - 1
1086 wORD_SCALE n# = scale# *# n# where I# scale# = SIZEOF_VOID_P
1087 dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_DOUBLE
1088 fLOAT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_FLOAT
1089
1090 bOOL_INDEX :: Int# -> Int#
1091 #if SIZEOF_VOID_P == 4
1092 bOOL_INDEX i# = i# `iShiftRA#` 5#
1093 #else
1094 bOOL_INDEX i# = i# `iShiftRA#` 6#
1095 #endif
1096
1097 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1098 bOOL_BIT n# = int2Word# 1# `shiftL#` (word2Int# (int2Word# n# `and#` mask#))
1099 where W# mask# = SIZEOF_VOID_P * 8 - 1
1100 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1101
1102 -----------------------------------------------------------------------------
1103 -- Freezing
1104
1105 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1106 freeze marr | (l,u) <- bounds marr = do
1107 ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1108 | i <- [0 .. rangeSize (l,u) - 1]]
1109 return (unsafeArray (l,u) ies)
1110
1111 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1112 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1113 case sizeofMutableByteArray# marr# of { n# ->
1114 case newByteArray# n# s1# of { (# s2#, marr'# #) ->
1115 case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
1116 case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1117 (# s4#, UArray l u arr# #) }}}}
1118
1119 {-# RULES
1120 "freeze/STArray" freeze = GHC.Arr.freezeSTArray
1121 "freeze/STUArray" freeze = freezeSTUArray
1122 #-}
1123
1124 -- In-place conversion of mutable arrays to immutable ones places
1125 -- a proof obligation on the user: no other parts of your code can
1126 -- have a reference to the array at the point where you unsafely
1127 -- freeze it (and, subsequently mutate it, I suspect).
1128
1129 {-# INLINE unsafeFreeze #-}
1130 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1131 unsafeFreeze = freeze
1132
1133 {-# RULES
1134 "unsafeFreeze/STArray" unsafeFreeze = GHC.Arr.unsafeFreezeSTArray
1135 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1136 #-}
1137
1138 -----------------------------------------------------------------------------
1139 -- Thawing
1140
1141 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1142 thaw arr | (l,u) <- bounds arr = do
1143 marr <- newArray_ (l,u)
1144 sequence_ [unsafeWrite marr i (unsafeAt arr i)
1145 | i <- [0 .. rangeSize (l,u) - 1]]
1146 return marr
1147
1148 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1149 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1150 case sizeofByteArray# arr# of { n# ->
1151 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1152 case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
1153 (# s3#, STUArray l u marr# #) }}}
1154
1155 foreign import "memcpy" unsafe
1156 memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
1157
1158 {-# RULES
1159 "thaw/STArray" thaw = GHC.Arr.thawSTArray
1160 "thaw/STUArray" thaw = thawSTUArray
1161 #-}
1162
1163 -- In-place conversion of immutable arrays to mutable ones places
1164 -- a proof obligation on the user: no other parts of your code can
1165 -- have a reference to the array at the point where you unsafely
1166 -- thaw it (and, subsequently mutate it, I suspect).
1167
1168 {-# INLINE unsafeThaw #-}
1169 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1170 unsafeThaw = thaw
1171
1172 {-# INLINE unsafeThawSTUArray #-}
1173 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1174 unsafeThawSTUArray (UArray l u marr#) =
1175 return (STUArray l u (unsafeCoerce# marr#))
1176
1177 {-# RULES
1178 "unsafeThaw/STArray" unsafeThaw = GHC.Arr.unsafeThawSTArray
1179 "unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray
1180 #-}