X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FArray%2FBase.hs;h=d007bf4a0e8cdb37730a9b3d52c75043b78c50e8;hb=a03b10415390db95c2e52523de86dd592ba19471;hp=756a703f69622d00ec781540fb9866e6672f79ae;hpb=1b7fd5be013652b70395f145e6fb5e257eae4f48;p=haskell-directory.git

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index 756a703..d007bf4 100644
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-bang-patterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Array.Base
@@ -6,7 +8,7 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable
+-- Portability :  non-portable (MPTCs, uses Control.Monad.ST)
 --
 -- Basis for IArray and MArray.  Not intended for external consumption;
 -- use IArray or MArray instead.
@@ -23,6 +25,7 @@ import qualified Control.Monad.ST.Lazy as Lazy (ST)
 import Data.Ix		( Ix, range, index, rangeSize )
 import Data.Int
 import Data.Word
+import Foreign.C.Types
 import Foreign.Ptr
 import Foreign.StablePtr
 
@@ -38,6 +41,7 @@ import GHC.Float	( Float(..), Double(..) )
 import GHC.Stable	( StablePtr(..) )
 import GHC.Int		( Int8(..),  Int16(..),  Int32(..),  Int64(..) )
 import GHC.Word		( Word8(..), Word16(..), Word32(..), Word64(..) )
+import GHC.IOBase       ( IO(..) )
 #endif
 
 #ifdef __HUGS__
@@ -58,12 +62,6 @@ import Data.Typeable
 -----------------------------------------------------------------------------
 -- Class of immutable arrays
 
--- | Class of array types with immutable bounds
--- (even if the array elements are mutable).
-class HasBounds a where
-    -- | Extracts the bounds of an array
-    bounds :: Ix i => a i e -> (i,i)
-
 {- | Class of immutable array types.
 
 An array type has the form @(a i e)@ where @a@ is the array type
@@ -72,7 +70,9 @@ the class 'Ix'), and @e@ is the element type.  The @IArray@ class is
 parameterised over both @a@ and @e@, so that instances specialised to
 certain element types can be defined.
 -}
-class HasBounds a => IArray a e where
+class IArray a e where
+    -- | Extracts the bounds of an immutable array
+    bounds           :: Ix i => a i e -> (i,i)
     unsafeArray      :: Ix i => (i,i) -> [(Int, e)] -> a i e
     unsafeAt         :: Ix i => a i e -> Int -> e
     unsafeReplace    :: Ix i => a i e -> [(Int, e)] -> a i e
@@ -202,48 +202,61 @@ listUArrayST (l,u) es = do
 -- the type looks like constrained over 's', which runST doesn't
 -- like. In fact all MArray (STUArray s) instances are polymorphic
 -- wrt. 's', but runST can't know that.
