MERGE: fix ugly uses of memcpy foreign import inside ST

[haskell-directory.git] / Data / Array / Base.hs

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index 12dbb8e..d007bf4 100644 (file)
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-bang-patterns #-}
+

 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Array.Base
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Array.Base

@@ -6,7 +8,7 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
 -- 
 -- 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.
 --
 -- Basis for IArray and MArray.  Not intended for external consumption;
 -- use IArray or MArray instead.

@@ -18,9 +20,12 @@ module Data.Array.Base where
 
 import Prelude
 
 
 import Prelude
 

+import Control.Monad.ST.Lazy ( strictToLazyST )
+import qualified Control.Monad.ST.Lazy as Lazy (ST)

 import Data.Ix         ( Ix, range, index, rangeSize )
 import Data.Int
 import Data.Word
 import Data.Ix         ( Ix, range, index, rangeSize )
 import Data.Int
 import Data.Word

+import Foreign.C.Types

 import Foreign.Ptr
 import Foreign.StablePtr
 
 import Foreign.Ptr
 import Foreign.StablePtr
 

@@ -36,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.Stable      ( StablePtr(..) )
 import GHC.Int         ( Int8(..),  Int16(..),  Int32(..),  Int64(..) )
 import GHC.Word                ( Word8(..), Word16(..), Word32(..), Word64(..) )

+import GHC.IOBase       ( IO(..) )

 #endif
 
 #ifdef __HUGS__
 #endif
 
 #ifdef __HUGS__

@@ -56,12 +62,6 @@ import Data.Typeable
 -----------------------------------------------------------------------------
 -- Class of immutable arrays
 
 -----------------------------------------------------------------------------
 -- 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
 {- | Class of immutable array types.
 
 An array type has the form @(a i e)@ where @a@ is the array type

@@ -70,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.
 -}
 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
     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

