1 % -----------------------------------------------------------------------------
2 % $Id: PrelArr.lhs,v 1.25 2000/08/31 19:57:42 simonpj Exp $
4 % (c) The University of Glasgow, 1994-2000
7 \section[PrelArr]{Module @PrelArr@}
9 Array implementation, @PrelArr@ exports the basic array
12 For byte-arrays see @PrelByteArr@.
15 {-# OPTIONS -fno-implicit-prelude #-}
19 import {-# SOURCE #-} PrelErr ( error )
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)
278 -- Mutterings about dependent types... ignore!
279 -- Array :: ix -> ix -> Array# elt -> Array
280 -- Array :: forall { l::int, h::int, l<=h } Int(l) -> Int(h) -> Array#(h-l+1) -> Array(l,h)
281 -- Array :: forall { l1,l2::int, h1,h2::int, l1<=h1+1,l2<=h2+1 }
282 -- (Int(l1),Int(l2)) -> (Int(h1),Int(h2)) -> Array#((h1-l1+1)*(h2-l2+1)) -> Array(l1,h1,l2,h2)
285 data STRef s a = STRef (MutVar# s a)
287 instance Eq (STRef s a) where
288 STRef v1# == STRef v2#
289 = sameMutVar# v1# v2#
291 -- just pointer equality on arrays:
292 instance Eq (STArray s ix elt) where
293 STArray _ _ arr1# == STArray _ _ arr2#
294 = sameMutableArray# arr1# arr2#
297 %*********************************************************
299 \subsection{Operations on mutable variables}
301 %*********************************************************
304 newSTRef :: a -> ST s (STRef s a)
305 readSTRef :: STRef s a -> ST s a
306 writeSTRef :: STRef s a -> a -> ST s ()
308 newSTRef init = ST $ \ s# ->
309 case (newMutVar# init s#) of { (# s2#, var# #) ->
310 (# s2#, STRef var# #) }
312 readSTRef (STRef var#) = ST $ \ s# -> readMutVar# var# s#
314 writeSTRef (STRef var#) val = ST $ \ s# ->
315 case writeMutVar# var# val s# of { s2# ->
319 %*********************************************************
321 \subsection{Operations on immutable arrays}
323 %*********************************************************
325 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
328 bounds :: (Ix a) => Array a b -> (a,a)
329 {-# INLINE bounds #-}
330 bounds (Array l u _) = (l,u)
332 assocs :: (Ix a) => Array a b -> [(a,b)]
333 {-# INLINE assocs #-} -- Want to fuse the list comprehension
334 assocs a = [(i, a!i) | i <- indices a]
336 indices :: (Ix a) => Array a b -> [a]
337 {-# INLINE indices #-}
338 indices = range . bounds
340 {-# SPECIALISE amap :: (b -> c) -> Array Int b -> Array Int c #-}
341 amap :: (Ix a) => (b -> c) -> Array a b -> Array a c
342 amap f a = array b [(i, f (a!i)) | i <- range b]
345 {-# SPECIALISE (!) :: Array Int b -> Int -> b #-}
346 (!) :: (Ix a) => Array a b -> a -> b
348 = let n# = case (index (l,u) i) of { I# x -> x } -- index fails if out of range
350 case (indexArray# arr# n#) of
354 array :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
357 = case rangeSize ixs of { I# n ->
359 case newArray# n arrEleBottom s1 of { (# s2, marr #) ->
360 foldr (fill ixs marr) (done ixs marr) ivs s2
363 fill :: Ix ix => (ix,ix) -> MutableArray# s elt
364 -> (ix,elt) -> STRep s a -> STRep s a
366 fill ixs marr (i,v) next = \s1 -> case index ixs i of { I# n ->
367 case writeArray# marr n v s1 of { s2 ->
370 done :: Ix ix => (ix,ix) -> MutableArray# s elt
371 -> STRep s (Array ix elt)
373 done (l,u) marr = \s1 ->
374 case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
375 (# s2, Array l u arr #) }
378 arrEleBottom = error "(Array.!): undefined array element"
381 -----------------------------------------------------------------------
382 -- These also go better with magic: (//), accum, accumArray
383 -- *** NB *** We INLINE them all so that their foldr's get to the call site
385 (//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
389 -- copy the old array:
390 arr <- thawSTArray old_array
391 -- now write the new elements into the new array:
396 fill_it_in :: Ix ix => STArray s ix elt -> [(ix, elt)] -> ST s ()
397 {-# INLINE fill_it_in #-}
398 fill_it_in arr lst = foldr (fill_one_in arr) (return ()) lst
399 -- **** STRICT **** (but that's OK...)
401 fill_one_in arr (i, v) rst = writeSTArray arr i v >> rst
403 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> STArray s ix elt -> [(ix,elt2)] -> ST s ()
404 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
405 {-# INLINE zap_with_f #-}
408 = foldr (zap_one f arr) (return ()) lst
410 zap_one f arr (i, new_v) rst = do
411 old_v <- readSTArray arr i
412 writeSTArray arr i (f old_v new_v)
415 accum :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
417 accum f old_array ivs
419 -- copy the old array:
420 arr <- thawSTArray old_array
421 -- now zap the elements in question with "f":
427 accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
428 {-# INLINE accumArray #-}
429 accumArray f zero ixs ivs
431 arr <- newSTArray ixs zero
438 %*********************************************************
440 \subsection{Array instances}
442 %*********************************************************
446 instance Ix a => Functor (Array a) where
449 instance (Ix a, Eq b) => Eq (Array a b) where
450 a == a' = assocs a == assocs a'
451 a /= a' = assocs a /= assocs a'
453 instance (Ix a, Ord b) => Ord (Array a b) where
454 compare a b = compare (assocs a) (assocs b)
456 instance (Ix a, Show a, Show b) => Show (Array a b) where
457 showsPrec p a = showParen (p > 9) (
458 showString "array " .
459 shows (bounds a) . showChar ' ' .
461 showList = showList__ (showsPrec 0)
464 instance (Ix a, Read a, Read b) => Read (Array a b) where
465 readsPrec p = readParen (p > 9)
466 (\r -> [(array b as, u) | ("array",s) <- lex r,
469 readList = readList__ (readsPrec 0)
474 %*********************************************************
476 \subsection{Operations on mutable arrays}
478 %*********************************************************
480 Idle ADR question: What's the tradeoff here between flattening these
481 datatypes into @STArray ix ix (MutableArray# s elt)@ and using
482 it as is? As I see it, the former uses slightly less heap and
483 provides faster access to the individual parts of the bounds while the
484 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
485 required by many array-related functions. Which wins? Is the
486 difference significant (probably not).
488 Idle AJG answer: When I looked at the outputted code (though it was 2
489 years ago) it seems like you often needed the tuple, and we build
490 it frequently. Now we've got the overloading specialiser things
491 might be different, though.
494 newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
496 {-# SPECIALIZE newSTArray :: IPr -> elt -> ST s (STArray s Int elt),
497 (IPr,IPr) -> elt -> ST s (STArray s IPr elt)
499 newSTArray (l,u) init = ST $ \ s# ->
500 case rangeSize (l,u) of { I# n# ->
501 case (newArray# n# init s#) of { (# s2#, arr# #) ->
502 (# s2#, STArray l u arr# #) }}
506 boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix)
507 {-# SPECIALIZE boundsSTArray :: STArray s Int elt -> IPr #-}
508 boundsSTArray (STArray l u _) = (l,u)
510 readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt
511 {-# SPECIALIZE readSTArray :: STArray s Int elt -> Int -> ST s elt,
512 STArray s IPr elt -> IPr -> ST s elt
515 readSTArray (STArray l u arr#) n = ST $ \ s# ->
516 case (index (l,u) n) of { I# n# ->
517 case readArray# arr# n# s# of { (# s2#, r #) ->
520 writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
521 {-# SPECIALIZE writeSTArray :: STArray s Int elt -> Int -> elt -> ST s (),
522 STArray s IPr elt -> IPr -> elt -> ST s ()
525 writeSTArray (STArray l u arr#) n ele = ST $ \ s# ->
526 case index (l,u) n of { I# n# ->
527 case writeArray# arr# n# ele s# of { s2# ->
532 %*********************************************************
534 \subsection{Moving between mutable and immutable}
536 %*********************************************************
539 freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
540 {-# SPECIALISE freezeSTArray :: STArray s Int elt -> ST s (Array Int elt),
541 STArray s IPr elt -> ST s (Array IPr elt)
544 freezeSTArray (STArray l u arr#) = ST $ \ s# ->
545 case rangeSize (l,u) of { I# n# ->
546 case freeze arr# n# s# of { (# s2#, frozen# #) ->
547 (# s2#, Array l u frozen# #) }}
549 freeze :: MutableArray# s ele -- the thing
550 -> Int# -- size of thing to be frozen
551 -> State# s -- the Universe and everything
552 -> (# State# s, Array# ele #)
554 = case newArray# n# init s# of { (# s2#, newarr1# #) ->
555 case copy 0# n# m_arr# newarr1# s2# of { (# s3#, newarr2# #) ->
556 unsafeFreezeArray# newarr2# s3#
559 init = error "freezeArray: element not copied"
562 -> MutableArray# s ele
563 -> MutableArray# s ele
565 -> (# State# s, MutableArray# s ele #)
567 copy cur# end# from# to# st#
571 = case readArray# from# cur# st# of { (# s1#, ele #) ->
572 case writeArray# to# cur# ele s1# of { s2# ->
573 copy (cur# +# 1#) end# from# to# s2#
576 unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
577 unsafeFreezeSTArray (STArray l u arr#) = ST $ \ s# ->
578 case unsafeFreezeArray# arr# s# of { (# s2#, frozen# #) ->
579 (# s2#, Array l u frozen# #) }
581 --This takes a immutable array, and copies it into a mutable array, in a
584 thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
585 {-# SPECIALISE thawSTArray :: Array Int elt -> ST s (STArray s Int elt),
586 Array IPr elt -> ST s (STArray s IPr elt)
589 thawSTArray (Array l u arr#) = ST $ \ s# ->
590 case rangeSize (l,u) of { I# n# ->
591 case thaw arr# n# s# of { (# s2#, thawed# #) ->
592 (# s2#, STArray l u thawed# #)}}
594 thaw :: Array# ele -- the thing
595 -> Int# -- size of thing to be thawed
596 -> State# s -- the Universe and everything
597 -> (# State# s, MutableArray# s ele #)
600 = case newArray# n# init s# of { (# s2#, newarr1# #) ->
601 copy 0# n# arr1# newarr1# s2# }
603 init = error "thawSTArray: element not copied"
607 -> MutableArray# s ele
609 -> (# State# s, MutableArray# s ele #)
611 copy cur# end# from# to# st#
615 = case indexArray# from# cur# of { (# ele #) ->
616 case writeArray# to# cur# ele st# of { s1# ->
617 copy (cur# +# 1#) end# from# to# s1#
620 -- this is a quicker version of the above, just flipping the type
621 -- (& representation) of an immutable array. And placing a
622 -- proof obligation on the programmer.
623 unsafeThawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
624 unsafeThawSTArray (Array l u arr#) = ST $ \ s# ->
625 case unsafeThawArray# arr# s# of
626 (# s2#, marr# #) -> (# s2#, STArray l u marr# #)