[project @ 2002-02-12 11:44:54 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / PrelArrExtra.lhs

diff --git a/ghc/lib/std/PrelArrExtra.lhs b/ghc/lib/std/PrelArrExtra.lhs
index 7c267fc..85292d8 100644 (file)
--- a/ghc/lib/std/PrelArrExtra.lhs
+++ b/ghc/lib/std/PrelArrExtra.lhs
@@ -1,6 +1,9 @@
+% -----------------------------------------------------------------------------
+% $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
@@ -13,72 +16,42 @@ module.
 
 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 l u arr#) = ST $ \ s# ->
-    case rangeSize (l,u)   of { I# n# ->
-    case freeze arr# n# s# of { (# s2#, frozen# #) ->
-    (# s2#, ByteArray l u 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 l u arr#) = ST $ \ s# ->
-    case rangeSize (l,u)   of { I# n# ->
-    case freeze arr# n# s# of { (# s2#, frozen# #) ->
-    (# s2#, ByteArray l u 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}