Change the API of MArray to allow resizable arrays
authorSimon Marlow <simonmar@microsoft.com>
Wed, 9 Aug 2006 10:05:48 +0000 (10:05 +0000)
committerSimon Marlow <simonmar@microsoft.com>
Wed, 9 Aug 2006 10:05:48 +0000 (10:05 +0000)
See #704

The MArray class doesn't currently allow a mutable array to change its
size, because of the pure function

  bounds :: (HasBounds a, Ix i) => a i e -> (i,i)

This patch removes the HasBounds class, and adds

  getBounds :: (MArray a e m, Ix i) => a i e -> m (i,i)

to the MArray class, and

  bounds :: (IArray a e, Ix i) => a i e -> (i,i)

to the IArray class.

The reason that bounds had to be incorporated into the IArray class is
because I couldn't make DiffArray work without doing this.  DiffArray
acts as a layer converting an MArray into an IArray, and there was no
way (that I could find) to define an instance of HasBounds for
DiffArray.

Data/Array/Base.hs
Data/Array/Diff.hs
Data/Array/IArray.hs
Data/Array/IO/Internals.hs
Data/Array/MArray.hs
Data/Array/Storable.hs

index ad9db1e..08a748a 100644 (file)
@@ -60,12 +60,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
@@ -74,7 +68,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
@@ -267,7 +263,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 #-}
@@ -358,11 +354,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 #-}
@@ -402,10 +396,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)
@@ -510,6 +500,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__
@@ -530,6 +522,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 #-}
@@ -547,6 +541,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__
@@ -564,6 +560,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__
@@ -581,6 +579,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 #-}
@@ -598,6 +598,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__
@@ -615,6 +617,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__
@@ -632,6 +636,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__
@@ -649,6 +655,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__
@@ -674,6 +682,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__
@@ -691,6 +701,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__
@@ -708,6 +720,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__
@@ -725,6 +739,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__
@@ -742,6 +758,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__
@@ -759,6 +777,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__
@@ -776,6 +796,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__
@@ -793,6 +815,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__
@@ -836,7 +860,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.
@@ -891,41 +918,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
@@ -942,11 +973,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 #-}
@@ -955,6 +984,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 #-}
@@ -993,12 +1024,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# ->
@@ -1031,6 +1060,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# ->
@@ -1046,6 +1077,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# ->
@@ -1061,6 +1094,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# ->
@@ -1076,6 +1111,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# ->
@@ -1091,6 +1128,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# ->
@@ -1106,6 +1145,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# ->
@@ -1121,6 +1162,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# ->
@@ -1136,6 +1179,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# ->
@@ -1151,6 +1196,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# ->
@@ -1166,6 +1213,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# ->
@@ -1181,6 +1230,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# ->
@@ -1196,6 +1247,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# ->
@@ -1211,6 +1264,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# ->
@@ -1226,6 +1281,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# ->
@@ -1241,6 +1298,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# ->
@@ -1256,6 +1315,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# ->
@@ -1311,7 +1372,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)
@@ -1328,81 +1392,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
@@ -1428,11 +1508,11 @@ 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)
index 94018e4..3e86f89 100644 (file)
@@ -161,90 +161,104 @@ instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where
 ------------------------------------------------------------------------
 -- Boring instances.
 
