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