diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs index 52e4c18dad79a227dd593f9966ec888becba9165..3fbb05accc7a70328fd472e97fae025a12a13bd3 100644 --- a/Data/Array/Base.hs +++ b/Data/Array/Base.hs @@ -359,8 +359,8 @@ Other implementations will also do this for unboxed arrays, but Haskell 98 requires that for 'Array' the value at such indices is bottom.) For most array types, this operation is O(/n/) where /n/ is the size -of the array. However, the 'Data.Array.Diff.DiffArray' type provides -this operation with complexity linear in the number of updates. +of the array. However, the diffarray package provides an array type +for which this operation has complexity linear in the number of updates. -} (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e arr // ies = case bounds arr of diff --git a/Data/Array/Diff.hs b/Data/Array/Diff.hs deleted file mode 100644 index c08ef3cdf5c1bf45d2e506292395fc595c3dbc50..0000000000000000000000000000000000000000 --- a/Data/Array/Diff.hs +++ /dev/null @@ -1,456 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Array.Diff --- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable (uses Data.Array.IArray) --- --- Functional arrays with constant-time update. --- ------------------------------------------------------------------------------ - -module Data.Array.Diff ( - - -- * Diff array types - - -- | Diff arrays have an immutable interface, but rely on internal - -- updates in place to provide fast functional update operator - -- '//'. - -- - -- When the '//' operator is applied to a diff array, its contents - -- are physically updated in place. The old array silently changes - -- its representation without changing the visible behavior: - -- it stores a link to the new current array along with the - -- difference to be applied to get the old contents. - -- - -- So if a diff array is used in a single-threaded style, - -- i.e. after '//' application the old version is no longer used, - -- @a'!'i@ takes O(1) time and @a '//' d@ takes O(@length d@). - -- Accessing elements of older versions gradually becomes slower. - -- - -- Updating an array which is not current makes a physical copy. - -- The resulting array is unlinked from the old family. So you - -- can obtain a version which is guaranteed to be current and - -- thus have fast element access by @a '//' []@. - - -- Possible improvement for the future (not implemented now): - -- make it possible to say "I will make an update now, but when - -- I later return to the old version, I want it to mutate back - -- instead of being copied". - - IOToDiffArray, -- data IOToDiffArray - -- (a :: * -> * -> *) -- internal mutable array - -- (i :: *) -- indices - -- (e :: *) -- elements - - -- | Type synonyms for the two most important IO array types. - - -- Two most important diff array types are fully polymorphic - -- lazy boxed DiffArray: - DiffArray, -- = IOToDiffArray IOArray - -- ...and strict unboxed DiffUArray, working only for elements - -- of primitive types but more compact and usually faster: - DiffUArray, -- = IOToDiffArray IOUArray - - -- * Overloaded immutable array interface - - -- | Module "Data.Array.IArray" provides the interface of diff arrays. - -- They are instances of class 'IArray'. - module Data.Array.IArray, - - -- * Low-level interface - - -- | These are really internal functions, but you will need them - -- to make further 'IArray' instances of various diff array types - -- (for either more 'MArray' types or more unboxed element types). - newDiffArray, readDiffArray, replaceDiffArray - ) - where - ------------------------------------------------------------------------- --- Imports. - -import Data.Array.Base -import Data.Array.IArray -import Data.Array.IO - -import Foreign.Ptr ( Ptr, FunPtr ) -import Foreign.StablePtr ( StablePtr ) -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Word ( Word, Word8, Word16, Word32, Word64 ) - -import System.IO.Unsafe ( unsafePerformIO ) -import Control.Exception ( evaluate ) -import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar ) - ------------------------------------------------------------------------- --- Diff array types. - --- | An arbitrary 'MArray' type living in the 'IO' monad can be converted --- to a diff array. - -newtype IOToDiffArray a i e = - DiffArray {varDiffArray :: MVar (DiffArrayData a i e)} - --- Internal representation: either a mutable array, or a link to --- another diff array patched with a list of index+element pairs. -data DiffArrayData a i e = Current (a i e) - | Diff (IOToDiffArray a i e) [(Int, e)] - --- | Fully polymorphic lazy boxed diff array. -type DiffArray = IOToDiffArray IOArray - --- | Strict unboxed diff array, working only for elements --- of primitive types but more compact and usually faster than 'DiffArray'. -type DiffUArray = IOToDiffArray IOUArray - --- Having 'MArray a e IO' in instance context would require --- -XUndecidableInstances, so each instance is separate here. - ------------------------------------------------------------------------- --- Showing DiffArrays - -instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Bool) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where - showsPrec = showsIArray - -instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where - showsPrec = showsIArray - ------------------------------------------------------------------------- --- Boring instances. - -instance IArray (IOToDiffArray IOArray) e where - bounds a = unsafePerformIO $ boundsDiffArray a - numElements a = unsafePerformIO $ numElementsDiffArray 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) Bool where - bounds a = unsafePerformIO $ boundsDiffArray a - numElements a = unsafePerformIO $ numElementsDiffArray 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) Char where - bounds a = unsafePerformIO $ boundsDiffArray a - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray 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 - numElements a = unsafePerformIO $ numElementsDiffArray a - unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies - unsafeAt a i = unsafePerformIO $ a `readDiffArray` i - unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies - - - ------------------------------------------------------------------------- --- The important stuff. - -newDiffArray :: (MArray a e IO, Ix i) - => (i,i) - -> [(Int, e)] - -> IO (IOToDiffArray a i e) -newDiffArray (l,u) ies = do - a <- newArray_ (l,u) - sequence_ [unsafeWrite a i e | (i, e) <- ies] - var <- newMVar (Current a) - return (DiffArray var) - -readDiffArray :: (MArray a e IO, Ix i) - => IOToDiffArray a i e - -> Int - -> IO e -a `readDiffArray` i = do - d <- readMVar (varDiffArray a) - case d of - Current a' -> unsafeRead a' i - Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies) - -replaceDiffArray :: (MArray a e IO, Ix i) - => IOToDiffArray a i e - -> [(Int, e)] - -> IO (IOToDiffArray a i e) -a `replaceDiffArray` ies = do - d <- takeMVar (varDiffArray a) - case d of - Current a' -> case ies of - [] -> do - -- We don't do the copy when there is nothing to change - -- and this is the current version. But see below. - putMVar (varDiffArray a) d - return a - _:_ -> do - diff <- sequence [do e <- unsafeRead a' i; return (i, e) - | (i, _) <- ies] - sequence_ [unsafeWrite a' i e | (i, e) <- ies] - var' <- newMVar (Current a') - putMVar (varDiffArray a) (Diff (DiffArray var') diff) - return (DiffArray var') - Diff _ _ -> do - -- We still do the copy when there is nothing to change - -- but this is not the current version. So you can use - -- 'a // []' to make sure that the resulting array has - -- fast element access. - putMVar (varDiffArray a) d - a' <- thawDiffArray a - -- thawDiffArray gives a fresh array which we can - -- safely mutate. - sequence_ [unsafeWrite a' i e | (i, e) <- ies] - var' <- newMVar (Current a') - return (DiffArray var') - --- The elements of the diff list might recursively reference the --- array, so we must seq them before taking the MVar to avoid --- deadlock. -replaceDiffArray1 :: (MArray a e IO, Ix i) - => IOToDiffArray a i e - -> [(Int, e)] - -> IO (IOToDiffArray a i e) -a `replaceDiffArray1` ies = do - mapM_ (evaluate . fst) ies - a `replaceDiffArray` ies - --- If the array contains unboxed elements, then the elements of the --- diff list may also recursively reference the array from inside --- replaceDiffArray, so we must seq them too. -replaceDiffArray2 :: (MArray a e IO, Ix i) - => IOToDiffArray a i e - -> [(Int, e)] - -> IO (IOToDiffArray a i e) -arr `replaceDiffArray2` ies = do - mapM_ (\(a,b) -> evaluate a >> evaluate b) ies - arr `replaceDiffArray` ies - - -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' -> getBounds a' - Diff a' _ -> boundsDiffArray a' - -numElementsDiffArray :: (MArray a e IO, Ix ix) - => IOToDiffArray a ix e - -> IO Int -numElementsDiffArray a - = do d <- readMVar (varDiffArray a) - case d of - Current a' -> getNumElements a' - Diff a' _ -> numElementsDiffArray a' - -freezeDiffArray :: (MArray a e IO, Ix ix) - => a ix e - -> IO (IOToDiffArray a ix e) -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 - #-} - --- unsafeFreezeDiffArray is really unsafe. Better don't use the old --- array at all after freezing. The contents of the source array will --- be changed when '//' is applied to the resulting array. - -unsafeFreezeDiffArray :: (MArray a e IO, Ix ix) - => a ix e - -> IO (IOToDiffArray a ix e) -unsafeFreezeDiffArray a = do - var <- newMVar (Current a) - return (DiffArray var) - -{-# RULES -"unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray - #-} - -thawDiffArray :: (MArray a e IO, Ix ix) - => IOToDiffArray a ix e - -> IO (a ix e) -thawDiffArray a = do - d <- readMVar (varDiffArray a) - case d of - 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 a' ies -> do - a'' <- thawDiffArray a' - sequence_ [unsafeWrite a'' i e | (i, e) <- ies] - return a'' - -{-# RULES -"thaw/DiffArray" thaw = thawDiffArray - #-} - --- unsafeThawDiffArray is really unsafe. Better don't use the old --- array at all after thawing. The contents of the resulting array --- will be changed when '//' is applied to the source array. - -unsafeThawDiffArray :: (MArray a e IO, Ix ix) - => IOToDiffArray a ix e - -> IO (a ix e) -unsafeThawDiffArray a = do - d <- readMVar (varDiffArray a) - case d of - Current a' -> return a' - Diff a' ies -> do - a'' <- unsafeThawDiffArray a' - sequence_ [unsafeWrite a'' i e | (i, e) <- ies] - return a'' - -{-# RULES -"unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray - #-} diff --git a/Data/Array/IArray.hs b/Data/Array/IArray.hs index 6d035c802703787e9239d795928aab8970a824ef..84ab0d4e2c51bfc975789b5d1cd9c704bf5de6c1 100644 --- a/Data/Array/IArray.hs +++ b/Data/Array/IArray.hs @@ -10,7 +10,8 @@ -- -- Immutable arrays, with an overloaded interface. For array types which -- can be used with this interface, see the 'Array' type exported by this --- module, and the "Data.Array.Unboxed" and "Data.Array.Diff" modules. +-- module and the "Data.Array.Unboxed" module. Other packages, such as +-- diffarray, also provide arrays using this interface. -- ----------------------------------------------------------------------------- diff --git a/array.cabal b/array.cabal index 9ad42586879852a8b744bff5a28f0a0eaba664d6..d5f8116ea58a254c1aae18eafbe8992e690162d6 100644 --- a/array.cabal +++ b/array.cabal @@ -26,7 +26,6 @@ library if !impl(nhc98) exposed-modules: Data.Array.Base - Data.Array.Diff Data.Array.IArray Data.Array.IO Data.Array.IO.Internals