ghc/lib/std/PrelArrExtra.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4 \section[PrelArrExtra]{Module @PrelArrExtra@}
   5
   6 The following functions should be in PrelArr, but need -monly-2-regs
   7 to compile.  So as not to compile the whole of PrelArr with
   8 -monly-2-regs, the culprits have been moved out into a separate
   9 module.
  10
  11 \begin{code}
  12 {-# OPTIONS -fno-implicit-prelude #-}
  13
  14 module PrelArrExtra where
  15
  16 import Ix
  17 import PrelArr
  18 import PrelByteArr
  19 import PrelST
  20 import PrelBase
  21 import PrelGHC
  22
  23 freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  24 freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  25
  26 freezeFloatArray (MutableByteArray l u arr#) = ST $ \ s# ->
  27     case rangeSize (l,u)   of { I# n# ->
  28     case freeze arr# n# s# of { (# s2#, frozen# #) ->
  29     (# s2#, ByteArray l u frozen# #) }}
  30   where
  31     freeze  :: MutableByteArray# s      -- the thing
  32             -> Int#                     -- size of thing to be frozen
  33             -> State# s                 -- the Universe and everything
  34             -> (# State# s, ByteArray# #)
  35
  36     freeze arr1# end# s#
  37       = case (newFloatArray# end# s#)    of { (# s2#, newarr1# #) ->
  38         case copy 0# arr1# newarr1# s2#  of { (# s3#, newarr2# #) ->
  39         unsafeFreezeByteArray# newarr2# s3#
  40         }}
  41       where
  42         copy :: Int#
  43              -> MutableByteArray# s -> MutableByteArray# s
  44              -> State# s
  45              -> (# State# s, MutableByteArray# s #)
  46
  47         copy cur# from# to# s1#
  48           | cur# ==# end#
  49             = (# s1#, to# #)
  50           | otherwise
  51             = case (readFloatArray#  from# cur#     s1#)  of { (# s2#, ele #) ->
  52               case (writeFloatArray# to#   cur# ele s2#)  of { s3# ->
  53               copy (cur# +# 1#) from# to# s3#
  54               }}
  55
  56 freezeDoubleArray (MutableByteArray l u arr#) = ST $ \ s# ->
  57     case rangeSize (l,u)   of { I# n# ->
  58     case freeze arr# n# s# of { (# s2#, frozen# #) ->
  59     (# s2#, ByteArray l u frozen# #) }}
  60   where
  61     freeze  :: MutableByteArray# s      -- the thing
  62             -> Int#                     -- size of thing to be frozen
  63             -> State# s                 -- the Universe and everything
  64             -> (# State# s, ByteArray# #)
  65
  66     freeze arr1# n# s1#
  67       = case (newDoubleArray# n# s1#)      of { (# s2#, newarr1# #) ->
  68         case copy 0# n# arr1# newarr1# s2# of { (# s3#, newarr2# #) ->
  69         unsafeFreezeByteArray# newarr2# s3#
  70         }}
  71       where
  72         copy :: Int# -> Int#
  73              -> MutableByteArray# s -> MutableByteArray# s
  74              -> State# s
  75              -> (# State# s, MutableByteArray# s #)
  76
  77         copy cur# end# from# to# st#
  78           | cur# ==# end#
  79             = (# st#, to# #)
  80           | otherwise
  81             = case (readDoubleArray#  from# cur#     st#) of { (# s2#, ele #) ->
  82               case (writeDoubleArray# to#   cur# ele s2#) of { s3# ->
  83               copy (cur# +# 1#) end# from# to# s3#
  84               }}
  85 \end{code}