@@ -200,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.
 -- 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.
 
 -- 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
 {-# 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.
 
 {-# INLINE (!) #-}
 -- | Returns the element of an immutable array at the specified index.

@@ -250,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.
 
 {-# 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 #-}
 indices arr = case bounds arr of (l,u) -> range (l,u)
 
 {-# INLINE elems #-}

@@ -341,11 +356,9 @@ ixmap (l,u) f arr =
 -----------------------------------------------------------------------------
 -- Normal polymorphic arrays
 
 -----------------------------------------------------------------------------
 -- Normal polymorphic arrays
 

-instance HasBounds Arr.Array where
+instance IArray Arr.Array e where

     {-# INLINE bounds #-}
     bounds = Arr.bounds
     {-# INLINE bounds #-}
     bounds = Arr.bounds

-
-instance IArray Arr.Array e where

     {-# INLINE unsafeArray #-}
     unsafeArray      = Arr.unsafeArray
     {-# INLINE unsafeAt #-}
     {-# INLINE unsafeArray #-}
     unsafeArray      = Arr.unsafeArray
     {-# INLINE unsafeAt #-}

@@ -385,10 +398,6 @@ data UArray i e = UArray !i !i !ByteArray
 
 INSTANCE_TYPEABLE2(UArray,uArrayTc,"UArray")
 
 
 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)
 {-# INLINE unsafeArrayUArray #-}
 unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i)
                   => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e)

@@ -493,6 +502,8 @@ unsafeAtBArray (UArray _ _ arr) = readByteArray arr
 #endif
 
 instance IArray UArray Bool where
 #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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
 #ifdef __GLASGOW_HASKELL__

@@ -513,6 +524,8 @@ instance IArray UArray Bool where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Char 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 #-}
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0')
     {-# INLINE unsafeAt #-}

@@ -530,6 +543,8 @@ instance IArray UArray Char where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -547,6 +562,8 @@ instance IArray UArray Int where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -564,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
     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 #-}
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr)
     {-# INLINE unsafeAt #-}

@@ -581,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
     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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr)
 #ifdef __GLASGOW_HASKELL__

@@ -598,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
     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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -615,6 +638,8 @@ instance IArray UArray Float where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Double 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -632,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
     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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr)
 #ifdef __GLASGOW_HASKELL__

@@ -657,6 +684,8 @@ nullStablePtr = castPtrToStablePtr nullPtr
 #endif
 
 instance IArray UArray Int8 where
 #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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -674,6 +703,8 @@ instance IArray UArray Int8 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int16 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -691,6 +722,8 @@ instance IArray UArray Int16 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int32 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -708,6 +741,8 @@ instance IArray UArray Int32 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Int64 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -725,6 +760,8 @@ instance IArray UArray Int64 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word8 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -742,6 +779,8 @@ instance IArray UArray Word8 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word16 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -759,6 +798,8 @@ instance IArray UArray Word16 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word32 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -776,6 +817,8 @@ instance IArray UArray Word32 where
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
 instance IArray UArray Word64 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__
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
 #ifdef __GLASGOW_HASKELL__

@@ -792,147 +835,13 @@ instance IArray UArray Word64 where
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
     {-# 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
+instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where

     (==) = eqUArray
 
     (==) = 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
-    (==) = 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
-    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
+instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where

     compare = cmpUArray
 
     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
 
 -----------------------------------------------------------------------------
     showsPrec = showsIArray
 
 -----------------------------------------------------------------------------

@@ -953,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.
 -}
 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.
 
     -- | Builds a new array, with every element initialised to the supplied 
     -- value.

@@ -1008,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
 {-# 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 ()
 
 {-# 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]
 
 {-# 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)]
 
 {-# 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)
 
 {-# 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]]
         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
 
 {-# INLINE mapIndices #-}
 -- | Constructs a new array derived from the original array by applying a

@@ -1059,11 +975,9 @@ mapIndices (l,u) f marr = do
 -----------------------------------------------------------------------------
 -- Polymorphic non-strict mutable arrays (ST monad)
 
 -----------------------------------------------------------------------------
 -- 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
 instance MArray (STArray s) e (ST s) where

+    {-# INLINE getBounds #-}
+    getBounds arr = return $! ArrST.boundsSTArray arr

     {-# INLINE newArray #-}
     newArray    = ArrST.newSTArray
     {-# INLINE unsafeRead #-}
     {-# INLINE newArray #-}
     newArray    = ArrST.newSTArray
     {-# INLINE unsafeRead #-}

@@ -1071,6 +985,20 @@ instance MArray (STArray s) e (ST s) where
     {-# INLINE unsafeWrite #-}
     unsafeWrite = ArrST.unsafeWriteSTArray
 
     {-# INLINE unsafeWrite #-}
     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 #-}
+    unsafeRead arr i    = strictToLazyST (ArrST.unsafeReadSTArray arr i)
+    {-# INLINE unsafeWrite #-}
+    unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e)
+
+#ifdef __HUGS__
+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+#endif
+

 -----------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (ST monad)
 
 -----------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (ST monad)
 

@@ -1098,12 +1026,10 @@ data STUArray s i a = STUArray !i !i !(MutableByteArray s)
 
 INSTANCE_TYPEABLE3(STUArray,stUArrayTc,"STUArray")
 
 
 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
 #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# ->
     {-# INLINE newArray #-}
     newArray (l,u) init = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1136,6 +1062,8 @@ instance MArray (STUArray s) Bool (ST s) where
         (# s3#, () #) }}}}
 
 instance MArray (STUArray s) Char (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1151,6 +1079,8 @@ instance MArray (STUArray s) Char (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1166,6 +1096,8 @@ instance MArray (STUArray s) Int (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1181,6 +1113,8 @@ instance MArray (STUArray s) Word (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) (Ptr a) (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1196,6 +1130,8 @@ instance MArray (STUArray s) (Ptr a) (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) (FunPtr 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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1211,6 +1147,8 @@ instance MArray (STUArray s) (FunPtr a) (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Float (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1226,6 +1164,8 @@ instance MArray (STUArray s) Float (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Double (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1241,6 +1181,8 @@ instance MArray (STUArray s) Double (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) (StablePtr a) (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1256,6 +1198,8 @@ instance MArray (STUArray s) (StablePtr a) (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int8 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1271,6 +1215,8 @@ instance MArray (STUArray s) Int8 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int16 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1286,6 +1232,8 @@ instance MArray (STUArray s) Int16 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int32 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1301,6 +1249,8 @@ instance MArray (STUArray s) Int32 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Int64 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1316,6 +1266,8 @@ instance MArray (STUArray s) Int64 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word8 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1331,6 +1283,8 @@ instance MArray (STUArray s) Word8 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word16 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1346,6 +1300,8 @@ instance MArray (STUArray s) Word16 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word32 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1361,6 +1317,8 @@ instance MArray (STUArray s) Word32 (ST s) where
         (# s2#, () #) }
 
 instance MArray (STUArray s) Word64 (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# ->
     {-# INLINE newArray_ #-}
     newArray_ (l,u) = ST $ \s1# ->
         case rangeSize (l,u)            of { I# n# ->

@@ -1416,7 +1374,10 @@ unsafeReadMBArray (STUArray _ _ marr) = readMutableByteArray marr
 unsafeWriteMBArray :: Storable e => STUArray s i e -> Int -> e -> ST s ()
 unsafeWriteMBArray (STUArray _ _ marr) = writeMutableByteArray 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
 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)
     newArray_ (l,u) = do
         marr <- newMutableByteArray (bOOL_SCALE (rangeSize (l,u)))
         return (STUArray l u marr)

@@ -1433,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
            (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
     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
     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
     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
     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
     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
     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
     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
     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
     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
     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
     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
     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
     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
     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
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
 instance MArray (STUArray s) Word64 (ST s) where

+    getBounds = getBoundsMBArray

     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray

@@ -1533,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)
 -- 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'# #) ->
 
 #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# #) ->
     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
 
 {-# RULES
 "freeze/STArray"  freeze = ArrST.freezeSTArray

@@ -1614,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# #) ->
 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"
 
 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
 
 {-# RULES
 "thaw/STArray"  thaw = ArrST.thawSTArray

@@ -1646,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
 
    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
 
    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.
 
    specialisations, you will need to compile with optimisation (-O) to
    get them.