X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FArray%2FBase.hs;h=dee798fdb7fcef18927f1dd689e54daa462ca60b;hb=f7a485978f04e84b086f1974b88887cc72d832d0;hp=d6d9cd450cccc3bb0de89d3e78e008c281396fa0;hpb=b0a9f0fb0ddfe48793e9c2d74593800566345e08;p=ghc-base.git

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index d6d9cd4..dee798f 100644
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1,16 +1,14 @@
 {-# OPTIONS -monly-3-regs #-}
 -----------------------------------------------------------------------------
--- 
+-- |
 -- Module      :  Data.Array.Base
 -- Copyright   :  (c) The University of Glasgow 2001
--- License     :  BSD-style (see the file libraries/core/LICENSE)
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: Base.hs,v 1.2 2001/07/31 13:28:58 simonmar Exp $
---
 -- Basis for IArray and MArray.  Not intended for external consumption;
 -- use IArray or MArray instead.
 --
@@ -38,6 +36,8 @@ import GHC.Word		( Word8(..), Word16(..), Word32(..), Word64(..) )
 import Data.Dynamic
 #include "Dynamic.h"
 
+#include "MachDeps.h"
+
 -----------------------------------------------------------------------------
 -- Class of immutable arrays
 
@@ -317,9 +317,16 @@ cmpIntUArray arr1@(UArray l1 u1 _) arr2@(UArray l2 u2 _) =
 
 {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-}
 
-showsUArray :: (IArray UArray e, Ix i, Show i, Show e)
-            => Int -> UArray i e -> ShowS
-showsUArray p a =
+-----------------------------------------------------------------------------
+-- Showing IArrays
+
+{-# SPECIALISE 
+    showsIArray :: (IArray UArray e, Ix i, Show i, Show e) => 
+		   Int -> UArray i e -> ShowS
+  #-}
+
+showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS
+showsIArray p a =
     showParen (p > 9) $
     showString "array " .
     shows (bounds a) .
@@ -635,46 +642,46 @@ instance Ix ix => Ord (UArray ix Word64) where
     compare = cmpUArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Bool) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Char) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Int) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Word) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Float) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Double) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Int8) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Int16) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Int32) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Int64) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Word8) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Word16) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Word32) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 instance (Ix ix, Show ix) => Show (UArray ix Word64) where
-    showsPrec = showsUArray
+    showsPrec = showsIArray
 
 -----------------------------------------------------------------------------
 -- Mutable arrays
@@ -1004,7 +1011,7 @@ instance MArray (STUArray s) Int64 (ST s) where
         case newByteArray# (n# *# 8#) s1# of { (# s2#, marr# #) ->
         (# s2#, STUArray l u marr# #) }}
     {-# INLINE unsafeRead #-}
-    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# ->
+    unsafeRead (STUArray _ _ marr#) (I# i#) = ST $ \s1# -> 
         case readInt64Array# marr# i# s1# of { (# s2#, e# #) ->
         (# s2#, I64# e# #) }
     {-# INLINE unsafeWrite #-}
@@ -1075,28 +1082,26 @@ instance MArray (STUArray s) Word64 (ST s) where
 -----------------------------------------------------------------------------
 -- Translation between elements and bytes
 
-#include "config.h"
-
 bOOL_SCALE, bOOL_WORD_SCALE,
   wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
-bOOL_SCALE n# = (n# +# last#) `iShiftRA#` 3#
-  where I# last# = SIZEOF_VOID_P * 8 - 1
+bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
+  where I# last# = SIZEOF_HSWORD * 8 - 1
 bOOL_WORD_SCALE n# = bOOL_INDEX (n# +# last#)
-  where I# last# = SIZEOF_VOID_P * 8 - 1
-wORD_SCALE   n# = scale# *# n# where I# scale# = SIZEOF_VOID_P
-dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_DOUBLE
-fLOAT_SCALE  n# = scale# *# n# where I# scale# = SIZEOF_FLOAT
+  where I# last# = SIZEOF_HSWORD * 8 - 1
+wORD_SCALE   n# = scale# *# n# where I# scale# = SIZEOF_HSWORD
+dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE
+fLOAT_SCALE  n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT
 
 bOOL_INDEX :: Int# -> Int#
-#if SIZEOF_VOID_P == 4
-bOOL_INDEX i# = i# `iShiftRA#` 5#
-#else
-bOOL_INDEX i# = i# `iShiftRA#` 6#
+#if SIZEOF_HSWORD == 4
+bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5#
+#elif SIZEOF_HSWORD == 8
+bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6#
 #endif
 
 bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word#
-bOOL_BIT     n# = int2Word# 1# `shiftL#` (word2Int# (int2Word# n# `and#` mask#))
-  where W# mask# = SIZEOF_VOID_P * 8 - 1
+bOOL_BIT     n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#))
+  where W# mask# = SIZEOF_HSWORD * 8 - 1
 bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# where W# mb# = maxBound
 
 -----------------------------------------------------------------------------
@@ -1152,7 +1157,7 @@ thawSTUArray (UArray l u arr#) = ST $ \s1# ->
     case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
     (# s3#, STUArray l u marr# #) }}}
 
-foreign import "memcpy" unsafe
+foreign import ccall unsafe "memcpy"
     memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
 
 {-# RULES