2 % (c) The AQUA Project, Glasgow University, 1994-1996
4 \section[PrelArr]{Module @PrelArr@}
6 Array implementation, @PrelArr@ exports the basic array
9 For byte-arrays see @PrelByteArr@.
12 {-# OPTIONS -fno-implicit-prelude #-}
16 import {-# SOURCE #-} PrelErr ( error )
17 import PrelList (foldl)
32 %*********************************************************
34 \subsection{The @Ix@ class}
36 %*********************************************************
39 class (Ord a) => Ix a where
41 index, unsafeIndex :: (a,a) -> a -> Int
42 inRange :: (a,a) -> a -> Bool
44 -- Must specify one of index, unsafeIndex
45 index b i | inRange b i = unsafeIndex b i
46 | otherwise = error "Error in array index"
47 unsafeIndex b i = index b i
51 %*********************************************************
53 \subsection{Instances of @Ix@}
55 %*********************************************************
58 -- abstract these errors from the relevant index functions so that
59 -- the guts of the function will be small enough to inline.
61 {-# NOINLINE indexError #-}
62 indexError :: Show a => (a,a) -> a -> String -> b
64 = error (showString "Ix{" . showString tp . showString "}.index: Index " .
65 showParen True (showsPrec 0 i) .
66 showString " out of range " $
67 showParen True (showsPrec 0 rng) "")
69 ----------------------------------------------------------------------
70 instance Ix Char where
74 {-# INLINE unsafeIndex #-}
75 unsafeIndex (m,_n) i = fromEnum i - fromEnum m
77 index b i | inRange b i = unsafeIndex b i
78 | otherwise = indexError b i "Char"
80 inRange (m,n) i = m <= i && i <= n
82 ----------------------------------------------------------------------
85 -- The INLINE stops the build in the RHS from getting inlined,
86 -- so that callers can fuse with the result of range
89 {-# INLINE unsafeIndex #-}
90 unsafeIndex (m,_n) i = i - m
92 index b i | inRange b i = unsafeIndex b i
93 | otherwise = indexError b i "Int"
95 {-# INLINE inRange #-}
96 inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
98 ----------------------------------------------------------------------
99 instance Ix Integer where
103 {-# INLINE unsafeIndex #-}
104 unsafeIndex (m,_n) i = fromInteger (i - m)
106 index b i | inRange b i = unsafeIndex b i
107 | otherwise = indexError b i "Integer"
109 inRange (m,n) i = m <= i && i <= n
112 ----------------------------------------------------------------------
113 instance Ix Bool where -- as derived
117 {-# INLINE unsafeIndex #-}
118 unsafeIndex (l,_) i = fromEnum i - fromEnum l
120 index b i | inRange b i = unsafeIndex b i
121 | otherwise = indexError b i "Bool"
123 inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
125 ----------------------------------------------------------------------
126 instance Ix Ordering where -- as derived
130 {-# INLINE unsafeIndex #-}
131 unsafeIndex (l,_) i = fromEnum i - fromEnum l
133 index b i | inRange b i = unsafeIndex b i
134 | otherwise = indexError b i "Ordering"
136 inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
138 ----------------------------------------------------------------------
141 range ((), ()) = [()]
142 {-# INLINE unsafeIndex #-}
143 unsafeIndex ((), ()) () = 0
144 {-# INLINE inRange #-}
145 inRange ((), ()) () = True
147 index b i = unsafeIndex b i
150 ----------------------------------------------------------------------
151 instance (Ix a, Ix b) => Ix (a, b) where -- as derived
152 {-# SPECIALISE instance Ix (Int,Int) #-}
155 range ((l1,l2),(u1,u2)) =
156 [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
158 {- INLINE unsafeIndex #-}
159 unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
160 unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
162 {- INLINE inRange #-}
163 inRange ((l1,l2),(u1,u2)) (i1,i2) =
164 inRange (l1,u1) i1 && inRange (l2,u2) i2
166 -- Default method for index
168 ----------------------------------------------------------------------
169 instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
170 {-# SPECIALISE instance Ix (Int,Int,Int) #-}
172 range ((l1,l2,l3),(u1,u2,u3)) =
173 [(i1,i2,i3) | i1 <- range (l1,u1),
177 unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
178 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
179 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
180 unsafeIndex (l1,u1) i1))
182 inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
183 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
186 -- Default method for index
188 ----------------------------------------------------------------------
189 instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
190 range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
191 [(i1,i2,i3,i4) | i1 <- range (l1,u1),
196 unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
197 unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
198 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
199 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
200 unsafeIndex (l1,u1) i1)))
202 inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
203 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
204 inRange (l3,u3) i3 && inRange (l4,u4) i4
206 -- Default method for index
208 instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
209 range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
210 [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
216 unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
217 unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
218 unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
219 unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
220 unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
221 unsafeIndex (l1,u1) i1))))
223 inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
224 inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
225 inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
228 -- Default method for index
232 %********************************************************
234 \subsection{Size of @Ix@ interval}
236 %********************************************************
238 The @rangeSize@ operator returns the number of elements
239 in the range for an @Ix@ pair.
242 {-# SPECIALISE unsafeRangeSize :: (Int,Int) -> Int #-}
243 {-# SPECIALISE unsafeRangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
244 unsafeRangeSize :: (Ix a) => (a,a) -> Int
245 unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
247 {-# SPECIALISE rangeSize :: (Int,Int) -> Int #-}
248 {-# SPECIALISE rangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
249 rangeSize :: (Ix a) => (a,a) -> Int
250 rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
253 -- Note that the following is NOT right
254 -- rangeSize (l,h) | l <= h = index b h + 1
257 -- Because it might be the case that l<h, but the range
258 -- is nevertheless empty. Consider
260 -- Here l<h, but the second index ranges from 2..1 and
266 %*********************************************************
268 \subsection{The @Array@ types}
270 %*********************************************************
273 type IPr = (Int, Int)
275 data Ix ix => Array ix elt = Array ix ix (Array# elt)
276 data Ix ix => STArray s ix elt = STArray ix ix (MutableArray# s elt)
279 data STRef s a = STRef (MutVar# s a)
281 instance Eq (STRef s a) where
282 STRef v1# == STRef v2#
283 = sameMutVar# v1# v2#
285 -- just pointer equality on arrays:
286 instance Eq (STArray s ix elt) where
287 STArray _ _ arr1# == STArray _ _ arr2#
288 = sameMutableArray# arr1# arr2#
291 %*********************************************************
293 \subsection{Operations on mutable variables}
295 %*********************************************************
298 newSTRef :: a -> ST s (STRef s a)
299 readSTRef :: STRef s a -> ST s a
300 writeSTRef :: STRef s a -> a -> ST s ()
302 newSTRef init = ST $ \ s# ->
303 case (newMutVar# init s#) of { (# s2#, var# #) ->
304 (# s2#, STRef var# #) }
306 readSTRef (STRef var#) = ST $ \ s# -> readMutVar# var# s#
308 writeSTRef (STRef var#) val = ST $ \ s# ->
309 case writeMutVar# var# val s# of { s2# ->
313 %*********************************************************
315 \subsection{Operations on immutable arrays}
317 %*********************************************************
319 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
322 bounds :: (Ix a) => Array a b -> (a,a)
323 {-# INLINE bounds #-}
324 bounds (Array l u _) = (l,u)
326 assocs :: (Ix a) => Array a b -> [(a,b)]
327 {-# INLINE assocs #-} -- Want to fuse the list comprehension
328 assocs a = [(i, a!i) | i <- indices a]
330 indices :: (Ix a) => Array a b -> [a]
331 {-# INLINE indices #-}
332 indices = range . bounds
334 {-# SPECIALISE amap :: (b -> c) -> Array Int b -> Array Int c #-}
335 amap :: (Ix a) => (b -> c) -> Array a b -> Array a c
336 amap f a = array b [(i, f (a!i)) | i <- range b]
339 {-# SPECIALISE (!) :: Array Int b -> Int -> b #-}
340 (!) :: (Ix a) => Array a b -> a -> b
342 = let n# = case (index (l,u) i) of { I# x -> x } -- index fails if out of range
344 case (indexArray# arr# n#) of
348 array :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
351 = case rangeSize ixs of { I# n ->
353 case newArray# n arrEleBottom s1 of { (# s2, marr #) ->
354 foldr (fill ixs marr) (done ixs marr) ivs s2
357 fill :: Ix ix => (ix,ix) -> MutableArray# s elt
358 -> (ix,elt) -> STRep s a -> STRep s a
360 fill ixs marr (i,v) next = \s1 -> case index ixs i of { I# n ->
361 case writeArray# marr n v s1 of { s2 ->
364 done :: Ix ix => (ix,ix) -> MutableArray# s elt
365 -> STRep s (Array ix elt)
367 done (l,u) marr = \s1 ->
368 case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
369 (# s2, Array l u arr #) }
372 arrEleBottom = error "(Array.!): undefined array element"
375 -----------------------------------------------------------------------
376 -- These also go better with magic: (//), accum, accumArray
377 -- *** NB *** We INLINE them all so that their foldr's get to the call site
379 (//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
383 -- copy the old array:
384 arr <- thawSTArray old_array
385 -- now write the new elements into the new array:
390 fill_it_in :: Ix ix => STArray s ix elt -> [(ix, elt)] -> ST s ()
391 {-# INLINE fill_it_in #-}
392 fill_it_in arr lst = foldr (fill_one_in arr) (return ()) lst
393 -- **** STRICT **** (but that's OK...)
395 fill_one_in arr (i, v) rst = writeSTArray arr i v >> rst
397 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> STArray s ix elt -> [(ix,elt2)] -> ST s ()
398 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
399 {-# INLINE zap_with_f #-}
402 = foldr (zap_one f arr) (return ()) lst
404 zap_one f arr (i, new_v) rst = do
405 old_v <- readSTArray arr i
406 writeSTArray arr i (f old_v new_v)
409 accum :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
411 accum f old_array ivs
413 -- copy the old array:
414 arr <- thawSTArray old_array
415 -- now zap the elements in question with "f":
421 accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
422 {-# INLINE accumArray #-}
423 accumArray f zero ixs ivs
425 arr <- newSTArray ixs zero
432 %*********************************************************
434 \subsection{Array instances}
436 %*********************************************************
440 instance Ix a => Functor (Array a) where
443 instance (Ix a, Eq b) => Eq (Array a b) where
444 a == a' = assocs a == assocs a'
445 a /= a' = assocs a /= assocs a'
447 instance (Ix a, Ord b) => Ord (Array a b) where
448 compare a b = compare (assocs a) (assocs b)
450 instance (Ix a, Show a, Show b) => Show (Array a b) where
451 showsPrec p a = showParen (p > 9) (
452 showString "array " .
453 shows (bounds a) . showChar ' ' .
455 showList = showList__ (showsPrec 0)
458 instance (Ix a, Read a, Read b) => Read (Array a b) where
459 readsPrec p = readParen (p > 9)
460 (\r -> [(array b as, u) | ("array",s) <- lex r,
463 readList = readList__ (readsPrec 0)
468 %*********************************************************
470 \subsection{Operations on mutable arrays}
472 %*********************************************************
474 Idle ADR question: What's the tradeoff here between flattening these
475 datatypes into @STArray ix ix (MutableArray# s elt)@ and using
476 it as is? As I see it, the former uses slightly less heap and
477 provides faster access to the individual parts of the bounds while the
478 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
479 required by many array-related functions. Which wins? Is the
480 difference significant (probably not).
482 Idle AJG answer: When I looked at the outputted code (though it was 2
483 years ago) it seems like you often needed the tuple, and we build
484 it frequently. Now we've got the overloading specialiser things
485 might be different, though.
488 newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
490 {-# SPECIALIZE newSTArray :: IPr -> elt -> ST s (STArray s Int elt),
491 (IPr,IPr) -> elt -> ST s (STArray s IPr elt)
493 newSTArray (l,u) init = ST $ \ s# ->
494 case rangeSize (l,u) of { I# n# ->
495 case (newArray# n# init s#) of { (# s2#, arr# #) ->
496 (# s2#, STArray l u arr# #) }}
500 boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix)
501 {-# SPECIALIZE boundsSTArray :: STArray s Int elt -> IPr #-}
502 boundsSTArray (STArray l u _) = (l,u)
504 readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt
505 {-# SPECIALIZE readSTArray :: STArray s Int elt -> Int -> ST s elt,
506 STArray s IPr elt -> IPr -> ST s elt
509 readSTArray (STArray l u arr#) n = ST $ \ s# ->
510 case (index (l,u) n) of { I# n# ->
511 case readArray# arr# n# s# of { (# s2#, r #) ->
514 writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
515 {-# SPECIALIZE writeSTArray :: STArray s Int elt -> Int -> elt -> ST s (),
516 STArray s IPr elt -> IPr -> elt -> ST s ()
519 writeSTArray (STArray l u arr#) n ele = ST $ \ s# ->
520 case index (l,u) n of { I# n# ->
521 case writeArray# arr# n# ele s# of { s2# ->
526 %*********************************************************
528 \subsection{Moving between mutable and immutable}
530 %*********************************************************
533 freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
534 {-# SPECIALISE freezeSTArray :: STArray s Int elt -> ST s (Array Int elt),
535 STArray s IPr elt -> ST s (Array IPr elt)
538 freezeSTArray (STArray l u arr#) = ST $ \ s# ->
539 case rangeSize (l,u) of { I# n# ->
540 case freeze arr# n# s# of { (# s2#, frozen# #) ->
541 (# s2#, Array l u frozen# #) }}
543 freeze :: MutableArray# s ele -- the thing
544 -> Int# -- size of thing to be frozen
545 -> State# s -- the Universe and everything
546 -> (# State# s, Array# ele #)
548 = case newArray# n# init s# of { (# s2#, newarr1# #) ->
549 case copy 0# n# m_arr# newarr1# s2# of { (# s3#, newarr2# #) ->
550 unsafeFreezeArray# newarr2# s3#
553 init = error "freezeArray: element not copied"
556 -> MutableArray# s ele
557 -> MutableArray# s ele
559 -> (# State# s, MutableArray# s ele #)
561 copy cur# end# from# to# st#
565 = case readArray# from# cur# st# of { (# s1#, ele #) ->
566 case writeArray# to# cur# ele s1# of { s2# ->
567 copy (cur# +# 1#) end# from# to# s2#
570 unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
571 unsafeFreezeSTArray (STArray l u arr#) = ST $ \ s# ->
572 case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
573 (# s2#, Array l u frozen# #) }
575 --This takes a immutable array, and copies it into a mutable array, in a
578 thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
579 {-# SPECIALISE thawSTArray :: Array Int elt -> ST s (STArray s Int elt),
580 Array IPr elt -> ST s (STArray s IPr elt)
583 thawSTArray (Array l u arr#) = ST $ \ s# ->
584 case rangeSize (l,u) of { I# n# ->
585 case thaw arr# n# s# of { (# s2#, thawed# #) ->
586 (# s2#, STArray l u thawed# #)}}
588 thaw :: Array# ele -- the thing
589 -> Int# -- size of thing to be thawed
590 -> State# s -- the Universe and everything
591 -> (# State# s, MutableArray# s ele #)
594 = case newArray# n# init s# of { (# s2#, newarr1# #) ->
595 copy 0# n# arr1# newarr1# s2# }
597 init = error "thawSTArray: element not copied"
601 -> MutableArray# s ele
603 -> (# State# s, MutableArray# s ele #)
605 copy cur# end# from# to# st#
609 = case indexArray# from# cur# of { (# ele #) ->
610 case writeArray# to# cur# ele st# of { s1# ->
611 copy (cur# +# 1#) end# from# to# s1#
614 -- this is a quicker version of the above, just flipping the type
615 -- (& representation) of an immutable array. And placing a
616 -- proof obligation on the programmer.
617 unsafeThawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
618 unsafeThawSTArray (Array l u arr#) = ST $ \ s# ->
619 case unsafeThawArray# arr# s# of
620 (# s2#, marr# #) -> (# s2#, STArray l u marr# #)