ghc/lib/ghc/ArrBase.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[ArrBase]{Module @ArrBase@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module  ArrBase where
  11
  12 import {-# SOURCE #-}   IOBase  ( error )
  13 import Ix
  14 import PrelList
  15 import STBase
  16 import PrelBase
  17 import GHC
  18
  19 infixl 9  !, //
  20 \end{code}
  21
  22 \begin{code}
  23 {-# GENERATE_SPECS array a{~,Int,IPr} b{} #-}
  24 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
  25
  26 {-# GENERATE_SPECS (!) a{~,Int,IPr} b{} #-}
  27 (!)                   :: (Ix a) => Array a b -> a -> b
  28
  29 bounds                :: (Ix a) => Array a b -> (a,a)
  30
  31 {-# GENERATE_SPECS (//) a{~,Int,IPr} b{} #-}
  32 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
  33
  34 {-# GENERATE_SPECS accum a{~,Int,IPr} b{} c{} #-}
  35 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
  36
  37 {-# GENERATE_SPECS accumArray a{~,Int,IPr} b{} c{} #-}
  38 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
  39 \end{code}
  40
  41
  42 %*********************************************************
  43 %*                                                      *
  44 \subsection{The @Array@ types}
  45 %*                                                      *
  46 %*********************************************************
  47
  48 \begin{code}
  49 type IPr = (Int, Int)
  50
  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)
  55 \end{code}
  56
  57
  58 %*********************************************************
  59 %*                                                      *
  60 \subsection{Operations on immutable arrays}
  61 %*                                                      *
  62 %*********************************************************
  63
  64 "array", "!" and "bounds" are basic; the rest can be defined in terms of them
  65
  66 \begin{code}
  67 bounds (Array b _)  = b
  68
  69 (Array bounds arr#) ! i
  70   = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
  71     in
  72     case (indexArray# arr# n#) of
  73       Lift v -> v
  74
  75 #ifdef USE_FOLDR_BUILD
  76 {-# INLINE array #-}
  77 #endif
  78 array ixs@(ix_start, ix_end) ivs =
  79    runST ( ST $ \ s ->
  80         case (newArray ixs arrEleBottom)        of { ST new_array_thing ->
  81         case (new_array_thing s)                of { (arr@(MutableArray _ arr#),s) ->
  82         let
  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#   ->
  86                S# s2# }}
  87         in
  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 }}}})
  91
  92 arrEleBottom = error "(Array.!): undefined array element"
  93
  94 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
  95 fill_it_in arr lst
  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
 100
 101 -----------------------------------------------------------------------
 102 -- these also go better with magic: (//), accum, accumArray
 103
 104 old_array // ivs
 105   = runST (
 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`
 110         freezeArray arr
 111     )
 112   where
 113     bottom = error "(Array.//): error in copying old array\n"
 114
 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
 117
 118 zap_with_f f arr lst
 119   = foldr zap_one (returnStrictlyST ()) lst
 120   where
 121     zap_one (i, new_v) rst
 122       = readArray  arr i                 `thenStrictlyST`  \ old_v ->
 123         writeArray arr i (f old_v new_v) `seqStrictlyST`
 124         rst
 125
 126 accum f old_array ivs
 127   = runST (
 128         -- copy the old array:
 129         thawArray old_array                 `thenStrictlyST` \ arr ->
 130
 131         -- now zap the elements in question with "f":
 132         zap_with_f f arr ivs            >>
 133         freezeArray arr
 134     )
 135   where
 136     bottom = error "Array.accum: error in copying old array\n"
 137
 138 accumArray f zero ixs ivs
 139   = runST (
 140         newArray ixs zero       >>= \ arr# ->
 141         zap_with_f f  arr# ivs  >>
 142         freezeArray arr#
 143     )
 144 \end{code}
 145
 146
 147 %*********************************************************
 148 %*                                                      *
 149 \subsection{Operations on mutable arrays}
 150 %*                                                      *
 151 %*********************************************************
 152
 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).
 160
 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.
 165
 166 \begin{code}
 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)
 170
 171 {-# SPECIALIZE newArray      :: IPr       -> elt -> ST s (MutableArray s Int elt),
 172                                 (IPr,IPr) -> elt -> ST s (MutableArray s IPr elt)
 173   #-}
 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) #-}
 179
 180 newArray ixs@(ix_start, ix_end) init = ST $ \ (S# s#) ->
 181     let n# = case (if null (range ixs)
 182                   then 0
 183                   else (index ixs ix_end) + 1) of { I# x -> x }
 184         -- size is one bigger than index of last elem
 185     in
 186     case (newArray# n# init s#)     of { StateAndMutableArray# s2# arr# ->
 187     (MutableArray ixs arr#, S# s2#)}
 188
 189 newCharArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
 190     let n# = case (if null (range ixs)
 191                   then 0
 192                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 193     in
 194     case (newCharArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 195     (MutableByteArray ixs barr#, S# s2#)}
 196
 197 newIntArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
 198     let n# = case (if null (range ixs)
 199                   then 0
 200                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 201     in
 202     case (newIntArray# n# s#)     of { StateAndMutableByteArray# s2# barr# ->
 203     (MutableByteArray ixs barr#, S# s2#)}
 204
 205 newAddrArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
 206     let n# = case (if null (range ixs)
 207                   then 0
 208                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 209     in
 210     case (newAddrArray# n# s#)    of { StateAndMutableByteArray# s2# barr# ->
 211     (MutableByteArray ixs barr#, S# s2#)}
 212
 213 newFloatArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
 214     let n# = case (if null (range ixs)
 215                   then 0
 216                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 217     in
 218     case (newFloatArray# n# s#)   of { StateAndMutableByteArray# s2# barr# ->
 219     (MutableByteArray ixs barr#, S# s2#)}
 220
 221 newDoubleArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
 222     let n# = case (if null (range ixs)
 223                   then 0
 224                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 225     in
 226     case (newDoubleArray# n# s#)  of { StateAndMutableByteArray# s2# barr# ->
 227     (MutableByteArray ixs barr#, S# s2#)}
 228
 229 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)
 230 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
 231
 232 {-# SPECIALIZE boundsOfArray     :: MutableArray s Int elt -> IPr #-}
 233 {-# SPECIALIZE boundsOfByteArray :: MutableByteArray s Int -> IPr #-}
 234
 235 boundsOfArray     (MutableArray     ixs _) = ixs
 236 boundsOfByteArray (MutableByteArray ixs _) = ixs
 237
 238 readArray       :: Ix ix => MutableArray s ix elt -> ix -> ST s elt
 239
 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
 245
 246 {-# SPECIALIZE readArray       :: MutableArray s Int elt -> Int -> ST s elt,
 247                                   MutableArray s IPr elt -> IPr -> ST s elt
 248   #-}
 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 #-}
 254
 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 ->
 258     (r, S# s2#)}}
 259
 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# ->
 263     (C# r#, S# s2#)}}
 264
 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# ->
 268     (I# r#, S# s2#)}}
 269
 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# ->
 273     (A# r#, S# s2#)}}
 274
 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# ->
 278     (F# r#, S# s2#)}}
 279
 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# ->
 283     (D# r#, S# s2#)}}
 284
 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
 291
 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 #-}
 297
 298 indexCharArray (ByteArray ixs barr#) n
 299   = case (index ixs n)                  of { I# n# ->
 300     case indexCharArray# barr# n#       of { r# ->
 301     (C# r#)}}
 302
 303 indexIntArray (ByteArray ixs barr#) n
 304   = case (index ixs n)                  of { I# n# ->
 305     case indexIntArray# barr# n#        of { r# ->
 306     (I# r#)}}
 307
 308 indexAddrArray (ByteArray ixs barr#) n
 309   = case (index ixs n)                  of { I# n# ->
 310     case indexAddrArray# barr# n#       of { r# ->
 311     (A# r#)}}
 312
 313 indexFloatArray (ByteArray ixs barr#) n
 314   = case (index ixs n)                  of { I# n# ->
 315     case indexFloatArray# barr# n#      of { r# ->
 316     (F# r#)}}
 317
 318 indexDoubleArray (ByteArray ixs barr#) n
 319   = case (index ixs n)                  of { I# n# ->
 320     case indexDoubleArray# barr# n#     of { r# ->
 321     (D# r#)}}
 322
 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
 329
 330 indexCharOffAddr (A# addr#) n
 331   = case n                              of { I# n# ->
 332     case indexCharOffAddr# addr# n#     of { r# ->
 333     (C# r#)}}
 334
 335 indexIntOffAddr (A# addr#) n
 336   = case n                              of { I# n# ->
 337     case indexIntOffAddr# addr# n#      of { r# ->
 338     (I# r#)}}
 339
 340 indexAddrOffAddr (A# addr#) n
 341   = case n                              of { I# n# ->
 342     case indexAddrOffAddr# addr# n#     of { r# ->
 343     (A# r#)}}
 344
 345 indexFloatOffAddr (A# addr#) n
 346   = case n                              of { I# n# ->
 347     case indexFloatOffAddr# addr# n#    of { r# ->
 348     (F# r#)}}
 349
 350 indexDoubleOffAddr (A# addr#) n
 351   = case n                              of { I# n# ->
 352     case indexDoubleOffAddr# addr# n#   of { r# ->
 353     (D# r#)}}
 354
 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 ()
 361
 362 {-# SPECIALIZE writeArray       :: MutableArray s Int elt -> Int -> elt -> ST s (),
 363                                    MutableArray s IPr elt -> IPr -> elt -> ST s ()
 364   #-}
 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 () #-}
 370
 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# ->
 374     ((), S# s2#)}}
 375
 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#   ->
 379     ((), S# s2#)}}
 380
 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#   ->
 384     ((), S# s2#)}}
 385
 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#   ->
 389     ((), S# s2#)}}
 390
 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#   ->
 394     ((), S# s2#)}}
 395
 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#   ->
 399     ((), S# s2#)}}
 400 \end{code}
 401
 402
 403 %*********************************************************
 404 %*                                                      *
 405 \subsection{Moving between mutable and immutable}
 406 %*                                                      *
 407 %*********************************************************
 408
 409 \begin{code}
 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)
 416
 417 {-# SPECIALISE freezeArray :: MutableArray s Int elt -> ST s (Array Int elt),
 418                               MutableArray s IPr elt -> ST s (Array IPr elt)
 419   #-}
 420 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 421
 422 freezeArray (MutableArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 423     let n# = case (if null (range ixs)
 424                   then 0
 425                   else (index ixs ix_end) + 1) of { I# x -> x }
 426     in
 427     case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
 428     (Array ixs frozen#, S# s2#)}
 429   where
 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
 434
 435     freeze arr# n# s#
 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#
 439         }}
 440       where
 441         init = error "freezeArray: element not copied"
 442
 443         copy :: Int# -> Int#
 444              -> MutableArray# s ele -> MutableArray# s ele
 445              -> State# s
 446              -> StateAndMutableArray# s ele
 447
 448         copy cur# end# from# to# s#
 449           | cur# ==# end#
 450             = StateAndMutableArray# s# to#
 451           | True
 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#
 455               }}
 456
 457 freezeCharArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 458     let n# = case (if null (range ixs)
 459                   then 0
 460                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 461     in
 462     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 463     (ByteArray ixs frozen#, S# s2#) }
 464   where
 465     freeze  :: MutableByteArray# s      -- the thing
 466             -> Int#                     -- size of thing to be frozen
 467             -> State# s                 -- the Universe and everything
 468             -> StateAndByteArray# s
 469
 470     freeze arr# n# 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#
 474         }}
 475       where
 476         copy :: Int# -> Int#
 477              -> MutableByteArray# s -> MutableByteArray# s
 478              -> State# s
 479              -> StateAndMutableByteArray# s
 480
 481         copy cur# end# from# to# s#
 482           | cur# ==# end#
 483             = StateAndMutableByteArray# s# to#
 484           | True
 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#
 488               }}
 489
 490 freezeIntArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 491     let n# = case (if null (range ixs)
 492                   then 0
 493                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 494     in
 495     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 496     (ByteArray ixs frozen#, S# s2#) }
 497   where
 498     freeze  :: MutableByteArray# s      -- the thing
 499             -> Int#                     -- size of thing to be frozen
 500             -> State# s                 -- the Universe and everything
 501             -> StateAndByteArray# s
 502
 503     freeze arr# n# 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#
 507         }}
 508       where
 509         copy :: Int# -> Int#
 510              -> MutableByteArray# s -> MutableByteArray# s
 511              -> State# s
 512              -> StateAndMutableByteArray# s
 513
 514         copy cur# end# from# to# s#
 515           | cur# ==# end#
 516             = StateAndMutableByteArray# s# to#
 517           | True
 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#
 521               }}
 522
 523 freezeAddrArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 524     let n# = case (if null (range ixs)
 525                   then 0
 526                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 527     in
 528     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 529     (ByteArray ixs frozen#, S# s2#) }
 530   where
 531     freeze  :: MutableByteArray# s      -- the thing
 532             -> Int#                     -- size of thing to be frozen
 533             -> State# s                 -- the Universe and everything
 534             -> StateAndByteArray# s
 535
 536     freeze arr# n# 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#
 540         }}
 541       where
 542         copy :: Int# -> Int#
 543              -> MutableByteArray# s -> MutableByteArray# s
 544              -> State# s
 545              -> StateAndMutableByteArray# s
 546
 547         copy cur# end# from# to# s#
 548           | cur# ==# end#
 549             = StateAndMutableByteArray# s# to#
 550           | True
 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#
 554               }}
 555
 556 freezeFloatArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 557     let n# = case (if null (range ixs)
 558                   then 0
 559                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 560     in
 561     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 562     (ByteArray ixs frozen#, S# s2#) }
 563   where
 564     freeze  :: MutableByteArray# s      -- the thing
 565             -> Int#                     -- size of thing to be frozen
 566             -> State# s                 -- the Universe and everything
 567             -> StateAndByteArray# s
 568
 569     freeze arr# n# 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#
 573         }}
 574       where
 575         copy :: Int# -> Int#
 576              -> MutableByteArray# s -> MutableByteArray# s
 577              -> State# s
 578              -> StateAndMutableByteArray# s
 579
 580         copy cur# end# from# to# s#
 581           | cur# ==# end#
 582             = StateAndMutableByteArray# s# to#
 583           | True
 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#
 587               }}
 588
 589 freezeDoubleArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 590     let n# = case (if null (range ixs)
 591                   then 0
 592                   else ((index ixs ix_end) + 1)) of { I# x -> x }
 593     in
 594     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
 595     (ByteArray ixs frozen#, S# s2#) }
 596   where
 597     freeze  :: MutableByteArray# s      -- the thing
 598             -> Int#                     -- size of thing to be frozen
 599             -> State# s                 -- the Universe and everything
 600             -> StateAndByteArray# s
 601
 602     freeze arr# n# 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#
 606         }}
 607       where
 608         copy :: Int# -> Int#
 609              -> MutableByteArray# s -> MutableByteArray# s
 610              -> State# s
 611              -> StateAndMutableByteArray# s
 612
 613         copy cur# end# from# to# s#
 614           | cur# ==# end#
 615             = StateAndMutableByteArray# s# to#
 616           | True
 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#
 620               }}
 621
 622 unsafeFreezeArray     :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
 623 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
 624
 625 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
 626   #-}
 627
 628 unsafeFreezeArray (MutableArray ixs arr#) = ST $ \ (S# s#) ->
 629     case unsafeFreezeArray# arr# s# of { StateAndArray# s2# frozen# ->
 630     (Array ixs frozen#, S# s2#) }
 631
 632 unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
 633     case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
 634     (ByteArray ixs frozen#, S# s2#) }
 635
 636
 637 --This takes a immutable array, and copies it into a mutable array, in a
 638 --hurry.
 639
 640 {-# SPECIALISE thawArray :: Array Int elt -> ST s (MutableArray s Int elt),
 641                             Array IPr elt -> ST s (MutableArray s IPr elt)
 642   #-}
 643
 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)
 647                   then 0
 648                   else (index ixs ix_end) + 1) of { I# x -> x }
 649     in
 650     case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
 651     (MutableArray ixs thawed#, S# s2#)}
 652   where
 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
 657
 658     thaw arr# n# s#
 659       = case newArray# n# init s#             of { StateAndMutableArray# s2# newarr1# ->
 660         copy 0# n# arr# newarr1# s2# }
 661       where
 662         init = error "thawArray: element not copied"
 663
 664         copy :: Int# -> Int#
 665              -> Array# ele
 666              -> MutableArray# s ele
 667              -> State# s
 668              -> StateAndMutableArray# s ele
 669
 670         copy cur# end# from# to# s#
 671           | cur# ==# end#
 672             = StateAndMutableArray# s# to#
 673           | True
 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#
 677               }}
 678 \end{code}
 679
 680 %*********************************************************
 681 %*                                                      *
 682 \subsection{Ghastly return types}
 683 %*                                                      *
 684 %*********************************************************
 685
 686 \begin{code}
 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)
 691 \end{code}