ghc/lib/std/PrelArrExtra.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelArrExtra.lhs,v 1.10 2000/06/30 13:39:35 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[PrelArrExtra]{Module @PrelArrExtra@}
   8
   9 The following functions should be in PrelArr, but need -monly-2-regs
  10 to compile.  So as not to compile the whole of PrelArr with
  11 -monly-2-regs, the culprits have been moved out into a separate
  12 module.
  13
  14 \begin{code}
  15 {-# OPTIONS -fno-implicit-prelude #-}
  16
  17 module PrelArrExtra where
  18
  19 import PrelArr
  20 import PrelByteArr
  21 import PrelST
  22 import PrelIOBase
  23 import PrelBase
  24 import PrelGHC
  25 \end{code}
  26
  27 %*********************************************************
  28 %*                                                      *
  29 \subsection{Moving between mutable and immutable}
  30 %*                                                      *
  31 %*********************************************************
  32
  33 \begin{code}
  34 freezeByteArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  35
  36 {-# SPECIALISE freezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
  37
  38 -- This coercion of memcpy to the ST monad is safe, because memcpy
  39 -- only modifies its destination operand, which is already MutableByteArray.
  40 freezeByteArray (MutableByteArray l u arr) = ST $ \ s ->
  41         let n = sizeofMutableByteArray# arr in
  42         case (newCharArray# n s)                   of { (# s, newarr #) ->
  43         case ((unsafeCoerce# memcpy) newarr arr n s) of { (# s, () #) ->
  44         case unsafeFreezeByteArray# newarr s       of { (# s, frozen #) ->
  45         (# s, ByteArray l u frozen #) }}}
  46
  47 foreign import "memcpy" unsafe
  48   memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
  49
  50 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  51
  52 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
  53   #-}
  54
  55 unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
  56     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
  57     (# s2#, ByteArray l u frozen# #) }
  58 \end{code}