From 50b46f721cd1d8966f9dd7cf20c44427b4ebc44f Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 9 Aug 2006 10:05:48 +0000 Subject: [PATCH] Change the API of MArray to allow resizable arrays 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 | 166 ++++++++++++++++++++++++++++++++------------ Data/Array/Diff.hs | 40 +++++++---- Data/Array/IArray.hs | 1 - Data/Array/IO/Internals.hs | 55 +++++++++++---- Data/Array/MArray.hs | 6 +- Data/Array/Storable.hs | 4 +- 6 files changed, 192 insertions(+), 80 deletions(-) diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index ad9db1e..08a748a 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -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) diff --git a/Data/Array/Diff.hs b/Data/Array/Diff.hs index 94018e4..3e86f89 100644 --- a/Data/Array/Diff.hs +++ b/Data/Array/Diff.hs @@ -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'' diff --git a/Data/Array/IArray.hs b/Data/Array/IArray.hs index fca1fee..2a88764 100644 --- a/Data/Array/IArray.hs +++ b/Data/Array/IArray.hs @@ -16,7 +16,6 @@ module Data.Array.IArray ( -- * Array classes - HasBounds, -- :: (* -> * -> *) -> class IArray, -- :: (* -> * -> *) -> * -> class module Data.Ix, diff --git a/Data/Array/IO/Internals.hs b/Data/Array/IO/Internals.hs index 8789a94..433c6c2 100644 --- a/Data/Array/IO/Internals.hs +++ b/Data/Array/IO/Internals.hs @@ -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) diff --git a/Data/Array/MArray.hs b/Data/Array/MArray.hs index 9119b09..95fae97 100644 --- a/Data/Array/MArray.hs +++ b/Data/Array/MArray.hs @@ -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)] diff --git a/Data/Array/Storable.hs b/Data/Array/Storable.hs index d10a793..a4aa7dd 100644 --- a/Data/Array/Storable.hs +++ b/Data/Array/Storable.hs @@ -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 -- 1.7.10.4