-
--- I would like to write a rule for listUArrayST (or listArray or
+--
+-- More precisely, we'd like to write this:
+--   listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i)
+--	        => (i,i) -> [e] -> UArray i e
+--   listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
+--   {-# RULES listArray = listUArray
+-- Then we could call listUArray at any type 'e' that had a suitable
+-- MArray instance.  But sadly we can't, because we don't have quantified 
+-- constraints.  Hence the mass of rules below.
+
+-- I would like also to write a rule for listUArrayST (or listArray or
 -- whatever) applied to unpackCString#. Unfortunately unpackCString#
 -- calls seem to be floated out, then floated back into the middle
 -- of listUArrayST, so I was not able to do this.
 
+#ifdef __GLASGOW_HASKELL__
+type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e
+
 {-# RULES
-"listArray/UArray/Bool"      listArray = \lu (es :: [Bool])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Char"      listArray = \lu (es :: [Char])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int"       listArray = \lu (es :: [Int])         ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word"      listArray = \lu (es :: [Word])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Ptr"       listArray = \lu (es :: [Ptr a])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/FunPtr"    listArray = \lu (es :: [FunPtr a])    ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Float"     listArray = \lu (es :: [Float])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Double"    listArray = \lu (es :: [Double])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/StablePtr" listArray = \lu (es :: [StablePtr a]) ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int8"      listArray = \lu (es :: [Int8])        ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int16"     listArray = \lu (es :: [Int16])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int32"     listArray = \lu (es :: [Int32])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Int64"     listArray = \lu (es :: [Int64])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word8"     listArray = \lu (es :: [Word8])       ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word16"    listArray = \lu (es :: [Word16])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word32"    listArray = \lu (es :: [Word32])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
-"listArray/UArray/Word64"    listArray = \lu (es :: [Word64])      ->
-    runST (listUArrayST lu es >>= unsafeFreezeSTUArray)
+"listArray/UArray/Bool"      listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool
+"listArray/UArray/Char"      listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char
+"listArray/UArray/Int"       listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int
+"listArray/UArray/Word"      listArray	
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word
+"listArray/UArray/Ptr"       listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a)
+"listArray/UArray/FunPtr"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a)
+"listArray/UArray/Float"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float
+"listArray/UArray/Double"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double
+"listArray/UArray/StablePtr" listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a)
+"listArray/UArray/Int8"      listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8
+"listArray/UArray/Int16"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16
+"listArray/UArray/Int32"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32
+"listArray/UArray/Int64"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64
+"listArray/UArray/Word8"     listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8
+"listArray/UArray/Word16"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16
+"listArray/UArray/Word32"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32
+"listArray/UArray/Word64"    listArray
+   = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64
     #-}
+#endif
 
 {-# INLINE (!) #-}
 -- | Returns the element of an immutable array at the specified index.
@@ -252,7 +265,7 @@ arr ! i = case bounds arr of (l,u) -> unsafeAt arr (index (l,u) i)
 
 {-# INLINE indices #-}
 -- | Returns a list of all the valid indices in an array.
-indices :: (HasBounds a, Ix i) => a i e -> [i]
+indices :: (IArray a e, Ix i) => a i e -> [i]
 indices arr = case bounds arr of (l,u) -> range (l,u)
 
 {-# INLINE elems #-}
@@ -343,11 +356,9 @@ ixmap (l,u) f arr =
 -----------------------------------------------------------------------------
 -- Normal polymorphic arrays
 
-instance HasBounds Arr.Array where
+instance IArray Arr.Array e where
     {-# INLINE bounds #-}
     bounds = Arr.bounds
-
-instance IArray Arr.Array e where
     {-# INLINE unsafeArray #-}
     unsafeArray      = Arr.unsafeArray
     {-# INLINE unsafeAt #-}
@@ -387,10 +398,6 @@ data UArray i e = UArray !i !i !ByteArray
 
 INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
 
-instance HasBounds UArray where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _) = (l,u)
-
 {-# INLINE unsafeArrayUArray #-}
 unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
                   => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)
@@ -495,6 +502,8 @@ unsafeAtBArray (UArray _ _ arr) = readByteArray arr
 #endif
 
 instance IArray UArray Bool where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
 #ifdef __GLASGOW_HASKELL__
@@ -515,6 +524,8 @@ instance IArray UArray Bool where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Char where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
     {-# INLINE unsafeAt #-}
@@ -532,6 +543,8 @@ instance IArray UArray Char where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -549,6 +562,8 @@ instance IArray UArray Int where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -566,6 +581,8 @@ instance IArray UArray Word where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray (Ptr a) where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
     {-# INLINE unsafeAt #-}
@@ -583,6 +600,8 @@ instance IArray UArray (Ptr a) where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray (FunPtr a) where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
 #ifdef __GLASGOW_HASKELL__
@@ -600,6 +619,8 @@ instance IArray UArray (FunPtr a) where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Float where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -617,6 +638,8 @@ instance IArray UArray Float where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Double where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -634,6 +657,8 @@ instance IArray UArray Double where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray (StablePtr a) where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
 #ifdef __GLASGOW_HASKELL__
@@ -659,6 +684,8 @@ nullStablePtr = castPtrToStablePtr nullPtr
 #endif
 
 instance IArray UArray Int8 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -676,6 +703,8 @@ instance IArray UArray Int8 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int16 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -693,6 +722,8 @@ instance IArray UArray Int16 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int32 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -710,6 +741,8 @@ instance IArray UArray Int32 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int64 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -727,6 +760,8 @@ instance IArray UArray Int64 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word8 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -744,6 +779,8 @@ instance IArray UArray Word8 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word16 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -761,6 +798,8 @@ instance IArray UArray Word16 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word32 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -778,6 +817,8 @@ instance IArray UArray Word32 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word64 where
+    {-# INLINE bounds #-}
+    bounds (UArray l u _) = (l,u)
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__
@@ -794,147 +835,13 @@ instance IArray UArray Word64 where
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
-instance Ix ix => Eq (UArray ix Bool) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Char) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix (Ptr a)) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix (FunPtr a)) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Float) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Double) where
-    (==) = eqUArray
-
-#ifdef __GLASGOW_HASKELL__
-instance Ix ix => Eq (UArray ix (StablePtr a)) where
-    (==) = eqUArray
-#endif
-
-instance Ix ix => Eq (UArray ix Int8) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int16) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int32) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Int64) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word8) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word16) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word32) where
-    (==) = eqUArray
-
-instance Ix ix => Eq (UArray ix Word64) where
+instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where
     (==) = eqUArray
 
