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 PrelST
  19 import PrelBase
  20 import PrelGHC
  21
  22 freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  23 freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  24
  25 freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ s# ->
  26     case rangeSize ixs     of { I# n# ->
  27     case freeze arr# n# s# of { (# s2#, frozen# #) ->
  28     (# s2#, ByteArray ixs frozen# #) }}
  29   where
  30     freeze  :: MutableByteArray# s      -- the thing
  31             -> Int#                     -- size of thing to be frozen
  32             -> State# s                 -- the Universe and everything
  33             -> (# State# s, ByteArray# #)
  34
  35     freeze arr1# end# s#
  36       = case (newFloatArray# end# s#)    of { (# s2#, newarr1# #) ->
  37         case copy 0# arr1# newarr1# s2#  of { (# s3#, newarr2# #) ->
  38         unsafeFreezeByteArray# newarr2# s3#
  39         }}
  40       where
  41         copy :: Int#
  42              -> MutableByteArray# s -> MutableByteArray# s
  43              -> State# s
  44              -> (# State# s, MutableByteArray# s #)
  45
  46         copy cur# from# to# s1#
  47           | cur# ==# end#
  48             = (# s1#, to# #)
  49           | otherwise
  50             = case (readFloatArray#  from# cur#     s1#)  of { (# s2#, ele #) ->
  51               case (writeFloatArray# to#   cur# ele s2#)  of { s3# ->
  52               copy (cur# +# 1#) from# to# s3#
  53               }}
  54
  55 freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ s# ->
  56     case rangeSize ixs     of { I# n# ->
  57     case freeze arr# n# s# of { (# s2#, frozen# #) ->
  58     (# s2#, ByteArray ixs frozen# #) }}
  59   where
  60     freeze  :: MutableByteArray# s      -- the thing
  61             -> Int#                     -- size of thing to be frozen
  62             -> State# s                 -- the Universe and everything
  63             -> (# State# s, ByteArray# #)
  64
  65     freeze arr1# n# s1#
  66       = case (newDoubleArray# n# s1#)      of { (# s2#, newarr1# #) ->
  67         case copy 0# n# arr1# newarr1# s2# of { (# s3#, newarr2# #) ->
  68         unsafeFreezeByteArray# newarr2# s3#
  69         }}
  70       where
  71         copy :: Int# -> Int#
  72              -> MutableByteArray# s -> MutableByteArray# s
  73              -> State# s
  74              -> (# State# s, MutableByteArray# s #)
  75
  76         copy cur# end# from# to# st#
  77           | cur# ==# end#
  78             = (# st#, to# #)
  79           | otherwise
  80             = case (readDoubleArray#  from# cur#     st#) of { (# s2#, ele #) ->
  81               case (writeDoubleArray# to#   cur# ele s2#) of { s3# ->
  82               copy (cur# +# 1#) end# from# to# s3#
  83               }}
  84 \end{code}