1 % -----------------------------------------------------------------------------
2 % $Id: Arr.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
4 % (c) The University of Glasgow, 1994-2000
7 \section[GHC.Arr]{Module @GHC.Arr@}
9 Array implementation, @GHC.Arr@ exports the basic array
12 For byte-arrays see @GHC.ByteArr@.
15 {-# OPTIONS -fno-implicit-prelude #-}
19 import {-# SOURCE #-} GHC.Err ( error )
33 %*********************************************************
35 \subsection{The @Ix@ class}
37 %*********************************************************
40 class (Ord a) => Ix a where
42 index, unsafeIndex :: (a,a) -> a -> Int
43 inRange :: (a,a) -> a -> Bool
45 -- Must specify one of index, unsafeIndex
46 index b i | inRange b i = unsafeIndex b i
47 | otherwise = error "Error in array index"
48 unsafeIndex b i = index b i
52 %*********************************************************
54 \subsection{Instances of @Ix@}
56 %*********************************************************
59 -- abstract these errors from the relevant index functions so that
60 -- the guts of the function will be small enough to inline.
62 {-# NOINLINE indexError #-}
63 indexError :: Show a => (a,a) -> a -> String -> b
65 = error (showString "Ix{" . showString tp . showString "}.index: Index " .
66 showParen True (showsPrec 0 i) .
67 showString " out of range " $
68 showParen True (showsPrec 0 rng) "")
70 ----------------------------------------------------------------------
71 instance Ix Char where
75 {-# INLINE unsafeIndex #-}
76 unsafeIndex (m,_n) i = fromEnum i - fromEnum m
78 index b i | inRange b i = unsafeIndex b i
79 | otherwise = indexError b i "Char"
81 inRange (m,n) i = m <= i && i <= n
83 ----------------------------------------------------------------------
86 -- The INLINE stops the build in the RHS from getting inlined,
87 -- so that callers can fuse with the result of range
90 {-# INLINE unsafeIndex #-}
91 unsafeIndex (m,_n) i = i - m
93 index b i | inRange b i = unsafeIndex b i
94 | otherwise = indexError b i "Int"
96 {-# INLINE inRange #-}
97 inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
99 ----------------------------------------------------------------------
100 instance Ix Integer where
104 {-# INLINE unsafeIndex #-}
105 unsafeIndex (m,_n) i = fromInteger (i - m)
107 index b i | inRange b i = unsafeIndex b i
108 | otherwise = indexError b i "Integer"
110 inRange (m,n) i = m <= i && i <= n
113 ----------------------------------------------------------------------
114 instance Ix Bool where -- as derived
118 {-# INLINE unsafeIndex #-}
119 unsafeIndex (l,_) i = fromEnum i - fromEnum l
121 index b i | inRange b i = unsafeIndex b i
122 | otherwise = indexError b i "Bool"
124 inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
126 ----------------------------------------------------------------------
127 instance Ix Ordering where -- as derived
131 {-# INLINE unsafeIndex #-}
132 unsafeIndex (l,_) i = fromEnum i - fromEnum l
134 index b i | inRange b i = unsafeIndex b i
135 | otherwise = indexError b i "Ordering"
137 inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
139 ----------------------------------------------------------------------
142 range ((), ()) = [()]
143 {-# INLINE unsafeIndex #-}
144 unsafeIndex ((), ()) () = 0
145 {-# INLINE inRange #-}
146 inRange ((), ()) () = True
148 index b i = unsafeIndex b i
151 ----------------------------------------------------------------------
152 instance (Ix a, Ix b) => Ix (a, b) where -- as derived
153 {-# SPECIALISE instance Ix (Int,Int) #-}
156 range ((l1,l2),(u1,u2)) =
157 [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
159 {- INLINE unsafeIndex #-}
160 unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
161 unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
163 {- INLINE inRange #-}
164 inRange ((l1,l2),(u1,u2)) (i1,i2) =
165 inRange (l1,u1) i1 && inRange (l2,u2) i2
167 -- Default method for index
169 ----------------------------------------------------------------------
170 instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
171 {-# SPECIALISE instance Ix (Int,Int,Int) #-}
173 range ((l1,l2,l3),(u1,u2,u3)) =
174 [(i1,i2,i3) | i1 <- range (l1,u1),
178 unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
179 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
180 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
181 unsafeIndex (l1,u1) i1))
183 inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
184 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
187 -- Default method for index
189 ----------------------------------------------------------------------
190 instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
191 range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
192 [(i1,i2,i3,i4) | i1 <- range (l1,u1),
197 unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
198 unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
199 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
200 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
201 unsafeIndex (l1,u1) i1)))
203 inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
204 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
205 inRange (l3,u3) i3 && inRange (l4,u4) i4
207 -- Default method for index
209 instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
210 range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
211 [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
217 unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
218 unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
219 unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
220 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
221 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
222 unsafeIndex (l1,u1) i1))))
224 inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
225 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
226 inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
229 -- Default method for index
233 %********************************************************
235 \subsection{Size of @Ix@ interval}
237 %********************************************************
239 The @rangeSize@ operator returns the number of elements
240 in the range for an @Ix@ pair.
243 {-# SPECIALISE unsafeRangeSize :: (Int,Int) -> Int #-}
244 {-# SPECIALISE unsafeRangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
245 unsafeRangeSize :: (Ix a) => (a,a) -> Int
246 unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
248 {-# SPECIALISE rangeSize :: (Int,Int) -> Int #-}
249 {-# SPECIALISE rangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
250 rangeSize :: (Ix a) => (a,a) -> Int
251 rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
254 -- Note that the following is NOT right
255 -- rangeSize (l,h) | l <= h = index b h + 1
258 -- Because it might be the case that l<h, but the range
259 -- is nevertheless empty. Consider
261 -- Here l<h, but the second index ranges from 2..1 and
265 %*********************************************************
267 \subsection{The @Array@ types}
269 %*********************************************************
272 type IPr = (Int, Int)
274 data Ix i => Array i e = Array !i !i (Array# e)
275 data Ix i => STArray s i e = STArray !i !i (MutableArray# s e)
277 -- Just pointer equality on mutable arrays:
278 instance Eq (STArray s i e) where
279 STArray _ _ arr1# == STArray _ _ arr2# =
280 sameMutableArray# arr1# arr2#
284 %*********************************************************
286 \subsection{Operations on immutable arrays}
288 %*********************************************************
291 {-# NOINLINE arrEleBottom #-}
293 arrEleBottom = error "(Array.!): undefined array element"
296 array :: Ix i => (i,i) -> [(i, e)] -> Array i e
297 array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
299 {-# INLINE unsafeArray #-}
300 unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e
301 unsafeArray (l,u) ies = runST (ST $ \s1# ->
302 case rangeSize (l,u) of { I# n# ->
303 case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
304 foldr (fill marr#) (done l u marr#) ies s2# }})
307 fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a
308 fill marr# (I# i#, e) next s1# =
309 case writeArray# marr# i# e s1# of { s2# ->
313 done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)
315 case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
316 (# s2#, Array l u arr# #) }
318 -- This is inefficient and I'm not sure why:
319 -- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
320 -- The code below is better. It still doesn't enable foldr/build
321 -- transformation on the list of elements; I guess it's impossible
322 -- using mechanisms currently available.
324 {-# INLINE listArray #-}
325 listArray :: Ix i => (i,i) -> [e] -> Array i e
326 listArray (l,u) es = runST (ST $ \s1# ->
327 case rangeSize (l,u) of { I# n# ->
328 case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
329 let fillFromList i# xs s3# | i# ==# n# = s3#
330 | otherwise = case xs of
332 y:ys -> case writeArray# marr# i# y s3# of { s4# ->
333 fillFromList (i# +# 1#) ys s4# } in
334 case fillFromList 0# es s2# of { s3# ->
335 done l u marr# s3# }}})
338 (!) :: Ix i => Array i e -> i -> e
339 arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)
341 {-# INLINE unsafeAt #-}
342 unsafeAt :: Ix i => Array i e -> Int -> e
343 unsafeAt (Array _ _ arr#) (I# i#) =
344 case indexArray# arr# i# of (# e #) -> e
346 {-# INLINE bounds #-}
347 bounds :: Ix i => Array i e -> (i,i)
348 bounds (Array l u _) = (l,u)
350 {-# INLINE indices #-}
351 indices :: Ix i => Array i e -> [i]
352 indices (Array l u _) = range (l,u)
355 elems :: Ix i => Array i e -> [e]
356 elems arr@(Array l u _) =
357 [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
359 {-# INLINE assocs #-}
360 assocs :: Ix i => Array i e -> [(i, e)]
361 assocs arr@(Array l u _) =
362 [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
364 {-# INLINE accumArray #-}
365 accumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(i, a)] -> Array i e
366 accumArray f init (l,u) ies =
367 unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
369 {-# INLINE unsafeAccumArray #-}
370 unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
371 unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->
372 case rangeSize (l,u) of { I# n# ->
373 case newArray# n# init s1# of { (# s2#, marr# #) ->
374 foldr (adjust f marr#) (done l u marr#) ies s2# }})
376 {-# INLINE adjust #-}
377 adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b
378 adjust f marr# (I# i#, new) next s1# =
379 case readArray# marr# i# s1# of { (# s2#, old #) ->
380 case writeArray# marr# i# (f old new) s2# of { s3# ->
384 (//) :: Ix i => Array i e -> [(i, e)] -> Array i e
385 arr@(Array l u _) // ies =
386 unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
388 {-# INLINE unsafeReplace #-}
389 unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e
390 unsafeReplace arr@(Array l u _) ies = runST (do
391 STArray _ _ marr# <- thawSTArray arr
392 ST (foldr (fill marr#) (done l u marr#) ies))
395 accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e
396 accum f arr@(Array l u _) ies =
397 unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
399 {-# INLINE unsafeAccum #-}
400 unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e
401 unsafeAccum f arr@(Array l u _) ies = runST (do
402 STArray _ _ marr# <- thawSTArray arr
403 ST (foldr (adjust f marr#) (done l u marr#) ies))
406 amap :: Ix i => (a -> b) -> Array i a -> Array i b
407 amap f arr@(Array l u _) =
408 unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
411 ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e
413 unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
415 {-# INLINE eqArray #-}
416 eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool
417 eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
418 if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
419 l1 == l2 && u1 == u2 &&
420 and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
422 {-# INLINE cmpArray #-}
423 cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering
424 cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
426 {-# INLINE cmpIntArray #-}
427 cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering
428 cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
429 if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
430 if rangeSize (l2,u2) == 0 then GT else
431 case compare l1 l2 of
432 EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
435 cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
439 {-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
443 %*********************************************************
445 \subsection{Array instances}
447 %*********************************************************
450 instance Ix i => Functor (Array i) where
453 instance (Ix i, Eq e) => Eq (Array i e) where
456 instance (Ix i, Ord e) => Ord (Array i e) where
459 instance (Ix a, Show a, Show b) => Show (Array a b) where
462 showString "array " .
468 instance (Ix a, Read a, Read b) => Read (Array a b) where
469 readsPrec p = readParen (p > 9)
470 (\r -> [(array b as, u) | ("array",s) <- lex r,
477 %*********************************************************
479 \subsection{Operations on mutable arrays}
481 %*********************************************************
483 Idle ADR question: What's the tradeoff here between flattening these
484 datatypes into @STArray ix ix (MutableArray# s elt)@ and using
485 it as is? As I see it, the former uses slightly less heap and
486 provides faster access to the individual parts of the bounds while the
487 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
488 required by many array-related functions. Which wins? Is the
489 difference significant (probably not).
491 Idle AJG answer: When I looked at the outputted code (though it was 2
492 years ago) it seems like you often needed the tuple, and we build
493 it frequently. Now we've got the overloading specialiser things
494 might be different, though.
497 {-# INLINE newSTArray #-}
498 newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
499 newSTArray (l,u) init = ST $ \s1# ->
500 case rangeSize (l,u) of { I# n# ->
501 case newArray# n# init s1# of { (# s2#, marr# #) ->
502 (# s2#, STArray l u marr# #) }}
504 {-# INLINE boundsSTArray #-}
505 boundsSTArray :: STArray s i e -> (i,i)
506 boundsSTArray (STArray l u _) = (l,u)
508 {-# INLINE readSTArray #-}
509 readSTArray :: Ix i => STArray s i e -> i -> ST s e
510 readSTArray marr@(STArray l u _) i =
511 unsafeReadSTArray marr (index (l,u) i)
513 {-# INLINE unsafeReadSTArray #-}
514 unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e
515 unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->
516 readArray# marr# i# s1#
518 {-# INLINE writeSTArray #-}
519 writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
520 writeSTArray marr@(STArray l u _) i e =
521 unsafeWriteSTArray marr (index (l,u) i) e
523 {-# INLINE unsafeWriteSTArray #-}
524 unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s ()
525 unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->
526 case writeArray# marr# i# e s1# of { s2# ->
531 %*********************************************************
533 \subsection{Moving between mutable and immutable}
535 %*********************************************************
538 freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
539 freezeSTArray (STArray l u marr#) = ST $ \s1# ->
540 case rangeSize (l,u) of { I# n# ->
541 case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) ->
542 let copy i# s3# | i# ==# n# = s3#
544 case readArray# marr# i# s3# of { (# s4#, e #) ->
545 case writeArray# marr'# i# e s4# of { s5# ->
546 copy (i# +# 1#) s5# }} in
547 case copy 0# s2# of { s3# ->
548 case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) ->
549 (# s4#, Array l u arr# #) }}}}
551 {-# INLINE unsafeFreezeSTArray #-}
552 unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
553 unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->
554 case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
555 (# s2#, Array l u arr# #) }
557 thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
558 thawSTArray (Array l u arr#) = ST $ \s1# ->
559 case rangeSize (l,u) of { I# n# ->
560 case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
561 let copy i# s3# | i# ==# n# = s3#
563 case indexArray# arr# i# of { (# e #) ->
564 case writeArray# marr# i# e s3# of { s4# ->
565 copy (i# +# 1#) s4# }} in
566 case copy 0# s2# of { s3# ->
567 (# s3#, STArray l u marr# #) }}}
569 {-# INLINE unsafeThawSTArray #-}
570 unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
571 unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->
572 case unsafeThawArray# arr# s1# of { (# s2#, marr# #) ->
573 (# s2#, STArray l u marr# #) }