From: simonmar <unknown>
Date: Tue, 28 Mar 2000 08:52:29 +0000 (+0000)
Subject: [project @ 2000-03-28 08:52:28 by simonmar]
X-Git-Tag: Approximately_9120_patches~4892
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=7f386840ce17159c13ff452d1099e0cbce7ddb5d;hp=8fe056b22898b185813b6d4011a57135fe7d4c1d;p=ghc-hetmet.git

[project @ 2000-03-28 08:52:28 by simonmar]
Replace freeze{Char,Int,Word,Float,Double}Array with freezeByteArray
(using sizeofByteArray and a foreign import of C's memcpy()).
---

diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs
index d1d7179..f2aa415 100644
--- a/ghc/lib/std/CPUTime.lhs
+++ b/ghc/lib/std/CPUTime.lhs
@@ -20,7 +20,8 @@ module CPUTime
 import Prelude		-- To generate the dependency
 import PrelGHC		( indexIntArray# )
 import PrelBase		( Int(..) )
-import PrelByteArr  	( ByteArray(..), newIntArray, unsafeFreezeByteArray )
+import PrelByteArr  	( ByteArray(..), newIntArray )
+import PrelArrExtra     ( unsafeFreezeByteArray )
 import PrelNum		( fromInt )
 import PrelIOBase	( IOError(..), IOErrorType( UnsupportedOperation ), 
 			  unsafePerformIO, stToIO )
diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs
index ca99aa2..6e77569 100644
--- a/ghc/lib/std/Directory.lhs
+++ b/ghc/lib/std/Directory.lhs
@@ -58,9 +58,8 @@ import Prelude		-- Just to get it in the dependencies
 
 import PrelGHC		( RealWorld, or#, and# )
 import PrelByteArr	( ByteArray, MutableByteArray,
-			  newWordArray, readWordArray, newCharArray,
-			  unsafeFreezeByteArray
-			)
+			  newWordArray, readWordArray, newCharArray )
+import PrelArrExtra	( unsafeFreezeByteArray )
 import PrelPack		( unpackNBytesST, packString, unpackCStringST )
 import PrelIOBase	( stToIO,
 			  constructErrorAndFail, constructErrorAndFailWithInfo,
diff --git a/ghc/lib/std/Makefile b/ghc/lib/std/Makefile
index 841c82c..7b481c9 100644
--- a/ghc/lib/std/Makefile
+++ b/ghc/lib/std/Makefile
@@ -50,9 +50,6 @@ ifneq "$(way)" ""
 SRC_HC_OPTS += -hisuf $(way_)hi
 endif
 
-# per-module flags
-PrelArrExtra_HC_OPTS     += -monly-2-regs
-
 # Far too much heap is needed to compile PrelNumExtra with -O at the
 # moment, but there you go..
 PrelNumExtra_HC_OPTS     += -H24m -K2m
diff --git a/ghc/lib/std/PrelArrExtra.lhs b/ghc/lib/std/PrelArrExtra.lhs
index 840e9dd..8984c24 100644
--- a/ghc/lib/std/PrelArrExtra.lhs
+++ b/ghc/lib/std/PrelArrExtra.lhs
@@ -17,69 +17,40 @@ import Ix
 import PrelArr
 import PrelByteArr
 import PrelST
+import PrelIOBase
 import PrelBase
 import PrelGHC
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Moving between mutable and immutable}
+%*							*
+%*********************************************************
 
-freezeFloatArray  :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
+\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 (newCharArray# 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}
diff --git a/ghc/lib/std/PrelByteArr.lhs b/ghc/lib/std/PrelByteArr.lhs
index ff44fb7..3533ee3 100644
--- a/ghc/lib/std/PrelByteArr.lhs
+++ b/ghc/lib/std/PrelByteArr.lhs
@@ -235,147 +235,3 @@ writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
     case writeDoubleArray# barr# n# ele s#  of { s2#   ->
     (# s2#, () #) }}
 \end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Moving between mutable and immutable}
-%*							*
-%*********************************************************
-
-\begin{code}
-freezeCharArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeIntArray    :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeWordArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-freezeAddrArray   :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-
-{-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
-
-freezeCharArray (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# #)
-
-    freeze arr1# n# s1#
-      = case (newCharArray# 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 #)
-
-	copy cur# end# from# to# st#
-	  | cur# ==# end#
-	    = (# st#, to# #)
-	  | otherwise
-	    = case (readCharArray#  from# cur#     st#) of { (# s2#, ele #) ->
-	      case (writeCharArray# to#   cur# ele s2#) of { s3# ->
-	      copy (cur# +# 1#) end# from# to# s3#
-	      }}
-
-freezeIntArray (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# #)
-
-    freeze m_arr# n# s#
-      = case (newIntArray# n# s#)    	     of { (# s2#, newarr1# #) ->
-	case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> (# State# s, MutableByteArray# s #)
-
-	copy cur# end# from# to# s1#
-	  | cur# ==# end#
-	    = (# s1#, to# #)
-	  | otherwise
-	    = case (readIntArray#  from# cur#     s1#) of { (# s2#, ele #) ->
-	      case (writeIntArray# to#   cur# ele s2#) of { s3# ->
-	      copy (cur# +# 1#) end# from# to# s3#
-	      }}
-
-freezeWordArray (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# #)
-
-    freeze m_arr# n# s1#
-      = case (newWordArray# n# s1#)    	     of { (# s2#, newarr1# #) ->
-	case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> (# State# s, MutableByteArray# s #)
-
-	copy cur# end# from# to# st#
-	  | cur# ==# end#  = (# st#, to# #)
-	  | otherwise      =
-	     case (readWordArray#  from# cur#     st#) of { (# s2#, ele #) ->
-	     case (writeWordArray# to#   cur# ele s2#) of { s3# ->
-	     copy (cur# +# 1#) end# from# to# s3#
-	     }}
-
-freezeAddrArray (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# #)
-
-    freeze m_arr# n# s1#
-      = case (newAddrArray# n# s1#)    	     of { (# s2#, newarr1# #) ->
-	case copy 0# n# m_arr# newarr1# s2#  of { (# s3#, newarr2# #) ->
-	unsafeFreezeByteArray# newarr2# s3#
-	}}
-      where
-	copy :: Int# -> Int#
-	     -> MutableByteArray# s -> MutableByteArray# s
-	     -> State# s
-	     -> (# State# s, MutableByteArray# s #)
-
-	copy cur# end# from# to# st#
-	  | cur# ==# end#
-	    = (# st#, to# #)
-	  | otherwise
-	    = case (readAddrArray#  from# cur#     st#)  of { (# st1#, ele #) ->
-	      case (writeAddrArray# to#   cur# ele st1#) of { st2# ->
-	      copy (cur# +# 1#) end# from# to# st2#
-	      }}
-
-unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
-
-{-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
-  #-}
-
-unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
-    case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
-    (# s2#, ByteArray l u frozen# #) }
-\end{code}