2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[ArrBase]{Module @ArrBase@}
8 {-# OPTIONS -fno-implicit-prelude #-}
12 import {-# SOURCE #-} IOBase ( error )
23 {-# GENERATE_SPECS array a{~,Int,IPr} b{} #-}
24 array :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
26 {-# GENERATE_SPECS (!) a{~,Int,IPr} b{} #-}
27 (!) :: (Ix a) => Array a b -> a -> b
29 bounds :: (Ix a) => Array a b -> (a,a)
31 {-# GENERATE_SPECS (//) a{~,Int,IPr} b{} #-}
32 (//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
34 {-# GENERATE_SPECS accum a{~,Int,IPr} b{} c{} #-}
35 accum :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
37 {-# GENERATE_SPECS accumArray a{~,Int,IPr} b{} c{} #-}
38 accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
42 %*********************************************************
44 \subsection{The @Array@ types}
46 %*********************************************************
51 data Ix ix => Array ix elt = Array (ix,ix) (Array# elt)
52 data Ix ix => ByteArray ix = ByteArray (ix,ix) ByteArray#
53 data Ix ix => MutableArray s ix elt = MutableArray (ix,ix) (MutableArray# s elt)
54 data Ix ix => MutableByteArray s ix = MutableByteArray (ix,ix) (MutableByteArray# s)
58 %*********************************************************
60 \subsection{Operations on immutable arrays}
62 %*********************************************************
64 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
67 bounds (Array b _) = b
69 (Array bounds arr#) ! i
70 = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
72 case (indexArray# arr# n#) of
75 #ifdef USE_FOLDR_BUILD
78 array ixs@(ix_start, ix_end) ivs =
80 case (newArray ixs arrEleBottom) of { ST new_array_thing ->
81 case (new_array_thing s) of { (arr@(MutableArray _ arr#),s) ->
83 fill_one_in (S# s#) (i, v)
84 = case index ixs i of { I# n# ->
85 case writeArray# arr# n# v s# of { s2# ->
88 case (foldl fill_one_in s ivs) of { s@(S# _) ->
89 case (freezeArray arr) of { ST freeze_array_thing ->
90 freeze_array_thing s }}}})
92 arrEleBottom = error "(Array.!): undefined array element"
94 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
96 = foldr fill_one_in (returnStrictlyST ()) lst
97 where -- **** STRICT **** (but that's OK...)
98 fill_one_in (i, v) rst
99 = writeArray arr i v `seqStrictlyST` rst
101 -----------------------------------------------------------------------
102 -- these also go better with magic: (//), accum, accumArray
106 -- copy the old array:
107 thawArray old_array `thenStrictlyST` \ arr ->
108 -- now write the new elements into the new array:
109 fill_it_in arr ivs `seqStrictlyST`
113 bottom = error "(Array.//): error in copying old array\n"
115 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
116 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
119 = foldr zap_one (returnStrictlyST ()) lst
121 zap_one (i, new_v) rst
122 = readArray arr i `thenStrictlyST` \ old_v ->
123 writeArray arr i (f old_v new_v) `seqStrictlyST`
126 accum f old_array ivs
128 -- copy the old array:
129 thawArray old_array `thenStrictlyST` \ arr ->
131 -- now zap the elements in question with "f":
132 zap_with_f f arr ivs >>
136 bottom = error "Array.accum: error in copying old array\n"
138 accumArray f zero ixs ivs
140 newArray ixs zero >>= \ arr# ->
141 zap_with_f f arr# ivs >>
147 %*********************************************************
149 \subsection{Operations on mutable arrays}
151 %*********************************************************
153 Idle ADR question: What's the tradeoff here between flattening these
154 datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
155 it as is? As I see it, the former uses slightly less heap and
156 provides faster access to the individual parts of the bounds while the
157 code used has the benefit of providing a ready-made @(lo, hi)@ pair as
158 required by many array-related functions. Which wins? Is the
159 difference significant (probably not).
161 Idle AJG answer: When I looked at the outputted code (though it was 2
162 years ago) it seems like you often needed the tuple, and we build
163 it frequently. Now we've got the overloading specialiser things
164 might be different, though.
167 newArray :: Ix ix => (ix,ix) -> elt -> ST s (MutableArray s ix elt)
168 newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray
169 :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix)
171 {-# SPECIALIZE newArray :: IPr -> elt -> ST s (MutableArray s Int elt),
172 (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
174 {-# SPECIALIZE newCharArray :: IPr -> ST s (MutableByteArray s Int) #-}
175 {-# SPECIALIZE newIntArray :: IPr -> ST s (MutableByteArray s Int) #-}
176 {-# SPECIALIZE newAddrArray :: IPr -> ST s (MutableByteArray s Int) #-}
177 {-# SPECIALIZE newFloatArray :: IPr -> ST s (MutableByteArray s Int) #-}
178 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
180 newArray ixs@(ix_start, ix_end) init = ST $ \ (S# s#) ->
181 let n# = case (if null (range ixs)
183 else (index ixs ix_end) + 1) of { I# x -> x }
184 -- size is one bigger than index of last elem
186 case (newArray# n# init s#) of { StateAndMutableArray# s2# arr# ->
187 (MutableArray ixs arr#, S# s2#)}
189 newCharArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
190 let n# = case (if null (range ixs)
192 else ((index ixs ix_end) + 1)) of { I# x -> x }
194 case (newCharArray# n# s#) of { StateAndMutableByteArray# s2# barr# ->
195 (MutableByteArray ixs barr#, S# s2#)}
197 newIntArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
198 let n# = case (if null (range ixs)
200 else ((index ixs ix_end) + 1)) of { I# x -> x }
202 case (newIntArray# n# s#) of { StateAndMutableByteArray# s2# barr# ->
203 (MutableByteArray ixs barr#, S# s2#)}
205 newAddrArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
206 let n# = case (if null (range ixs)
208 else ((index ixs ix_end) + 1)) of { I# x -> x }
210 case (newAddrArray# n# s#) of { StateAndMutableByteArray# s2# barr# ->
211 (MutableByteArray ixs barr#, S# s2#)}
213 newFloatArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
214 let n# = case (if null (range ixs)
216 else ((index ixs ix_end) + 1)) of { I# x -> x }
218 case (newFloatArray# n# s#) of { StateAndMutableByteArray# s2# barr# ->
219 (MutableByteArray ixs barr#, S# s2#)}
221 newDoubleArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
222 let n# = case (if null (range ixs)
224 else ((index ixs ix_end) + 1)) of { I# x -> x }
226 case (newDoubleArray# n# s#) of { StateAndMutableByteArray# s2# barr# ->
227 (MutableByteArray ixs barr#, S# s2#)}
229 boundsOfArray :: Ix ix => MutableArray s ix elt -> (ix, ix)
230 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
232 {-# SPECIALIZE boundsOfArray :: MutableArray s Int elt -> IPr #-}
233 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
235 boundsOfArray (MutableArray ixs _) = ixs
236 boundsOfByteArray (MutableByteArray ixs _) = ixs
238 readArray :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
240 readCharArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
241 readIntArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
242 readAddrArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
243 readFloatArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
244 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
246 {-# SPECIALIZE readArray :: MutableArray s Int elt -> Int -> ST s elt,
247 MutableArray s IPr elt -> IPr -> ST s elt
249 {-# SPECIALIZE readCharArray :: MutableByteArray s Int -> Int -> ST s Char #-}
250 {-# SPECIALIZE readIntArray :: MutableByteArray s Int -> Int -> ST s Int #-}
251 {-# SPECIALIZE readAddrArray :: MutableByteArray s Int -> Int -> ST s Addr #-}
252 --NO:{-# SPECIALIZE readFloatArray :: MutableByteArray s Int -> Int -> ST s Float #-}
253 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
255 readArray (MutableArray ixs arr#) n = ST $ \ (S# s#) ->
256 case (index ixs n) of { I# n# ->
257 case readArray# arr# n# s# of { StateAndPtr# s2# r ->
260 readCharArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
261 case (index ixs n) of { I# n# ->
262 case readCharArray# barr# n# s# of { StateAndChar# s2# r# ->
265 readIntArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
266 case (index ixs n) of { I# n# ->
267 case readIntArray# barr# n# s# of { StateAndInt# s2# r# ->
270 readAddrArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
271 case (index ixs n) of { I# n# ->
272 case readAddrArray# barr# n# s# of { StateAndAddr# s2# r# ->
275 readFloatArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
276 case (index ixs n) of { I# n# ->
277 case readFloatArray# barr# n# s# of { StateAndFloat# s2# r# ->
280 readDoubleArray (MutableByteArray ixs barr#) n = ST $ \ (S# s#) ->
281 case (index ixs n) of { I# n# ->
282 case readDoubleArray# barr# n# s# of { StateAndDouble# s2# r# ->
285 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
286 indexCharArray :: Ix ix => ByteArray ix -> ix -> Char
287 indexIntArray :: Ix ix => ByteArray ix -> ix -> Int
288 indexAddrArray :: Ix ix => ByteArray ix -> ix -> Addr
289 indexFloatArray :: Ix ix => ByteArray ix -> ix -> Float
290 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
292 {-# SPECIALIZE indexCharArray :: ByteArray Int -> Int -> Char #-}
293 {-# SPECIALIZE indexIntArray :: ByteArray Int -> Int -> Int #-}
294 {-# SPECIALIZE indexAddrArray :: ByteArray Int -> Int -> Addr #-}
295 --NO:{-# SPECIALIZE indexFloatArray :: ByteArray Int -> Int -> Float #-}
296 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
298 indexCharArray (ByteArray ixs barr#) n
299 = case (index ixs n) of { I# n# ->
300 case indexCharArray# barr# n# of { r# ->
303 indexIntArray (ByteArray ixs barr#) n
304 = case (index ixs n) of { I# n# ->
305 case indexIntArray# barr# n# of { r# ->
308 indexAddrArray (ByteArray ixs barr#) n
309 = case (index ixs n) of { I# n# ->
310 case indexAddrArray# barr# n# of { r# ->
313 indexFloatArray (ByteArray ixs barr#) n
314 = case (index ixs n) of { I# n# ->
315 case indexFloatArray# barr# n# of { r# ->
318 indexDoubleArray (ByteArray ixs barr#) n
319 = case (index ixs n) of { I# n# ->
320 case indexDoubleArray# barr# n# of { r# ->
323 --Indexing off @Addrs@ is similar, and therefore given here.
324 indexCharOffAddr :: Addr -> Int -> Char
325 indexIntOffAddr :: Addr -> Int -> Int
326 indexAddrOffAddr :: Addr -> Int -> Addr
327 indexFloatOffAddr :: Addr -> Int -> Float
328 indexDoubleOffAddr :: Addr -> Int -> Double
330 indexCharOffAddr (A# addr#) n
331 = case n of { I# n# ->
332 case indexCharOffAddr# addr# n# of { r# ->
335 indexIntOffAddr (A# addr#) n
336 = case n of { I# n# ->
337 case indexIntOffAddr# addr# n# of { r# ->
340 indexAddrOffAddr (A# addr#) n
341 = case n of { I# n# ->
342 case indexAddrOffAddr# addr# n# of { r# ->
345 indexFloatOffAddr (A# addr#) n
346 = case n of { I# n# ->
347 case indexFloatOffAddr# addr# n# of { r# ->
350 indexDoubleOffAddr (A# addr#) n
351 = case n of { I# n# ->
352 case indexDoubleOffAddr# addr# n# of { r# ->
355 writeArray :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
356 writeCharArray :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s ()
357 writeIntArray :: Ix ix => MutableByteArray s ix -> ix -> Int -> ST s ()
358 writeAddrArray :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s ()
359 writeFloatArray :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s ()
360 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s ()
362 {-# SPECIALIZE writeArray :: MutableArray s Int elt -> Int -> elt -> ST s (),
363 MutableArray s IPr elt -> IPr -> elt -> ST s ()
365 {-# SPECIALIZE writeCharArray :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
366 {-# SPECIALIZE writeIntArray :: MutableByteArray s Int -> Int -> Int -> ST s () #-}
367 {-# SPECIALIZE writeAddrArray :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
368 --NO:{-# SPECIALIZE writeFloatArray :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
369 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
371 writeArray (MutableArray ixs arr#) n ele = ST $ \ (S# s#) ->
372 case index ixs n of { I# n# ->
373 case writeArray# arr# n# ele s# of { s2# ->
376 writeCharArray (MutableByteArray ixs barr#) n (C# ele) = ST $ \ (S# s#) ->
377 case (index ixs n) of { I# n# ->
378 case writeCharArray# barr# n# ele s# of { s2# ->
381 writeIntArray (MutableByteArray ixs barr#) n (I# ele) = ST $ \ (S# s#) ->
382 case (index ixs n) of { I# n# ->
383 case writeIntArray# barr# n# ele s# of { s2# ->
386 writeAddrArray (MutableByteArray ixs barr#) n (A# ele) = ST $ \ (S# s#) ->
387 case (index ixs n) of { I# n# ->
388 case writeAddrArray# barr# n# ele s# of { s2# ->
391 writeFloatArray (MutableByteArray ixs barr#) n (F# ele) = ST $ \ (S# s#) ->
392 case (index ixs n) of { I# n# ->
393 case writeFloatArray# barr# n# ele s# of { s2# ->
396 writeDoubleArray (MutableByteArray ixs barr#) n (D# ele) = ST $ \ (S# s#) ->
397 case (index ixs n) of { I# n# ->
398 case writeDoubleArray# barr# n# ele s# of { s2# ->
403 %*********************************************************
405 \subsection{Moving between mutable and immutable}
407 %*********************************************************
410 freezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
411 freezeCharArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
412 freezeIntArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
413 freezeAddrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
414 freezeFloatArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
415 freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
417 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
418 MutableArray s IPr elt -> ST s (Array IPr elt)
420 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
422 freezeArray (MutableArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
423 let n# = case (if null (range ixs)
425 else (index ixs ix_end) + 1) of { I# x -> x }
427 case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
428 (Array ixs frozen#, S# s2#)}
430 freeze :: MutableArray# s ele -- the thing
431 -> Int# -- size of thing to be frozen
432 -> State# s -- the Universe and everything
433 -> StateAndArray# s ele
436 = case newArray# n# init s# of { StateAndMutableArray# s2# newarr1# ->
437 case copy 0# n# arr# newarr1# s2# of { StateAndMutableArray# s3# newarr2# ->
438 unsafeFreezeArray# newarr2# s3#
441 init = error "freezeArray: element not copied"
444 -> MutableArray# s ele -> MutableArray# s ele
446 -> StateAndMutableArray# s ele
448 copy cur# end# from# to# s#
450 = StateAndMutableArray# s# to#
452 = case readArray# from# cur# s# of { StateAndPtr# s1# ele ->
453 case writeArray# to# cur# ele s1# of { s2# ->
454 copy (cur# +# 1#) end# from# to# s2#
457 freezeCharArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
458 let n# = case (if null (range ixs)
460 else ((index ixs ix_end) + 1)) of { I# x -> x }
462 case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
463 (ByteArray ixs frozen#, S# s2#) }
465 freeze :: MutableByteArray# s -- the thing
466 -> Int# -- size of thing to be frozen
467 -> State# s -- the Universe and everything
468 -> StateAndByteArray# s
471 = case (newCharArray# n# s#) of { StateAndMutableByteArray# s2# newarr1# ->
472 case copy 0# n# arr# newarr1# s2# of { StateAndMutableByteArray# s3# newarr2# ->
473 unsafeFreezeByteArray# newarr2# s3#
477 -> MutableByteArray# s -> MutableByteArray# s
479 -> StateAndMutableByteArray# s
481 copy cur# end# from# to# s#
483 = StateAndMutableByteArray# s# to#
485 = case (readCharArray# from# cur# s#) of { StateAndChar# s1# ele ->
486 case (writeCharArray# to# cur# ele s1#) of { s2# ->
487 copy (cur# +# 1#) end# from# to# s2#
490 freezeIntArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
491 let n# = case (if null (range ixs)
493 else ((index ixs ix_end) + 1)) of { I# x -> x }
495 case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
496 (ByteArray ixs frozen#, S# s2#) }
498 freeze :: MutableByteArray# s -- the thing
499 -> Int# -- size of thing to be frozen
500 -> State# s -- the Universe and everything
501 -> StateAndByteArray# s
504 = case (newIntArray# n# s#) of { StateAndMutableByteArray# s2# newarr1# ->
505 case copy 0# n# arr# newarr1# s2# of { StateAndMutableByteArray# s3# newarr2# ->
506 unsafeFreezeByteArray# newarr2# s3#
510 -> MutableByteArray# s -> MutableByteArray# s
512 -> StateAndMutableByteArray# s
514 copy cur# end# from# to# s#
516 = StateAndMutableByteArray# s# to#
518 = case (readIntArray# from# cur# s#) of { StateAndInt# s1# ele ->
519 case (writeIntArray# to# cur# ele s1#) of { s2# ->
520 copy (cur# +# 1#) end# from# to# s2#
523 freezeAddrArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
524 let n# = case (if null (range ixs)
526 else ((index ixs ix_end) + 1)) of { I# x -> x }
528 case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
529 (ByteArray ixs frozen#, S# s2#) }
531 freeze :: MutableByteArray# s -- the thing
532 -> Int# -- size of thing to be frozen
533 -> State# s -- the Universe and everything
534 -> StateAndByteArray# s
537 = case (newAddrArray# n# s#) of { StateAndMutableByteArray# s2# newarr1# ->
538 case copy 0# n# arr# newarr1# s2# of { StateAndMutableByteArray# s3# newarr2# ->
539 unsafeFreezeByteArray# newarr2# s3#
543 -> MutableByteArray# s -> MutableByteArray# s
545 -> StateAndMutableByteArray# s
547 copy cur# end# from# to# s#
549 = StateAndMutableByteArray# s# to#
551 = case (readAddrArray# from# cur# s#) of { StateAndAddr# s1# ele ->
552 case (writeAddrArray# to# cur# ele s1#) of { s2# ->
553 copy (cur# +# 1#) end# from# to# s2#
556 freezeFloatArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
557 let n# = case (if null (range ixs)
559 else ((index ixs ix_end) + 1)) of { I# x -> x }
561 case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
562 (ByteArray ixs frozen#, S# s2#) }
564 freeze :: MutableByteArray# s -- the thing
565 -> Int# -- size of thing to be frozen
566 -> State# s -- the Universe and everything
567 -> StateAndByteArray# s
570 = case (newFloatArray# n# s#) of { StateAndMutableByteArray# s2# newarr1# ->
571 case copy 0# n# arr# newarr1# s2# of { StateAndMutableByteArray# s3# newarr2# ->
572 unsafeFreezeByteArray# newarr2# s3#
576 -> MutableByteArray# s -> MutableByteArray# s
578 -> StateAndMutableByteArray# s
580 copy cur# end# from# to# s#
582 = StateAndMutableByteArray# s# to#
584 = case (readFloatArray# from# cur# s#) of { StateAndFloat# s1# ele ->
585 case (writeFloatArray# to# cur# ele s1#) of { s2# ->
586 copy (cur# +# 1#) end# from# to# s2#
589 freezeDoubleArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
590 let n# = case (if null (range ixs)
592 else ((index ixs ix_end) + 1)) of { I# x -> x }
594 case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
595 (ByteArray ixs frozen#, S# s2#) }
597 freeze :: MutableByteArray# s -- the thing
598 -> Int# -- size of thing to be frozen
599 -> State# s -- the Universe and everything
600 -> StateAndByteArray# s
603 = case (newDoubleArray# n# s#) of { StateAndMutableByteArray# s2# newarr1# ->
604 case copy 0# n# arr# newarr1# s2# of { StateAndMutableByteArray# s3# newarr2# ->
605 unsafeFreezeByteArray# newarr2# s3#
609 -> MutableByteArray# s -> MutableByteArray# s
611 -> StateAndMutableByteArray# s
613 copy cur# end# from# to# s#
615 = StateAndMutableByteArray# s# to#
617 = case (readDoubleArray# from# cur# s#) of { StateAndDouble# s1# ele ->
618 case (writeDoubleArray# to# cur# ele s1#) of { s2# ->
619 copy (cur# +# 1#) end# from# to# s2#
622 unsafeFreezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
623 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
625 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
628 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ (S# s#) ->
629 case unsafeFreezeArray# arr# s# of { StateAndArray# s2# frozen# ->
630 (Array ixs frozen#, S# s2#) }
632 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
633 case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
634 (ByteArray ixs frozen#, S# s2#) }
637 --This takes a immutable array, and copies it into a mutable array, in a
640 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
641 Array IPr elt -> ST s (MutableArray s IPr elt)
644 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
645 thawArray (Array ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
646 let n# = case (if null (range ixs)
648 else (index ixs ix_end) + 1) of { I# x -> x }
650 case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
651 (MutableArray ixs thawed#, S# s2#)}
653 thaw :: Array# ele -- the thing
654 -> Int# -- size of thing to be thawed
655 -> State# s -- the Universe and everything
656 -> StateAndMutableArray# s ele
659 = case newArray# n# init s# of { StateAndMutableArray# s2# newarr1# ->
660 copy 0# n# arr# newarr1# s2# }
662 init = error "thawArray: element not copied"
666 -> MutableArray# s ele
668 -> StateAndMutableArray# s ele
670 copy cur# end# from# to# s#
672 = StateAndMutableArray# s# to#
674 = case indexArray# from# cur# of { Lift ele ->
675 case writeArray# to# cur# ele s# of { s1# ->
676 copy (cur# +# 1#) end# from# to# s1#
680 %*********************************************************
682 \subsection{Ghastly return types}
684 %*********************************************************
687 data StateAndArray# s elt = StateAndArray# (State# s) (Array# elt)
688 data StateAndMutableArray# s elt = StateAndMutableArray# (State# s) (MutableArray# s elt)
689 data StateAndByteArray# s = StateAndByteArray# (State# s) ByteArray#
690 data StateAndMutableByteArray# s = StateAndMutableByteArray# (State# s) (MutableByteArray# s)