-- |
-- Module : Data.Array.Diff
-- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/core/LICENSE)
+-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--- Portability : non-portable
+-- Portability : non-portable (uses Data.Array.IArray)
--
-- Functional arrays with constant-time update.
--
module Data.Array.Diff (
- -- Diff arrays have immutable interface, but rely on internal
+ -- * Diff array types
+
+ -- | Diff arrays have an immutable interface, but rely on internal
-- updates in place to provide fast functional update operator
-- '//'.
--
--
-- 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.
+ -- @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 // []'.
+ -- 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".
- -- An arbitrary MArray type living in the IO monad can be converted
- -- to a diff array.
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 IArray provides the interface of diff arrays. They are
- -- instances of class IArray.
+ -- | Module "Data.Array.IArray" provides the interface of diff arrays.
+ -- They are instances of class 'IArray'.
module Data.Array.IArray,
-
- -- These are really internal functions, but you will need them
- -- to make further IArray instances of various DiffArrays (for
- -- either more MArray types or more unboxed element types).
+
+ -- * 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
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 Data.Word ( Word, Word8, Word16, Word32, Word64 )
import System.IO.Unsafe ( unsafePerformIO )
-import Control.Concurrent ( MVar, newMVar, takeMVar, putMVar, readMVar )
+import Control.Exception ( evaluate )
+import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )
------------------------------------------------------------------------
-- Diff array types.
--- Convert an IO array type to a diff array.
+-- | 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)}
data DiffArrayData a i e = Current (a i e)
| Diff (IOToDiffArray a i e) [(Int, e)]
--- Type synonyms for two most important IO array types.
+-- | 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
instance IArray (IOToDiffArray IOArray) e where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray1` ies
instance IArray (IOToDiffArray IOUArray) Char where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) (Ptr a) where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Float where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Double where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int8 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int16 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int32 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Int64 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word8 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word16 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word32 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
instance IArray (IOToDiffArray IOUArray) Word64 where
unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
- unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
+ unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` 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)
+a `replaceDiffArray2` ies = do
+ mapM_ (\(a,b) -> do evaluate a; evaluate b) ies
+ a `replaceDiffArray` ies
+
+
boundsDiffArray :: (HasBounds a, Ix ix)
=> IOToDiffArray a ix e
-> IO (ix,ix)
freezeDiffArray :: (MArray a e IO, Ix ix)
=> a ix e
-> IO (IOToDiffArray a ix e)
-freezeDiffArray a | (l,u) <- bounds a = do
+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')
thawDiffArray a = do
d <- readMVar (varDiffArray a)
case d of
- Current a' | (l,u) <- bounds a' -> do
+ Current 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]]
return a''
projects / haskell-directory.git / blobdiff