X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelByteArr.lhs;h=050a8ed0a2f6005d7790b5b39d8ce901992bd70a;hb=8d0e6c63640414fda69fe77c126f10128a90a5f3;hp=ff44fb79cb577f3e9b670d7faafd73e79919423d;hpb=111cee3f1ad93816cb828e38b38521d85c3bcebb;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelByteArr.lhs b/ghc/lib/std/PrelByteArr.lhs
index ff44fb7..050a8ed 100644
--- a/ghc/lib/std/PrelByteArr.lhs
+++ b/ghc/lib/std/PrelByteArr.lhs
@@ -1,6 +1,9 @@
+% -----------------------------------------------------------------------------
+% $Id: PrelByteArr.lhs,v 1.13 2001/02/22 16:48:24 qrczak Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
 %
+
 \section[PrelByteArr]{Module @PrelByteArr@}
 
 Byte-arrays are flat arrays of non-pointers only.
@@ -11,15 +14,11 @@ Byte-arrays are flat arrays of non-pointers only.
 module PrelByteArr where
 
 import {-# SOURCE #-} PrelErr ( error )
+import PrelNum
 import PrelArr
 import PrelFloat
-import Ix
-import PrelList (foldl)
 import PrelST
 import PrelBase
-import PrelAddr
-import PrelGHC
-
 \end{code}
 
 %*********************************************************
@@ -64,57 +63,54 @@ it frequently. Now we've got the overloading specialiser things
 might be different, though.
 
 \begin{code}
-newCharArray, newIntArray, newWordArray, newAddrArray, newFloatArray, newDoubleArray
+newCharArray, newIntArray, newFloatArray, newDoubleArray
 	 :: Ix ix => (ix,ix) -> ST s (MutableByteArray s ix) 
 
 {-# SPECIALIZE newCharArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 {-# SPECIALIZE newIntArray    :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newWordArray   :: IPr -> ST s (MutableByteArray s Int) #-}
-{-# SPECIALIZE newAddrArray   :: IPr -> ST s (MutableByteArray s Int) #-}
 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 
 newCharArray (l,u) = ST $ \ s# ->
     case rangeSize (l,u)          of { I# n# ->
-    case (newCharArray# n# s#)	  of { (# s2#, barr# #) ->
+    case (newByteArray# (cHAR_SCALE n#) s#) of { (# s2#, barr# #) ->
     (# s2#, MutableByteArray l u barr# #) }}
 
 newIntArray (l,u) = ST $ \ s# ->
     case rangeSize (l,u)          of { I# n# ->
-    case (newIntArray# n# s#)	  of { (# s2#, barr# #) ->
+    case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
     (# s2#, MutableByteArray l u barr# #) }}
 
 newWordArray (l,u) = ST $ \ s# ->
     case rangeSize (l,u)          of { I# n# ->
-    case (newWordArray# n# s#)	  of { (# s2#, barr# #) ->
-    (# s2#, MutableByteArray l u barr# #) }}
-
-newAddrArray (l,u) = ST $ \ s# ->
-    case rangeSize (l,u)          of { I# n# ->
-    case (newAddrArray# n# s#)	  of { (# s2#, barr# #) ->
+    case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
     (# s2#, MutableByteArray l u barr# #) }}
 
 newFloatArray (l,u) = ST $ \ s# ->
     case rangeSize (l,u)          of { I# n# ->
-    case (newFloatArray# n# s#)	  of { (# s2#, barr# #) ->
+    case (newByteArray# (fLOAT_SCALE n#) s#) of { (# s2#, barr# #) ->
     (# s2#, MutableByteArray l u barr# #) }}
 
 newDoubleArray (l,u) = ST $ \ s# ->
     case rangeSize (l,u)          of { I# n# ->
-    case (newDoubleArray# n# s#)  of { (# s2#, barr# #) ->
+    case (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) ->
     (# s2#, MutableByteArray l u barr# #) }}
 
+#include "config.h"
+
+  -- Char arrays really contain only 8-bit bytes for compatibility.
+cHAR_SCALE   n = 1# *# n
+wORD_SCALE   n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n)
+dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n)
+fLOAT_SCALE  n = (case SIZEOF_FLOAT  :: Int of I# x -> x *# n)
 
 readCharArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Char 
 readIntArray    :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
-readWordArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Word
-readAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> ST s Addr
 readFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> ST s Float
 readDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Double
 
 {-# SPECIALIZE readCharArray   :: MutableByteArray s Int -> Int -> ST s Char #-}
 {-# SPECIALIZE readIntArray    :: MutableByteArray s Int -> Int -> ST s Int #-}
-{-# SPECIALIZE readAddrArray   :: MutableByteArray s Int -> Int -> ST s Addr #-}
 --NO:{-# SPECIALIZE readFloatArray  :: MutableByteArray s Int -> Int -> ST s Float #-}
 {-# SPECIALIZE readDoubleArray :: MutableByteArray s Int -> Int -> ST s Double #-}
 
@@ -128,16 +124,6 @@ readIntArray (MutableByteArray l u barr#) n = ST $ \ s# ->
     case readIntArray# barr# n# s#	of { (# s2#, r# #) ->
     (# s2#, I# r# #) }}
 
-readWordArray (MutableByteArray l u barr#) n = ST $ \ s# ->
-    case (index (l,u) n)	    	of { I# n# ->
-    case readWordArray# barr# n# s#	of { (# s2#, r# #) ->
-    (# s2#, W# r# #) }}
-
-readAddrArray (MutableByteArray l u barr#) n = ST $ \ s# ->
-    case (index (l,u) n)	    	of { I# n# ->
-    case readAddrArray# barr# n# s#	of { (# s2#, r# #) ->
-    (# s2#, A# r# #) }}
-
 readFloatArray (MutableByteArray l u barr#) n = ST $ \ s# ->
     case (index (l,u) n)	    	of { I# n# ->
     case readFloatArray# barr# n# s#	of { (# s2#, r# #) ->
@@ -151,14 +137,11 @@ readDoubleArray (MutableByteArray l u barr#) n = ST $ \ s# ->
 --Indexing of ordinary @Arrays@ is standard Haskell and isn't defined here.
 indexCharArray   :: Ix ix => ByteArray ix -> ix -> Char 
 indexIntArray    :: Ix ix => ByteArray ix -> ix -> Int
-indexWordArray   :: Ix ix => ByteArray ix -> ix -> Word
-indexAddrArray   :: Ix ix => ByteArray ix -> ix -> Addr
 indexFloatArray  :: Ix ix => ByteArray ix -> ix -> Float
 indexDoubleArray :: Ix ix => ByteArray ix -> ix -> Double
 
 {-# SPECIALIZE indexCharArray   :: ByteArray Int -> Int -> Char #-}
 {-# SPECIALIZE indexIntArray    :: ByteArray Int -> Int -> Int #-}
-{-# SPECIALIZE indexAddrArray   :: ByteArray Int -> Int -> Addr #-}
 --NO:{-# SPECIALIZE indexFloatArray  :: ByteArray Int -> Int -> Float #-}
 {-# SPECIALIZE indexDoubleArray :: ByteArray Int -> Int -> Double #-}
 
@@ -172,16 +155,6 @@ indexIntArray (ByteArray l u barr#) n
     case indexIntArray# barr# n# 	of { r# ->
     (I# r#)}}
 
-indexWordArray (ByteArray l u barr#) n
-  = case (index (l,u) n)	    	of { I# n# ->
-    case indexWordArray# barr# n# 	of { r# ->
-    (W# r#)}}
-
-indexAddrArray (ByteArray l u barr#) n
-  = case (index (l,u) n)	    	of { I# n# ->
-    case indexAddrArray# barr# n# 	of { r# ->
-    (A# r#)}}
-
 indexFloatArray (ByteArray l u barr#) n
   = case (index (l,u) n)	    	of { I# n# ->
     case indexFloatArray# barr# n# 	of { r# ->
@@ -194,14 +167,11 @@ indexDoubleArray (ByteArray l u barr#) n
 
 writeCharArray   :: Ix ix => MutableByteArray s ix -> ix -> Char -> ST s () 
 writeIntArray    :: Ix ix => MutableByteArray s ix -> ix -> Int  -> ST s () 
-writeWordArray   :: Ix ix => MutableByteArray s ix -> ix -> Word -> ST s () 
-writeAddrArray   :: Ix ix => MutableByteArray s ix -> ix -> Addr -> ST s () 
 writeFloatArray  :: Ix ix => MutableByteArray s ix -> ix -> Float -> ST s () 
 writeDoubleArray :: Ix ix => MutableByteArray s ix -> ix -> Double -> ST s () 
 
 {-# SPECIALIZE writeCharArray   :: MutableByteArray s Int -> Int -> Char -> ST s () #-}
 {-# SPECIALIZE writeIntArray    :: MutableByteArray s Int -> Int -> Int  -> ST s () #-}
-{-# SPECIALIZE writeAddrArray   :: MutableByteArray s Int -> Int -> Addr -> ST s () #-}
 --NO:{-# SPECIALIZE writeFloatArray  :: MutableByteArray s Int -> Int -> Float -> ST s () #-}
 {-# SPECIALIZE writeDoubleArray :: MutableByteArray s Int -> Int -> Double -> ST s () #-}
 
@@ -215,16 +185,6 @@ writeIntArray (MutableByteArray l u barr#) n (I# ele) = ST $ \ s# ->
     case writeIntArray# barr# n# ele s#     of { s2#   ->
     (# s2#, () #) }}
 
-writeWordArray (MutableByteArray l u barr#) n (W# ele) = ST $ \ s# ->
-    case index (l,u) n	    	    	    of { I# n# ->
-    case writeWordArray# barr# n# ele s#    of { s2#   ->
-    (# s2#, () #) }}
-
-writeAddrArray (MutableByteArray l u barr#) n (A# ele) = ST $ \ s# ->
-    case index (l,u) n	    	    	    of { I# n# ->
-    case writeAddrArray# barr# n# ele s#    of { s2#   ->
-    (# s2#, () #) }}
-
 writeFloatArray (MutableByteArray l u barr#) n (F# ele) = ST $ \ s# ->
     case index (l,u) n	    	    	    of { I# n# ->
     case writeFloatArray# barr# n# ele s#   of { s2#   ->
@@ -235,147 +195,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}