[project @ 2002-04-24 16:31:37 by simonmar]

[ghc-base.git] / Data / Array / Base.hs

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index 7821876..7ec369c 100644 (file)
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -monly-3-regs #-}
 -----------------------------------------------------------------------------
--- 
+-- |
 -- Module      :  Data.Array.Base
 -- Copyright   :  (c) The University of Glasgow 2001
 -- License     :  BSD-style (see the file libraries/core/LICENSE)
@@ -9,7 +9,7 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- $Id: Base.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
+-- $Id: Base.hs,v 1.7 2002/04/24 16:31:43 simonmar Exp $
 --
 -- Basis for IArray and MArray.  Not intended for external consumption;
 -- use IArray or MArray instead.
@@ -38,6 +38,8 @@ import GHC.Word               ( Word8(..), Word16(..), Word32(..), Word64(..) )
 import Data.Dynamic
 #include "Dynamic.h"
 
+#include "MachDeps.h"
+
 -----------------------------------------------------------------------------
 -- Class of immutable arrays
 
@@ -317,9 +319,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 +644,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
@@ -801,6 +810,19 @@ instance HasBounds (STUArray s) where
     bounds (STUArray l u _) = (l,u)
 
 instance MArray (STUArray s) Bool (ST s) where
+    {-# INLINE newArray #-}
+    newArray (l,u) init = ST $ \s1# ->
+        case rangeSize (l,u)            of { I# n# ->
+        case newByteArray# (bOOL_SCALE n#) s1# of { (# s2#, marr# #) ->
+        case bOOL_WORD_SCALE n#         of { n'# ->
+        let loop i# s3# | i# ==# n'# = s3#
+                        | otherwise  =
+                case writeWordArray# marr# i# e# s3# of { s4# ->
+                loop (i# +# 1#) s4# } in
+        case loop 0# s2#                of { s3# ->
+        (# s3#, STUArray l u marr# #) }}}}
+      where
+        W# e# = if init then maxBound else 0
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -991,7 +1013,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 #-}
@@ -1062,24 +1084,26 @@ instance MArray (STUArray s) Word64 (ST s) where
 -----------------------------------------------------------------------------
 -- Translation between elements and bytes
 
-#include "config.h"
-
-bOOL_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
-bOOL_SCALE   n# = bOOL_INDEX (n# +# last#) where I# last# = SIZEOF_VOID_P - 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
+bOOL_SCALE, bOOL_WORD_SCALE,
+  wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#
+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_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
 
 -----------------------------------------------------------------------------
@@ -1135,7 +1159,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