[project @ 2002-04-26 13:34:05 by simonmar]
[packages/old-locale.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 -- Basis for IArray and MArray. Not intended for external consumption;
13 -- use IArray or MArray instead.
14 --
15 -----------------------------------------------------------------------------
16
17 module Data.Array.Base where
18
19 import Prelude
20
21 import Data.Ix ( Ix, range, index, rangeSize )
22
23 #ifdef __GLASGOW_HASKELL__
24 import GHC.Arr ( STArray, unsafeIndex )
25 import qualified GHC.Arr
26 import GHC.ST ( ST(..), runST )
27 import GHC.Base
28 import GHC.Word ( Word(..) )
29 import GHC.Ptr ( Ptr(..), FunPtr(..) )
30 import GHC.Float ( Float(..), Double(..) )
31 import GHC.Stable ( StablePtr(..) )
32 import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) )
33 import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) )
34 #endif
35
36 import Data.Dynamic
37 #include "Dynamic.h"
38
39 #include "MachDeps.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 -----------------------------------------------------------------------------
321 -- Showing IArrays
322
323 {-# SPECIALISE
324 showsIArray :: (IArray UArray e, Ix i, Show i, Show e) =>
325 Int -> UArray i e -> ShowS
326 #-}
327
328 showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS
329 showsIArray p a =
330 showParen (p > 9) $
331 showString "array " .
332 shows (bounds a) .
333 showChar ' ' .
334 shows (assocs a)
335
336 -----------------------------------------------------------------------------
337 -- Flat unboxed arrays: instances
338
339 instance IArray UArray Bool where
340 {-# INLINE unsafeArray #-}
341 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
342 {-# INLINE unsafeAt #-}
343 unsafeAt (UArray _ _ arr#) (I# i#) =
344 (indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
345 `neWord#` int2Word# 0#
346 {-# INLINE unsafeReplace #-}
347 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
348 {-# INLINE unsafeAccum #-}
349 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
350 {-# INLINE unsafeAccumArray #-}
351 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
352
353 instance IArray UArray Char where
354 {-# INLINE unsafeArray #-}
355 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
356 {-# INLINE unsafeAt #-}
357 unsafeAt (UArray _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#)
358 {-# INLINE unsafeReplace #-}
359 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
360 {-# INLINE unsafeAccum #-}
361 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
362 {-# INLINE unsafeAccumArray #-}
363 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
364
365 instance IArray UArray Int where
366 {-# INLINE unsafeArray #-}
367 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
368 {-# INLINE unsafeAt #-}
369 unsafeAt (UArray _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#)
370 {-# INLINE unsafeReplace #-}
371 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
372 {-# INLINE unsafeAccum #-}
373 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
374 {-# INLINE unsafeAccumArray #-}
375 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
376
377 instance IArray UArray Word where
378 {-# INLINE unsafeArray #-}
379 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
380 {-# INLINE unsafeAt #-}
381 unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
382 {-# INLINE unsafeReplace #-}
383 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
384 {-# INLINE unsafeAccum #-}
385 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
386 {-# INLINE unsafeAccumArray #-}
387 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
388
389 instance IArray UArray (Ptr a) where
390 {-# INLINE unsafeArray #-}
391 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
392 {-# INLINE unsafeAt #-}
393 unsafeAt (UArray _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#)
394 {-# INLINE unsafeReplace #-}
395 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
396 {-# INLINE unsafeAccum #-}
397 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
398 {-# INLINE unsafeAccumArray #-}
399 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
400
401 instance IArray UArray (FunPtr a) where
402 {-# INLINE unsafeArray #-}
403 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
404 {-# INLINE unsafeAt #-}
405 unsafeAt (UArray _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#)
406 {-# INLINE unsafeReplace #-}
407 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
408 {-# INLINE unsafeAccum #-}
409 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
410 {-# INLINE unsafeAccumArray #-}
411 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
412
413 instance IArray UArray Float where
414 {-# INLINE unsafeArray #-}
415 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
416 {-# INLINE unsafeAt #-}
417 unsafeAt (UArray _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#)
418 {-# INLINE unsafeReplace #-}
419 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
420 {-# INLINE unsafeAccum #-}
421 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
422 {-# INLINE unsafeAccumArray #-}
423 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
424
425 instance IArray UArray Double where
426 {-# INLINE unsafeArray #-}
427 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
428 {-# INLINE unsafeAt #-}
429 unsafeAt (UArray _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#)
430 {-# INLINE unsafeReplace #-}
431 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
432 {-# INLINE unsafeAccum #-}
433 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
434 {-# INLINE unsafeAccumArray #-}
435 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
436
437 instance IArray UArray (StablePtr a) where
438 {-# INLINE unsafeArray #-}
439 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
440 {-# INLINE unsafeAt #-}
441 unsafeAt (UArray _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#)
442 {-# INLINE unsafeReplace #-}
443 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
444 {-# INLINE unsafeAccum #-}
445 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
446 {-# INLINE unsafeAccumArray #-}
447 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
448
449 instance IArray UArray Int8 where
450 {-# INLINE unsafeArray #-}
451 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
452 {-# INLINE unsafeAt #-}
453 unsafeAt (UArray _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#)
454 {-# INLINE unsafeReplace #-}
455 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
456 {-# INLINE unsafeAccum #-}
457 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
458 {-# INLINE unsafeAccumArray #-}
459 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
460
461 instance IArray UArray Int16 where
462 {-# INLINE unsafeArray #-}
463 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
464 {-# INLINE unsafeAt #-}
465 unsafeAt (UArray _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#)
466 {-# INLINE unsafeReplace #-}
467 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
468 {-# INLINE unsafeAccum #-}
469 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
470 {-# INLINE unsafeAccumArray #-}
471 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
472
473 instance IArray UArray Int32 where
474 {-# INLINE unsafeArray #-}
475 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
476 {-# INLINE unsafeAt #-}
477 unsafeAt (UArray _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#)
478 {-# INLINE unsafeReplace #-}
479 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
480 {-# INLINE unsafeAccum #-}
481 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
482 {-# INLINE unsafeAccumArray #-}
483 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
484
485 instance IArray UArray Int64 where
486 {-# INLINE unsafeArray #-}
487 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
488 {-# INLINE unsafeAt #-}
489 unsafeAt (UArray _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#)
490 {-# INLINE unsafeReplace #-}
491 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
492 {-# INLINE unsafeAccum #-}
493 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
494 {-# INLINE unsafeAccumArray #-}
495 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
496
497 instance IArray UArray Word8 where
498 {-# INLINE unsafeArray #-}
499 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
500 {-# INLINE unsafeAt #-}
501 unsafeAt (UArray _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#)
502 {-# INLINE unsafeReplace #-}
503 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
504 {-# INLINE unsafeAccum #-}
505 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
506 {-# INLINE unsafeAccumArray #-}
507 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
508
509 instance IArray UArray Word16 where
510 {-# INLINE unsafeArray #-}
511 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
512 {-# INLINE unsafeAt #-}
513 unsafeAt (UArray _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#)
514 {-# INLINE unsafeReplace #-}
515 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
516 {-# INLINE unsafeAccum #-}
517 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
518 {-# INLINE unsafeAccumArray #-}
519 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
520
521 instance IArray UArray Word32 where
522 {-# INLINE unsafeArray #-}
523 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
524 {-# INLINE unsafeAt #-}
525 unsafeAt (UArray _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#)
526 {-# INLINE unsafeReplace #-}
527 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
528 {-# INLINE unsafeAccum #-}
529 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
530 {-# INLINE unsafeAccumArray #-}
531 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
532
533 instance IArray UArray Word64 where
534 {-# INLINE unsafeArray #-}
535 unsafeArray lu ies = runST (unsafeArrayUArray lu ies)
536 {-# INLINE unsafeAt #-}
537 unsafeAt (UArray _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#)
538 {-# INLINE unsafeReplace #-}
539 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
540 {-# INLINE unsafeAccum #-}
541 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
542 {-# INLINE unsafeAccumArray #-}
543 unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
544
545 instance Ix ix => Eq (UArray ix Bool) where
546 (==) = eqUArray
547
548 instance Ix ix => Eq (UArray ix Char) where
549 (==) = eqUArray
550
551 instance Ix ix => Eq (UArray ix Int) where
552 (==) = eqUArray
553
554 instance Ix ix => Eq (UArray ix Word) where
555 (==) = eqUArray
556
557 instance Ix ix => Eq (UArray ix (Ptr a)) where
558 (==) = eqUArray
559
560 instance Ix ix => Eq (UArray ix (FunPtr a)) where
561 (==) = eqUArray
562
563 instance Ix ix => Eq (UArray ix Float) where
564 (==) = eqUArray
565
566 instance Ix ix => Eq (UArray ix Double) where
567 (==) = eqUArray
568
569 instance Ix ix => Eq (UArray ix (StablePtr a)) where
570 (==) = eqUArray
571
572 instance Ix ix => Eq (UArray ix Int8) where
573 (==) = eqUArray
574
575 instance Ix ix => Eq (UArray ix Int16) where
576 (==) = eqUArray
577
578 instance Ix ix => Eq (UArray ix Int32) where
579 (==) = eqUArray
580
581 instance Ix ix => Eq (UArray ix Int64) where
582 (==) = eqUArray
583
584 instance Ix ix => Eq (UArray ix Word8) where
585 (==) = eqUArray
586
587 instance Ix ix => Eq (UArray ix Word16) where
588 (==) = eqUArray
589
590 instance Ix ix => Eq (UArray ix Word32) where
591 (==) = eqUArray
592
593 instance Ix ix => Eq (UArray ix Word64) where
594 (==) = eqUArray
595
596 instance Ix ix => Ord (UArray ix Bool) where
597 compare = cmpUArray
598
599 instance Ix ix => Ord (UArray ix Char) where
600 compare = cmpUArray
601
602 instance Ix ix => Ord (UArray ix Int) where
603 compare = cmpUArray
604
605 instance Ix ix => Ord (UArray ix Word) where
606 compare = cmpUArray
607
608 instance Ix ix => Ord (UArray ix (Ptr a)) where
609 compare = cmpUArray
610
611 instance Ix ix => Ord (UArray ix (FunPtr a)) where
612 compare = cmpUArray
613
614 instance Ix ix => Ord (UArray ix Float) where
615 compare = cmpUArray
616
617 instance Ix ix => Ord (UArray ix Double) where
618 compare = cmpUArray
619
620 instance Ix ix => Ord (UArray ix Int8) where
621 compare = cmpUArray
622
623 instance Ix ix => Ord (UArray ix Int16) where
624 compare = cmpUArray
625
626 instance Ix ix => Ord (UArray ix Int32) where
627 compare = cmpUArray
628
629 instance Ix ix => Ord (UArray ix Int64) where
630 compare = cmpUArray
631
632 instance Ix ix => Ord (UArray ix Word8) where
633 compare = cmpUArray
634
635 instance Ix ix => Ord (UArray ix Word16) where
636 compare = cmpUArray
637
638 instance Ix ix => Ord (UArray ix Word32) where
639 compare = cmpUArray
640
641 instance Ix ix => Ord (UArray ix Word64) where
642 compare = cmpUArray
643
644 instance (Ix ix, Show ix) => Show (UArray ix Bool) where
645 showsPrec = showsIArray
646
647 instance (Ix ix, Show ix) => Show (UArray ix Char) where
648 showsPrec = showsIArray
649
650 instance (Ix ix, Show ix) => Show (UArray ix Int) where
651 showsPrec = showsIArray
652
653 instance (Ix ix, Show ix) => Show (UArray ix Word) where
654 showsPrec = showsIArray
655
656 instance (Ix ix, Show ix) => Show (UArray ix Float) where
657 showsPrec = showsIArray
658
659 instance (Ix ix, Show ix) => Show (UArray ix Double) where
660 showsPrec = showsIArray
661
662 instance (Ix ix, Show ix) => Show (UArray ix Int8) where
663 showsPrec = showsIArray
664
665 instance (Ix ix, Show ix) => Show (UArray ix Int16) where
666 showsPrec = showsIArray
667
668 instance (Ix ix, Show ix) => Show (UArray ix Int32) where
669 showsPrec = showsIArray
670
671 instance (Ix ix, Show ix) => Show (UArray ix Int64) where
672 showsPrec = showsIArray
673
674 instance (Ix ix, Show ix) => Show (UArray ix Word8) where
675 showsPrec = showsIArray
676
677 instance (Ix ix, Show ix) => Show (UArray ix Word16) where
678 showsPrec = showsIArray
679
680 instance (Ix ix, Show ix) => Show (UArray ix Word32) where
681 showsPrec = showsIArray
682
683 instance (Ix ix, Show ix) => Show (UArray ix Word64) where
684 showsPrec = showsIArray
685
686 -----------------------------------------------------------------------------
687 -- Mutable arrays
688
689 {-# NOINLINE arrEleBottom #-}
690 arrEleBottom :: a
691 arrEleBottom = error "MArray: undefined array element"
692
693 class (HasBounds a, Monad m) => MArray a e m where
694 newArray :: Ix i => (i,i) -> e -> m (a i e)
695 newArray_ :: Ix i => (i,i) -> m (a i e)
696 unsafeRead :: Ix i => a i e -> Int -> m e
697 unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
698
699 newArray (l,u) init = do
700 marr <- newArray_ (l,u)
701 sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
702 return marr
703
704 newArray_ (l,u) = newArray (l,u) arrEleBottom
705
706 -- newArray takes an initialiser which all elements of
707 -- the newly created array are initialised to. newArray_ takes
708 -- no initialiser, it is assumed that the array is initialised with
709 -- "undefined" values.
710
711 -- why not omit newArray_? Because in the unboxed array case we would
712 -- like to omit the initialisation altogether if possible. We can't do
713 -- this for boxed arrays, because the elements must all have valid values
714 -- at all times in case of garbage collection.
715
716 -- why not omit newArray? Because in the boxed case, we can omit the
717 -- default initialisation with undefined values if we *do* know the
718 -- initial value and it is constant for all elements.
719
720 {-# INLINE newListArray #-}
721 newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e)
722 newListArray (l,u) es = do
723 marr <- newArray_ (l,u)
724 let n = rangeSize (l,u)
725 let fillFromList i xs | i == n = return ()
726 | otherwise = case xs of
727 [] -> return ()
728 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys
729 fillFromList 0 es
730 return marr
731
732 {-# INLINE readArray #-}
733 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
734 readArray marr i | (l,u) <- bounds marr =
735 unsafeRead marr (index (l,u) i)
736
737 {-# INLINE writeArray #-}
738 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
739 writeArray marr i e | (l,u) <- bounds marr =
740 unsafeWrite marr (index (l,u) i) e
741
742 {-# INLINE getElems #-}
743 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
744 getElems marr | (l,u) <- bounds marr =
745 sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
746
747 {-# INLINE getAssocs #-}
748 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
749 getAssocs marr | (l,u) <- bounds marr =
750 sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
751 | i <- range (l,u)]
752
753 {-# INLINE mapArray #-}
754 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
755 mapArray f marr | (l,u) <- bounds marr = do
756 marr' <- newArray_ (l,u)
757 sequence_ [do
758 e <- unsafeRead marr i
759 unsafeWrite marr' i (f e)
760 | i <- [0 .. rangeSize (l,u) - 1]]
761 return marr'
762
763 {-# INLINE mapIndices #-}
764 mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
765 mapIndices (l,u) f marr = do
766 marr' <- newArray_ (l,u)
767 sequence_ [do
768 e <- readArray marr (f i)
769 unsafeWrite marr' (unsafeIndex (l,u) i) e
770 | i <- range (l,u)]
771 return marr'
772
773 -----------------------------------------------------------------------------
774 -- Polymorphic non-strict mutable arrays (ST monad)
775
776 instance HasBounds (STArray s) where
777 {-# INLINE bounds #-}
778 bounds = GHC.Arr.boundsSTArray
779
780 instance MArray (STArray s) e (ST s) where
781 {-# INLINE newArray #-}
782 newArray = GHC.Arr.newSTArray
783 {-# INLINE unsafeRead #-}
784 unsafeRead = GHC.Arr.unsafeReadSTArray
785 {-# INLINE unsafeWrite #-}
786 unsafeWrite = GHC.Arr.unsafeWriteSTArray
787
788 -----------------------------------------------------------------------------
789 -- Typeable instance for STArray
790
791 sTArrayTc :: TyCon
792 sTArrayTc = mkTyCon "STArray"
793
794 instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where
795 typeOf a = mkAppTy sTArrayTc [typeOf ((undefined :: STArray a b c -> a) a),
796 typeOf ((undefined :: STArray a b c -> b) a),
797 typeOf ((undefined :: STArray a b c -> c) a)]
798
799 -----------------------------------------------------------------------------
800 -- Flat unboxed mutable arrays (ST monad)
801
802 data STUArray s i a = STUArray !i !i (MutableByteArray# s)
803
804 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
805
806 instance HasBounds (STUArray s) where
807 {-# INLINE bounds #-}
808 bounds (STUArray l u _) = (l,u)
809
810 instance MArray (STUArray s) Bool (ST s) where
811 {-# INLINE newArray #-}
812 newArray (l,u) init = ST $ \s1# ->
813 case rangeSize (l,u) of { I# n# ->
814 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
815 case bOOL_WORD_SCALE n# of { n'# ->
816 let loop i# s3# | i# ==# n'# = s3#
817 | otherwise =
818 case writeWordArray# marr# i# e# s3# of { s4# ->
819 loop (i# +# 1#) s4# } in
820 case loop 0# s2# of { s3# ->
821 (# s3#, STUArray l u marr# #) }}}}
822 where
823 W# e# = if init then maxBound else 0
824 {-# INLINE newArray_ #-}
825 newArray_ (l,u) = ST $ \s1# ->
826 case rangeSize (l,u) of { I# n# ->
827 case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
828 (# s2#, STUArray l u marr# #) }}
829 {-# INLINE unsafeRead #-}
830 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
831 case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) ->
832 (# s2#, (e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0# #) }
833 {-# INLINE unsafeWrite #-}
834 unsafeWrite (STUArray _ _ marr#) (I# i#) e = ST $ \s1# ->
835 case bOOL_INDEX i# of { j# ->
836 case readWordArray# marr# j# s1# of { (# s2#, old# #) ->
837 case if e then old# `or#` bOOL_BIT i#
838 else old# `and#` bOOL_NOT_BIT i# of { e# ->
839 case writeWordArray# marr# j# e# s2# of { s3# ->
840 (# s3#, () #) }}}}
841
842 instance MArray (STUArray s) Char (ST s) where
843 {-# INLINE newArray_ #-}
844 newArray_ (l,u) = ST $ \s1# ->
845 case rangeSize (l,u) of { I# n# ->
846 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
847 (# s2#, STUArray l u marr# #) }}
848 {-# INLINE unsafeRead #-}
849 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
850 case readWideCharArray# marr# i# s1# of { (# s2#, e# #) ->
851 (# s2#, C# e# #) }
852 {-# INLINE unsafeWrite #-}
853 unsafeWrite (STUArray _ _ marr#) (I# i#) (C# e#) = ST $ \s1# ->
854 case writeWideCharArray# marr# i# e# s1# of { s2# ->
855 (# s2#, () #) }
856
857 instance MArray (STUArray s) Int (ST s) where
858 {-# INLINE newArray_ #-}
859 newArray_ (l,u) = ST $ \s1# ->
860 case rangeSize (l,u) of { I# n# ->
861 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
862 (# s2#, STUArray l u marr# #) }}
863 {-# INLINE unsafeRead #-}
864 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
865 case readIntArray# marr# i# s1# of { (# s2#, e# #) ->
866 (# s2#, I# e# #) }
867 {-# INLINE unsafeWrite #-}
868 unsafeWrite (STUArray _ _ marr#) (I# i#) (I# e#) = ST $ \s1# ->
869 case writeIntArray# marr# i# e# s1# of { s2# ->
870 (# s2#, () #) }
871
872 instance MArray (STUArray s) Word (ST s) where
873 {-# INLINE newArray_ #-}
874 newArray_ (l,u) = ST $ \s1# ->
875 case rangeSize (l,u) of { I# n# ->
876 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
877 (# s2#, STUArray l u marr# #) }}
878 {-# INLINE unsafeRead #-}
879 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
880 case readWordArray# marr# i# s1# of { (# s2#, e# #) ->
881 (# s2#, W# e# #) }
882 {-# INLINE unsafeWrite #-}
883 unsafeWrite (STUArray _ _ marr#) (I# i#) (W# e#) = ST $ \s1# ->
884 case writeWordArray# marr# i# e# s1# of { s2# ->
885 (# s2#, () #) }
886
887 instance MArray (STUArray s) (Ptr a) (ST s) where
888 {-# INLINE newArray_ #-}
889 newArray_ (l,u) = ST $ \s1# ->
890 case rangeSize (l,u) of { I# n# ->
891 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
892 (# s2#, STUArray l u marr# #) }}
893 {-# INLINE unsafeRead #-}
894 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
895 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
896 (# s2#, Ptr e# #) }
897 {-# INLINE unsafeWrite #-}
898 unsafeWrite (STUArray _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# ->
899 case writeAddrArray# marr# i# e# s1# of { s2# ->
900 (# s2#, () #) }
901
902 instance MArray (STUArray s) (FunPtr a) (ST s) where
903 {-# INLINE newArray_ #-}
904 newArray_ (l,u) = ST $ \s1# ->
905 case rangeSize (l,u) of { I# n# ->
906 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
907 (# s2#, STUArray l u marr# #) }}
908 {-# INLINE unsafeRead #-}
909 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
910 case readAddrArray# marr# i# s1# of { (# s2#, e# #) ->
911 (# s2#, FunPtr e# #) }
912 {-# INLINE unsafeWrite #-}
913 unsafeWrite (STUArray _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# ->
914 case writeAddrArray# marr# i# e# s1# of { s2# ->
915 (# s2#, () #) }
916
917 instance MArray (STUArray s) Float (ST s) where
918 {-# INLINE newArray_ #-}
919 newArray_ (l,u) = ST $ \s1# ->
920 case rangeSize (l,u) of { I# n# ->
921 case newByteArray# (fLOAT_SCALE n#) s1# of { (# s2#, marr# #) ->
922 (# s2#, STUArray l u marr# #) }}
923 {-# INLINE unsafeRead #-}
924 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
925 case readFloatArray# marr# i# s1# of { (# s2#, e# #) ->
926 (# s2#, F# e# #) }
927 {-# INLINE unsafeWrite #-}
928 unsafeWrite (STUArray _ _ marr#) (I# i#) (F# e#) = ST $ \s1# ->
929 case writeFloatArray# marr# i# e# s1# of { s2# ->
930 (# s2#, () #) }
931
932 instance MArray (STUArray s) Double (ST s) where
933 {-# INLINE newArray_ #-}
934 newArray_ (l,u) = ST $ \s1# ->
935 case rangeSize (l,u) of { I# n# ->
936 case newByteArray# (dOUBLE_SCALE n#) s1# of { (# s2#, marr# #) ->
937 (# s2#, STUArray l u marr# #) }}
938 {-# INLINE unsafeRead #-}
939 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
940 case readDoubleArray# marr# i# s1# of { (# s2#, e# #) ->
941 (# s2#, D# e# #) }
942 {-# INLINE unsafeWrite #-}
943 unsafeWrite (STUArray _ _ marr#) (I# i#) (D# e#) = ST $ \s1# ->
944 case writeDoubleArray# marr# i# e# s1# of { s2# ->
945 (# s2#, () #) }
946
947 instance MArray (STUArray s) (StablePtr a) (ST s) where
948 {-# INLINE newArray_ #-}
949 newArray_ (l,u) = ST $ \s1# ->
950 case rangeSize (l,u) of { I# n# ->
951 case newByteArray# (wORD_SCALE n#) s1# of { (# s2#, marr# #) ->
952 (# s2#, STUArray l u marr# #) }}
953 {-# INLINE unsafeRead #-}
954 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
955 case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) ->
956 (# s2# , StablePtr e# #) }
957 {-# INLINE unsafeWrite #-}
958 unsafeWrite (STUArray _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# ->
959 case writeStablePtrArray# marr# i# e# s1# of { s2# ->
960 (# s2#, () #) }
961
962 instance MArray (STUArray s) Int8 (ST s) where
963 {-# INLINE newArray_ #-}
964 newArray_ (l,u) = ST $ \s1# ->
965 case rangeSize (l,u) of { I# n# ->
966 case newByteArray# n# s1# of { (# s2#, marr# #) ->
967 (# s2#, STUArray l u marr# #) }}
968 {-# INLINE unsafeRead #-}
969 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
970 case readInt8Array# marr# i# s1# of { (# s2#, e# #) ->
971 (# s2#, I8# e# #) }
972 {-# INLINE unsafeWrite #-}
973 unsafeWrite (STUArray _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# ->
974 case writeInt8Array# marr# i# e# s1# of { s2# ->
975 (# s2#, () #) }
976
977 instance MArray (STUArray s) Int16 (ST s) where
978 {-# INLINE newArray_ #-}
979 newArray_ (l,u) = ST $ \s1# ->
980 case rangeSize (l,u) of { I# n# ->
981 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
982 (# s2#, STUArray l u marr# #) }}
983 {-# INLINE unsafeRead #-}
984 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
985 case readInt16Array# marr# i# s1# of { (# s2#, e# #) ->
986 (# s2#, I16# e# #) }
987 {-# INLINE unsafeWrite #-}
988 unsafeWrite (STUArray _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# ->
989 case writeInt16Array# marr# i# e# s1# of { s2# ->
990 (# s2#, () #) }
991
992 instance MArray (STUArray s) Int32 (ST s) where
993 {-# INLINE newArray_ #-}
994 newArray_ (l,u) = ST $ \s1# ->
995 case rangeSize (l,u) of { I# n# ->
996 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
997 (# s2#, STUArray l u marr# #) }}
998 {-# INLINE unsafeRead #-}
999 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1000 case readInt32Array# marr# i# s1# of { (# s2#, e# #) ->
1001 (# s2#, I32# e# #) }
1002 {-# INLINE unsafeWrite #-}
1003 unsafeWrite (STUArray _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# ->
1004 case writeInt32Array# marr# i# e# s1# of { s2# ->
1005 (# s2#, () #) }
1006
1007 instance MArray (STUArray s) Int64 (ST s) where
1008 {-# INLINE newArray_ #-}
1009 newArray_ (l,u) = ST $ \s1# ->
1010 case rangeSize (l,u) of { I# n# ->
1011 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1012 (# s2#, STUArray l u marr# #) }}
1013 {-# INLINE unsafeRead #-}
1014 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1015 case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
1016 (# s2#, I64# e# #) }
1017 {-# INLINE unsafeWrite #-}
1018 unsafeWrite (STUArray _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# ->
1019 case writeInt64Array# marr# i# e# s1# of { s2# ->
1020 (# s2#, () #) }
1021
1022 instance MArray (STUArray s) Word8 (ST s) where
1023 {-# INLINE newArray_ #-}
1024 newArray_ (l,u) = ST $ \s1# ->
1025 case rangeSize (l,u) of { I# n# ->
1026 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1027 (# s2#, STUArray l u marr# #) }}
1028 {-# INLINE unsafeRead #-}
1029 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1030 case readWord8Array# marr# i# s1# of { (# s2#, e# #) ->
1031 (# s2#, W8# e# #) }
1032 {-# INLINE unsafeWrite #-}
1033 unsafeWrite (STUArray _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# ->
1034 case writeWord8Array# marr# i# e# s1# of { s2# ->
1035 (# s2#, () #) }
1036
1037 instance MArray (STUArray s) Word16 (ST s) where
1038 {-# INLINE newArray_ #-}
1039 newArray_ (l,u) = ST $ \s1# ->
1040 case rangeSize (l,u) of { I# n# ->
1041 case newByteArray# (n# *# 2#) s1# of { (# s2#, marr# #) ->
1042 (# s2#, STUArray l u marr# #) }}
1043 {-# INLINE unsafeRead #-}
1044 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1045 case readWord16Array# marr# i# s1# of { (# s2#, e# #) ->
1046 (# s2#, W16# e# #) }
1047 {-# INLINE unsafeWrite #-}
1048 unsafeWrite (STUArray _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# ->
1049 case writeWord16Array# marr# i# e# s1# of { s2# ->
1050 (# s2#, () #) }
1051
1052 instance MArray (STUArray s) Word32 (ST s) where
1053 {-# INLINE newArray_ #-}
1054 newArray_ (l,u) = ST $ \s1# ->
1055 case rangeSize (l,u) of { I# n# ->
1056 case newByteArray# (n# *# 4#) s1# of { (# s2#, marr# #) ->
1057 (# s2#, STUArray l u marr# #) }}
1058 {-# INLINE unsafeRead #-}
1059 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1060 case readWord32Array# marr# i# s1# of { (# s2#, e# #) ->
1061 (# s2#, W32# e# #) }
1062 {-# INLINE unsafeWrite #-}
1063 unsafeWrite (STUArray _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# ->
1064 case writeWord32Array# marr# i# e# s1# of { s2# ->
1065 (# s2#, () #) }
1066
1067 instance MArray (STUArray s) Word64 (ST s) where
1068 {-# INLINE newArray_ #-}
1069 newArray_ (l,u) = ST $ \s1# ->
1070 case rangeSize (l,u) of { I# n# ->
1071 case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
1072 (# s2#, STUArray l u marr# #) }}
1073 {-# INLINE unsafeRead #-}
1074 unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
1075 case readWord64Array# marr# i# s1# of { (# s2#, e# #) ->
1076 (# s2#, W64# e# #) }
1077 {-# INLINE unsafeWrite #-}
1078 unsafeWrite (STUArray _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# ->
1079 case writeWord64Array# marr# i# e# s1# of { s2# ->
1080 (# s2#, () #) }
1081
1082 -----------------------------------------------------------------------------
1083 -- Translation between elements and bytes
1084
1085 bOOL_SCALE, bOOL_WORD_SCALE,
1086 wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
1087 bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
1088 where I# last# = SIZEOF_HSWORD * 8 - 1
1089 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
1090 where I# last# = SIZEOF_HSWORD * 8 - 1
1091 wORD_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSWORD
1092 dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE
1093 fLOAT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT
1094
1095 bOOL_INDEX :: Int# -> Int#
1096 #if SIZEOF_HSWORD == 4
1097 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
1098 #elif SIZEOF_HSWORD == 8
1099 bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#
1100 #endif
1101
1102 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
1103 bOOL_BIT n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
1104 where W# mask# = SIZEOF_HSWORD * 8 - 1
1105 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
1106
1107 -----------------------------------------------------------------------------
1108 -- Freezing
1109
1110 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1111 freeze marr | (l,u) <- bounds marr = do
1112 ies <- sequence [do e <- unsafeRead marr i; return (i,e)
1113 | i <- [0 .. rangeSize (l,u) - 1]]
1114 return (unsafeArray (l,u) ies)
1115
1116 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
1117 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
1118 case sizeofMutableByteArray# marr# of { n# ->
1119 case newByteArray# n# s1# of { (# s2#, marr'# #) ->
1120 case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
1121 case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
1122 (# s4#, UArray l u arr# #) }}}}
1123
1124 {-# RULES
1125 "freeze/STArray" freeze = GHC.Arr.freezeSTArray
1126 "freeze/STUArray" freeze = freezeSTUArray
1127 #-}
1128
1129 -- In-place conversion of mutable arrays to immutable ones places
1130 -- a proof obligation on the user: no other parts of your code can
1131 -- have a reference to the array at the point where you unsafely
1132 -- freeze it (and, subsequently mutate it, I suspect).
1133
1134 {-# INLINE unsafeFreeze #-}
1135 unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
1136 unsafeFreeze = freeze
1137
1138 {-# RULES
1139 "unsafeFreeze/STArray" unsafeFreeze = GHC.Arr.unsafeFreezeSTArray
1140 "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray
1141 #-}
1142
1143 -----------------------------------------------------------------------------
1144 -- Thawing
1145
1146 thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1147 thaw arr | (l,u) <- bounds arr = do
1148 marr <- newArray_ (l,u)
1149 sequence_ [unsafeWrite marr i (unsafeAt arr i)
1150 | i <- [0 .. rangeSize (l,u) - 1]]
1151 return marr
1152
1153 thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1154 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
1155 case sizeofByteArray# arr# of { n# ->
1156 case newByteArray# n# s1# of { (# s2#, marr# #) ->
1157 case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
1158 (# s3#, STUArray l u marr# #) }}}
1159
1160 foreign import ccall unsafe "memcpy"
1161 memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
1162
1163 {-# RULES
1164 "thaw/STArray" thaw = GHC.Arr.thawSTArray
1165 "thaw/STUArray" thaw = thawSTUArray
1166 #-}
1167
1168 -- In-place conversion of immutable arrays to mutable ones places
1169 -- a proof obligation on the user: no other parts of your code can
1170 -- have a reference to the array at the point where you unsafely
1171 -- thaw it (and, subsequently mutate it, I suspect).
1172
1173 {-# INLINE unsafeThaw #-}
1174 unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)
1175 unsafeThaw = thaw
1176
1177 {-# INLINE unsafeThawSTUArray #-}
1178 unsafeThawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
1179 unsafeThawSTUArray (UArray l u marr#) =
1180 return (STUArray l u (unsafeCoerce# marr#))
1181
1182 {-# RULES
1183 "unsafeThaw/STArray" unsafeThaw = GHC.Arr.unsafeThawSTArray
1184 "unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray
1185 #-}