ghc/lib/std/PrelArrExtra.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelArrExtra.lhs,v 1.12 2000/12/12 12:19:58 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 \end{code}
  25
  26 %*********************************************************
  27 %*                                                      *
  28 \subsection{Moving between mutable and immutable}
  29 %*                                                      *
  30 %*********************************************************
  31
  32 \begin{code}
  33 freezeByteArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  34
  35 {-# SPECIALISE freezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
  36
  37 -- This coercion of memcpy to the ST monad is safe, because memcpy
  38 -- only modifies its destination operand, which is already MutableByteArray.
  39 freezeByteArray (MutableByteArray l u arr) = ST $ \ s ->
  40         let n = sizeofMutableByteArray# arr in
  41         case (newByteArray# n s)                   of { (# s, newarr #) ->
  42         case ((unsafeCoerce# memcpy) newarr arr n s) of { (# s, () #) ->
  43         case unsafeFreezeByteArray# newarr s       of { (# s, frozen #) ->
  44         (# s, ByteArray l u frozen #) }}}
  45
  46 foreign import "memcpy" unsafe
  47   memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
  48
  49 unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
  50
  51 {-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
  52   #-}
  53
  54 unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
  55     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
  56     (# s2#, ByteArray l u frozen# #) }
  57 \end{code}