Remove Control.Parallel*, now in package parallel
[haskell-directory.git] / Data / Array / Base.hs
index 5fe52d0..d007bf4 100644 (file)
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-bang-patterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Array.Base
@@ -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
@@ -265,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 #-}
@@ -356,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 #-}
@@ -400,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)
@@ -508,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__
@@ -528,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 #-}
@@ -545,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__
@@ -562,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__
@@ -579,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 #-}
@@ -596,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__
@@ -613,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__
@@ -630,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__
@@ -647,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__
@@ -672,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__
@@ -689,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__
@@ -706,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__
@@ -723,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__
@@ -740,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__
@@ -757,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__
@@ -774,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__
@@ -791,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__
@@ -807,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
+instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) 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
+instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) 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
-    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
 
 -----------------------------------------------------------------------------
@@ -968,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.
@@ -1023,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
@@ -1074,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 #-}
@@ -1087,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 #-}
@@ -1125,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# ->
@@ -1163,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# ->
@@ -1178,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# ->
@@ -1193,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# ->
@@ -1208,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# ->
@@ -1223,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# ->
@@ -1238,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# ->
@@ -1253,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# ->
@@ -1268,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# ->
@@ -1283,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# ->
@@ -1298,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# ->
@@ -1313,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# ->
@@ -1328,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# ->
@@ -1343,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# ->
@@ -1358,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# ->
@@ -1373,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# ->
@@ -1388,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# ->
@@ -1443,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)
@@ -1460,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
@@ -1560,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
@@ -1641,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
@@ -1673,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.