-instance HasBounds a => HasBounds (IOToDiffArray a) where
-    bounds a = unsafePerformIO $ boundsDiffArray a
-
 instance IArray (IOToDiffArray IOArray) e where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray1` ies
 
 instance IArray (IOToDiffArray IOUArray) Char where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Int where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Word where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) (Ptr a) where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Float where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Double where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Int8 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Int16 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Int32 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Int64 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Word8 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Word16 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Word32 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
 
 instance IArray (IOToDiffArray IOUArray) Word64 where
+    bounds        a      = unsafePerformIO $ boundsDiffArray a
     unsafeArray   lu ies = unsafePerformIO $ newDiffArray lu ies
     unsafeAt      a i    = unsafePerformIO $ a `readDiffArray` i
     unsafeReplace a ies  = unsafePerformIO $ a `replaceDiffArray2` ies
@@ -330,24 +344,24 @@ a `replaceDiffArray2` ies = do
     a `replaceDiffArray` ies
 
 
-boundsDiffArray :: (HasBounds a, Ix ix)
+boundsDiffArray :: (MArray a e IO, Ix ix)
                 => IOToDiffArray a ix e
                 -> IO (ix,ix)
 boundsDiffArray a = do
     d <- readMVar (varDiffArray a)
     case d of
-        Current a' -> return (bounds a')
+        Current a' -> getBounds a'
         Diff a' _  -> boundsDiffArray a'
 
 freezeDiffArray :: (MArray a e IO, Ix ix)
                 => a ix e
                 -> IO (IOToDiffArray a ix e)
-freezeDiffArray a = case bounds a of
-  (l,u) -> do
-    a' <- newArray_ (l,u)
-    sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
-    var <- newMVar (Current a')
-    return (DiffArray var)
+freezeDiffArray a = do
+  (l,u) <- getBounds a
+  a' <- newArray_ (l,u)
+  sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
+  var <- newMVar (Current a')
+  return (DiffArray var)
 
 {-# RULES
 "freeze/DiffArray" freeze = freezeDiffArray
@@ -374,8 +388,8 @@ thawDiffArray :: (MArray a e IO, Ix ix)
 thawDiffArray a = do
     d <- readMVar (varDiffArray a)
     case d of
-        Current a' -> case bounds a' of
-         (l,u) -> do
+        Current a' -> do
+           (l,u) <- getBounds a'
             a'' <- newArray_ (l,u)
             sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]
             return a''
index fca1fee..2a88764 100644 (file)
@@ -16,7 +16,6 @@
 
 module Data.Array.IArray ( 
     -- * Array classes
-    HasBounds,  -- :: (* -> * -> *) -> class
     IArray,     -- :: (* -> * -> *) -> * -> class
 
     module Data.Ix,
index 8789a94..433c6c2 100644 (file)
@@ -48,18 +48,13 @@ INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")
 -----------------------------------------------------------------------------
 -- | Instance declarations for 'IOArray's
 
-#ifdef __GLASGOW_HASKELL__
-instance HasBounds IOArray where
-    {-# INLINE bounds #-}
-    bounds (IOArray marr) = bounds marr
-#endif
-
-#ifdef __HUGS__
-instance HasBounds IOArray where
-    bounds      = boundsIOArray
-#endif
-
 instance MArray IOArray e IO where
+#if defined(__HUGS__)
+    getBound    = return . boundsIOArray
+#elif defined(__GLASGOW_HASKELL__)
+    {-# INLINE getBounds #-}
+    getBounds (IOArray marr) = stToIO $ getBounds marr
+#endif
     newArray    = newIOArray
     unsafeRead  = unsafeReadIOArray
     unsafeWrite = unsafeWriteIOArray
@@ -79,11 +74,9 @@ newtype IOUArray i e = IOUArray (STUArray RealWorld i e)
 
 INSTANCE_TYPEABLE2(IOUArray,iOUArrayTc,"IOUArray")
 
-instance HasBounds IOUArray where
-    {-# INLINE bounds #-}
-    bounds (IOUArray marr) = bounds marr
-
 instance MArray IOUArray Bool IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -96,6 +89,8 @@ instance MArray IOUArray Bool IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Char IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -108,6 +103,8 @@ instance MArray IOUArray Char IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -120,6 +117,8 @@ instance MArray IOUArray Int IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -132,6 +131,8 @@ instance MArray IOUArray Word IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray (Ptr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -144,6 +145,8 @@ instance MArray IOUArray (Ptr a) IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray (FunPtr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -156,6 +159,8 @@ instance MArray IOUArray (FunPtr a) IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Float IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -168,6 +173,8 @@ instance MArray IOUArray Float IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Double IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -180,6 +187,8 @@ instance MArray IOUArray Double IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray (StablePtr a) IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -192,6 +201,8 @@ instance MArray IOUArray (StablePtr a) IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int8 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -204,6 +215,8 @@ instance MArray IOUArray Int8 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int16 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -216,6 +229,8 @@ instance MArray IOUArray Int16 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int32 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -228,6 +243,8 @@ instance MArray IOUArray Int32 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Int64 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -240,6 +257,8 @@ instance MArray IOUArray Int64 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word8 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -252,6 +271,8 @@ instance MArray IOUArray Word8 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word16 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -264,6 +285,8 @@ instance MArray IOUArray Word16 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word32 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
@@ -276,6 +299,8 @@ instance MArray IOUArray Word32 IO where
     unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
 
 instance MArray IOUArray Word64 IO where
+    {-# INLINE getBounds #-}
+    getBounds (IOUArray arr) = stToIO $ getBounds arr
     {-# INLINE newArray #-}
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOUArray marr)
index 9119b09..95fae97 100644 (file)
@@ -18,9 +18,6 @@ module Data.Array.MArray (
     -- * Class of mutable array types
     MArray,       -- :: (* -> * -> *) -> * -> (* -> *) -> class
 
-    -- * Class of array types with bounds
-    HasBounds,    -- :: (* -> * -> *) -> class
-
     -- * The @Ix@ class and operations
     module Data.Ix,
 
@@ -38,8 +35,7 @@ module Data.Array.MArray (
     mapIndices,   -- :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e)
 
     -- * Deconstructing mutable arrays
-    bounds,       -- :: (HasBounds a, Ix i) => a i e -> (i,i)
-    indices,      -- :: (HasBounds a, Ix i) => a i e -> [i]
+    getBounds,    -- :: (MArray a e m, Ix i) => a i e -> m (i,i)
     getElems,     -- :: (MArray a e m, Ix i) => a i e -> m [e]
     getAssocs,    -- :: (MArray a e m, Ix i) => a i e -> m [(i, e)]
 
index d10a793..a4aa7dd 100644 (file)
@@ -49,10 +49,8 @@ import Foreign hiding (newArray)
 -- |The array type
 data StorableArray i e = StorableArray !i !i !(ForeignPtr e)
 
-instance HasBounds StorableArray where
-    bounds (StorableArray l u _) = (l,u)
-
 instance Storable e => MArray StorableArray e IO where
+    getBounds (StorableArray l u _) = return (l,u)
 
     newArray (l,u) init = do
         fp <- mallocForeignPtrArray size