-instance Ix ix => Ord (UArray ix Bool) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Char) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix (Ptr a)) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix (FunPtr a)) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Float) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Double) where
+instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where
     compare = cmpUArray
 
-instance Ix ix => Ord (UArray ix Int8) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int16) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int32) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Int64) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word8) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word16) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word32) where
-    compare = cmpUArray
-
-instance Ix ix => Ord (UArray ix Word64) where
-    compare = cmpUArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Bool) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Char) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Float) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Double) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int8) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int16) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int32) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Int64) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word8) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word16) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word32) where
-    showsPrec = showsIArray
-
-instance (Ix ix, Show ix) => Show (UArray ix Word64) where
+instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where
     showsPrec = showsIArray
 
 -----------------------------------------------------------------------------
@@ -955,7 +862,10 @@ instances specialised to certain element types can be defined, in the
 same way as for 'IArray'), and also over the type of the monad, @m@,
 in which the mutable array will be manipulated.
 -}
-class (HasBounds a, Monad m) => MArray a e m where
+class (Monad m) => MArray a e m where
+
+    -- | Returns the bounds of the array
+    getBounds   :: Ix i => a i e -> m (i,i)
 
     -- | Builds a new array, with every element initialised to the supplied 
     -- value.
@@ -1010,41 +920,45 @@ newListArray (l,u) es = do
 {-# INLINE readArray #-}
 -- | Read an element from a mutable array
 readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
-readArray marr i = case bounds marr of
-    (l,u) -> unsafeRead marr (index (l,u) i)
+readArray marr i = do
+  (l,u) <- getBounds marr
+  unsafeRead marr (index (l,u) i)
 
 {-# INLINE writeArray #-}
 -- | Write an element in a mutable array
 writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
-writeArray marr i e = case bounds marr of
-    (l,u) -> unsafeWrite marr (index (l,u) i) e
+writeArray marr i e = do
+  (l,u) <- getBounds marr
+  unsafeWrite marr (index (l,u) i) e
 
 {-# INLINE getElems #-}
 -- | Return a list of all the elements of a mutable array
 getElems :: (MArray a e m, Ix i) => a i e -> m [e]
-getElems marr = case bounds marr of
-    (l,u) -> sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
+getElems marr = do 
+  (l,u) <- getBounds marr
+  sequence [unsafeRead marr i | i <- [0 .. rangeSize (l,u) - 1]]
 
 {-# INLINE getAssocs #-}
 -- | Return a list of all the associations of a mutable array, in
 -- index order.
 getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
-getAssocs marr = case bounds marr of
-    (l,u) -> sequence [do e <- unsafeRead marr (index (l,u) i); return (i,e)
-              | i <- range (l,u)]
+getAssocs marr = do 
+  (l,u) <- getBounds marr
+  sequence [ do e <- unsafeRead marr (index (l,u) i); return (i,e)
+           | i <- range (l,u)]
 
 {-# INLINE mapArray #-}
 -- | Constructs a new array derived from the original array by applying a
 -- function to each of the elements.
 mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e)
-mapArray f marr = case bounds marr of
-  (l,u) -> do
-    marr' <- newArray_ (l,u)
-    sequence_ [do
+mapArray f marr = do 
+  (l,u) <- getBounds marr
+  marr' <- newArray_ (l,u)
+  sequence_ [do
         e <- unsafeRead marr i
         unsafeWrite marr' i (f e)
         | i <- [0 .. rangeSize (l,u) - 1]]
-    return marr'
+  return marr'
 
 {-# INLINE mapIndices #-}
 -- | Constructs a new array derived from the original array by applying a
@@ -1061,11 +975,9 @@ mapIndices (l,u) f marr = do
 -----------------------------------------------------------------------------
 -- Polymorphic non-strict mutable arrays (ST monad)
 
-instance HasBounds (STArray s) where
-    {-# INLINE bounds #-}
-    bounds = ArrST.boundsSTArray
-
 instance MArray (STArray s) e (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds arr = return $! ArrST.boundsSTArray arr
     {-# INLINE newArray #-}
     newArray    = ArrST.newSTArray
     {-# INLINE unsafeRead #-}
@@ -1074,6 +986,8 @@ instance MArray (STArray s) e (ST s) where
     unsafeWrite = ArrST.unsafeWriteSTArray
 
 instance MArray (STArray s) e (Lazy.ST s) where
+    {-# INLINE getBounds #-}
+    getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr)
     {-# INLINE newArray #-}
     newArray (l,u) e    = strictToLazyST (ArrST.newSTArray (l,u) e)
     {-# INLINE unsafeRead #-}
@@ -1112,12 +1026,10 @@ data STUArray s i a = STUArray !i !i !(MutableByteArray s)
 
 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
 
-instance HasBounds (STUArray s) where
-    {-# INLINE bounds #-}
-    bounds (STUArray l u _) = (l,u)
-
 #ifdef __GLASGOW_HASKELL__
 instance MArray (STUArray s) Bool (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray #-}
     newArray (l,u) init = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1150,6 +1062,8 @@ instance MArray (STUArray s) Bool (ST s) where
         (# s3#, () #) }}}}
 
 instance MArray (STUArray s) Char (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1165,6 +1079,8 @@ instance MArray (STUArray s) Char (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1180,6 +1096,8 @@ instance MArray (STUArray s) Int (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1195,6 +1113,8 @@ instance MArray (STUArray s) Word (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) (Ptr a) (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1210,6 +1130,8 @@ instance MArray (STUArray s) (Ptr a) (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) (FunPtr a) (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1225,6 +1147,8 @@ instance MArray (STUArray s) (FunPtr a) (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Float (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1240,6 +1164,8 @@ instance MArray (STUArray s) Float (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Double (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1255,6 +1181,8 @@ instance MArray (STUArray s) Double (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) (StablePtr a) (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1270,6 +1198,8 @@ instance MArray (STUArray s) (StablePtr a) (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int8 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1285,6 +1215,8 @@ instance MArray (STUArray s) Int8 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int16 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1300,6 +1232,8 @@ instance MArray (STUArray s) Int16 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int32 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1315,6 +1249,8 @@ instance MArray (STUArray s) Int32 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int64 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1330,6 +1266,8 @@ instance MArray (STUArray s) Int64 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word8 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1345,6 +1283,8 @@ instance MArray (STUArray s) Word8 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word16 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1360,6 +1300,8 @@ instance MArray (STUArray s) Word16 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word32 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1375,6 +1317,8 @@ instance MArray (STUArray s) Word32 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word64 (ST s) where
+    {-# INLINE getBounds #-}
+    getBounds (STUArray l u _) = return (l,u)
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->
@@ -1430,7 +1374,10 @@ unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
 unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
 unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray marr
 
+getBoundsMBArray (STUArray l u _) = return (l,u)
+
 instance MArray (STUArray s) Bool (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ (l,u) = do
         marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
         return (STUArray l u marr)
@@ -1447,81 +1394,97 @@ instance MArray (STUArray s) Bool (ST s) where
 	    (if e then setBit (w::BitSet) bit else clearBit w bit)
 
 instance MArray (STUArray s) Char (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Int (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Word (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) (Ptr a) (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) (FunPtr a) (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Float (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Double (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) (StablePtr a) (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Int8 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Int16 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Int32 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Int64 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Word8 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Word16 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Word32 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Word64 (ST s) where
+    getBounds = getBoundsMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
@@ -1547,20 +1510,25 @@ bOOL_SUBINDEX i = i `mod` bitSetSize
 -- immutable array (any instance of 'IArray') by taking a complete
 -- copy of it.
 freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
-freeze marr = case bounds marr of
-  (l,u) -> do
-    ies <- sequence [do e <- unsafeRead marr i; return (i,e)
-                     | i <- [0 .. rangeSize (l,u) - 1]]
-    return (unsafeArray (l,u) ies)
+freeze marr = do
+  (l,u) <- getBounds marr
+  ies <- sequence [do e <- unsafeRead marr i; return (i,e)
+                   | i <- [0 .. rangeSize (l,u) - 1]]
+  return (unsafeArray (l,u) ies)
 
 #ifdef __GLASGOW_HASKELL__
 freezeSTUArray :: Ix i => STUArray s i e -> ST s (UArray i e)
 freezeSTUArray (STUArray l u marr#) = ST $ \s1# ->
     case sizeofMutableByteArray# marr#  of { n# ->
     case newByteArray# n# s1#           of { (# s2#, marr'# #) ->
-    case unsafeCoerce# memcpy marr'# marr# n# s2# of { (# s3#, () #) ->
+    case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m ->
+    case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
     case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) ->
-    (# s4#, UArray l u arr# #) }}}}
+    (# s4#, UArray l u arr# #) }}}}}
+
+foreign import ccall unsafe "memcpy"
+    memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize
+           -> IO (Ptr a)
 
 {-# RULES
 "freeze/STArray"  freeze = ArrST.freezeSTArray
@@ -1628,11 +1596,13 @@ thawSTUArray :: Ix i => UArray i e -> ST s (STUArray s i e)
 thawSTUArray (UArray l u arr#) = ST $ \s1# ->
     case sizeofByteArray# arr#          of { n# ->
     case newByteArray# n# s1#           of { (# s2#, marr# #) ->
-    case unsafeCoerce# memcpy marr# arr# n# s2# of { (# s3#, () #) ->
-    (# s3#, STUArray l u marr# #) }}}
+    case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m ->
+    case unsafeCoerce# m s2#            of { (# s3#, _ #) ->
+    (# s3#, STUArray l u marr# #) }}}}
 
 foreign import ccall unsafe "memcpy"
-    memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
+    memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize
+           -> IO (Ptr a)
 
 {-# RULES
 "thaw/STArray"  thaw = ArrST.thawSTArray
@@ -1660,14 +1630,20 @@ thawSTUArray (UArray l u arr) = do
 
    Note that because the array is possibly not copied, any subsequent
    modifications made to the mutable version of the array may be
-   shared with the immutable version.  It is safe to use, therefore, if
-   the immutable version is never referenced again.
+   shared with the immutable version.  It is only safe to use,
+   therefore, if the immutable array is never referenced again in this
+   thread, and there is no possibility that it can be also referenced
+   in another thread.  If you use an unsafeThaw/write/unsafeFreeze
+   sequence in a multi-threaded setting, then you must ensure that
+   this sequence is atomic with respect to other threads, or a garbage
+   collector crash may result (because the write may be writing to a
+   frozen array).
 
    The non-copying implementation is supported between certain pairs
    of array types only; one constraint is that the array types must
    have identical representations.  In GHC, The following pairs of
    array types have a non-copying O(1) implementation of
-   'unsafeFreeze'.  Because the optimised versions are enabled by
+   'unsafeThaw'.  Because the optimised versions are enabled by
    specialisations, you will need to compile with optimisation (-O) to
    get them.