X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FArray%2FDiff.hs;h=94018e459fe8c7c8299c12252be1c770caa55c29;hb=2570f264ed329f04017d507250494eb0ab680d64;hp=9c65e6cde095baa11999fd48ff6c29b78f17d908;hpb=746ef6a7fd71bb1e9ebe3cd107c5f9f79f3b7a68;p=haskell-directory.git diff --git a/Data/Array/Diff.hs b/Data/Array/Diff.hs index 9c65e6c..94018e4 100644 --- a/Data/Array/Diff.hs +++ b/Data/Array/Diff.hs @@ -2,11 +2,11 @@ -- | -- 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. -- @@ -14,7 +14,9 @@ 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 -- '//'. -- @@ -26,40 +28,44 @@ module Data.Array.Diff ( -- -- 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 @@ -77,15 +83,18 @@ 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 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)} @@ -94,8 +103,11 @@ newtype IOToDiffArray 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 @@ -155,87 +167,87 @@ instance HasBounds a => HasBounds (IOToDiffArray a) where 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 @@ -295,6 +307,29 @@ a `replaceDiffArray` ies = do 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) @@ -307,7 +342,8 @@ boundsDiffArray a = do 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') @@ -338,7 +374,8 @@ thawDiffArray :: (MArray a e IO, Ix ix) 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''