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