+% -----------------------------------------------------------------------------
+% $Id: PrelArrExtra.lhs,v 1.12 2000/12/12 12:19:58 simonmar Exp $
%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
%
+
\section[PrelArrExtra]{Module @PrelArrExtra@}
The following functions should be in PrelArr, but need -monly-2-regs
module PrelArrExtra where
-import Ix
import PrelArr
+import PrelByteArr
import PrelST
+import PrelIOBase
import PrelBase
-import PrelGHC
+\end{code}
-freezeFloatArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+%*********************************************************
+%* *
+\subsection{Moving between mutable and immutable}
+%* *
+%*********************************************************
+
+\begin{code}
+freezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
+{-# SPECIALISE freezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
- freeze arr1# end# s#
- = case (newFloatArray# end# s#) of { (# s2#, newarr1# #) ->
- case copy 0# arr1# newarr1# s2# of { (# s3#, newarr2# #) ->
- unsafeFreezeByteArray# newarr2# s3#
- }}
- where
- copy :: Int#
- -> MutableByteArray# s -> MutableByteArray# s
- -> State# s
- -> (# State# s, MutableByteArray# s #)
+-- This coercion of memcpy to the ST monad is safe, because memcpy
+-- only modifies its destination operand, which is already MutableByteArray.
+freezeByteArray (MutableByteArray l u arr) = ST $ \ s ->
+ let n = sizeofMutableByteArray# arr in
+ case (newByteArray# n s) of { (# s, newarr #) ->
+ case ((unsafeCoerce# memcpy) newarr arr n s) of { (# s, () #) ->
+ case unsafeFreezeByteArray# newarr s of { (# s, frozen #) ->
+ (# s, ByteArray l u frozen #) }}}
- copy cur# from# to# s1#
- | cur# ==# end#
- = (# s1#, to# #)
- | otherwise
- = case (readFloatArray# from# cur# s1#) of { (# s2#, ele #) ->
- case (writeFloatArray# to# cur# ele s2#) of { s3# ->
- copy (cur# +# 1#) from# to# s3#
- }}
+foreign import "memcpy" unsafe
+ memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
-freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ s# ->
- case rangeSize ixs of { I# n# ->
- case freeze arr# n# s# of { (# s2#, frozen# #) ->
- (# s2#, ByteArray ixs frozen# #) }}
- where
- freeze :: MutableByteArray# s -- the thing
- -> Int# -- size of thing to be frozen
- -> State# s -- the Universe and everything
- -> (# State# s, ByteArray# #)
+unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
- freeze arr1# n# s1#
- = case (newDoubleArray# n# s1#) of { (# s2#, newarr1# #) ->
- case copy 0# n# arr1# newarr1# s2# of { (# s3#, newarr2# #) ->
- unsafeFreezeByteArray# newarr2# s3#
- }}
- where
- copy :: Int# -> Int#
- -> MutableByteArray# s -> MutableByteArray# s
- -> State# s
- -> (# State# s, MutableByteArray# s #)
+{-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
+ #-}
- copy cur# end# from# to# st#
- | cur# ==# end#
- = (# st#, to# #)
- | otherwise
- = case (readDoubleArray# from# cur# st#) of { (# s2#, ele #) ->
- case (writeDoubleArray# to# cur# ele s2#) of { s3# ->
- copy (cur# +# 1#) end# from# to# s3#
- }}
+unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
+ case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
+ (# s2#, ByteArray l u frozen# #) }
\end{code}