X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelArrExtra.lhs;h=85292d8d21471555babd36c2f20cf55b6eff0942;hb=225d251337438e2f7870f0ec2781b1c616ef7462;hp=7c267fccc4c3ccf1e5187dc153d576131da488dd;hpb=34df35343c166dea72507b5d626d7ca792d436c9;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelArrExtra.lhs b/ghc/lib/std/PrelArrExtra.lhs
index 7c267fc..85292d8d 100644
--- 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}