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