[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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}