X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelByteArr.lhs;h=31eff8996f3046a979a134fc8f745ace65bc0754;hb=239e9471e104fd88ec93bf42623c3a68a496657a;hp=f51ad172a9306af9b57d06e462ea01044fa21c6e;hpb=a103a9dc0de992716e62c30d7ac81c0bc0dbcdc5;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelByteArr.lhs b/ghc/lib/std/PrelByteArr.lhs
index f51ad17..31eff89 100644
--- a/ghc/lib/std/PrelByteArr.lhs
+++ b/ghc/lib/std/PrelByteArr.lhs
@@ -1,24 +1,24 @@
+% -----------------------------------------------------------------------------
+% $Id: PrelByteArr.lhs,v 1.14 2001/05/18 16:54:05 simonmar 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.
 
 \begin{code}
-{-# OPTIONS -fcompiling-prelude -fno-implicit-prelude #-}
+{-# OPTIONS -fno-implicit-prelude #-}
 
 module PrelByteArr where
 
 import {-# SOURCE #-} PrelErr ( error )
+import PrelNum
 import PrelArr
 import PrelFloat
-import PrelList (foldl)
 import PrelST
 import PrelBase
-import PrelAddr
-import PrelGHC
-
 \end{code}
 
 %*********************************************************
@@ -49,71 +49,55 @@ instance Eq (MutableByteArray s ix) where
 %*							*
 %*********************************************************
 
-Idle ADR question: What's the tradeoff here between flattening these
-datatypes into @MutableArray ix ix (MutableArray# s elt)@ and using
-it as is?  As I see it, the former uses slightly less heap and
-provides faster access to the individual parts of the bounds while the
-code used has the benefit of providing a ready-made @(lo, hi)@ pair as
-required by many array-related functions.  Which wins? Is the
-difference significant (probably not).
-
-Idle AJG answer: When I looked at the outputted code (though it was 2
-years ago) it seems like you often needed the tuple, and we build
-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 #-}
 
@@ -127,16 +111,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# #) ->
@@ -150,14 +124,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 #-}
 
@@ -171,16 +142,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# ->
@@ -193,14 +154,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 () #-}
 
@@ -214,16 +172,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#   ->