1 -----------------------------------------------------------------------------
3 -- Module : Data.Array.Diff
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
11 -- Functional arrays with constant-time update.
13 -----------------------------------------------------------------------------
15 module Data.Array.Diff (
19 -- | Diff arrays have an immutable interface, but rely on internal
20 -- updates in place to provide fast functional update operator
23 -- When the '//' operator is applied to a diff array, its contents
24 -- are physically updated in place. The old array silently changes
25 -- its representation without changing the visible behavior:
26 -- it stores a link to the new current array along with the
27 -- difference to be applied to get the old contents.
29 -- So if a diff array is used in a single-threaded style,
30 -- i.e. after '//' application the old version is no longer used,
31 -- @a'!'i@ takes O(1) time and @a '//' d@ takes O(@length d@).
32 -- Accessing elements of older versions gradually becomes slower.
34 -- Updating an array which is not current makes a physical copy.
35 -- The resulting array is unlinked from the old family. So you
36 -- can obtain a version which is guaranteed to be current and
37 -- thus have fast element access by @a '//' []@.
39 -- Possible improvement for the future (not implemented now):
40 -- make it possible to say "I will make an update now, but when
41 -- I later return to the old version, I want it to mutate back
42 -- instead of being copied".
44 IOToDiffArray, -- data IOToDiffArray
45 -- (a :: * -> * -> *) -- internal mutable array
46 -- (i :: *) -- indices
47 -- (e :: *) -- elements
49 -- | Type synonyms for the two most important IO array types.
51 -- Two most important diff array types are fully polymorphic
52 -- lazy boxed DiffArray:
53 DiffArray, -- = IOToDiffArray IOArray
54 -- ...and strict unboxed DiffUArray, working only for elements
55 -- of primitive types but more compact and usually faster:
56 DiffUArray, -- = IOToDiffArray IOUArray
58 -- * Overloaded immutable array interface
60 -- | Module "Data.Array.IArray" provides the interface of diff arrays.
61 -- They are instances of class 'IArray'.
62 module Data.Array.IArray,
64 -- * Low-level interface
66 -- | These are really internal functions, but you will need them
67 -- to make further 'IArray' instances of various diff array types
68 -- (for either more 'MArray' types or more unboxed element types).
69 newDiffArray, readDiffArray, replaceDiffArray
73 ------------------------------------------------------------------------
79 import Data.Array.Base
80 import Data.Array.IArray
83 import Foreign.Ptr ( Ptr, FunPtr )
84 import Foreign.StablePtr ( StablePtr )
85 import Data.Int ( Int8, Int16, Int32, Int64 )
86 #ifdef __GLASGOW_HASKELL__
87 import Data.Word ( Word )
89 import Data.Word ( Word8, Word16, Word32, Word64 )
91 import System.IO.Unsafe ( unsafePerformIO )
92 import Control.Exception ( evaluate )
93 import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )
95 ------------------------------------------------------------------------
98 -- | An arbitrary 'MArray' type living in the 'IO' monad can be converted
101 newtype IOToDiffArray a i e =
102 DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}
104 -- Internal representation: either a mutable array, or a link to
105 -- another diff array patched with a list of index+element pairs.
106 data DiffArrayData a i e = Current (a i e)
107 | Diff (IOToDiffArray a i e) [(Int, e)]
109 -- | Fully polymorphic lazy boxed diff array.
110 type DiffArray = IOToDiffArray IOArray
112 -- | Strict unboxed diff array, working only for elements
113 -- of primitive types but more compact and usually faster than 'DiffArray'.
114 type DiffUArray = IOToDiffArray IOUArray
116 -- Having 'MArray a e IO' in instance context would require
117 -- -fallow-undecidable-instances, so each instance is separate here.
119 ------------------------------------------------------------------------
120 -- Showing DiffArrays
122 instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where
123 showsPrec = showsIArray
125 instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where
126 showsPrec = showsIArray
128 instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where
129 showsPrec = showsIArray
131 #ifdef __GLASGOW_HASKELL__
132 instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where
133 showsPrec = showsIArray
136 instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where
137 showsPrec = showsIArray
139 instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where
140 showsPrec = showsIArray
142 instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where
143 showsPrec = showsIArray
145 instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where
146 showsPrec = showsIArray
148 instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where
149 showsPrec = showsIArray
151 instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where
152 showsPrec = showsIArray
154 instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where
155 showsPrec = showsIArray
157 instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where
158 showsPrec = showsIArray
160 instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where
161 showsPrec = showsIArray
163 instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where
164 showsPrec = showsIArray
166 ------------------------------------------------------------------------
169 instance HasBounds a => HasBounds (IOToDiffArray a) where
170 bounds a = unsafePerformIO $ boundsDiffArray a
172 instance IArray (IOToDiffArray IOArray) e where
173 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
174 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
175 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray1` ies
177 instance IArray (IOToDiffArray IOUArray) Char where
178 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
179 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
180 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
182 instance IArray (IOToDiffArray IOUArray) Int where
183 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
184 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
185 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
187 #ifdef __GLASGOW_HASKELL__
188 instance IArray (IOToDiffArray IOUArray) Word where
189 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
190 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
191 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
194 instance IArray (IOToDiffArray IOUArray) (Ptr a) where
195 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
196 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
197 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
199 instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
200 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
201 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
202 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
204 instance IArray (IOToDiffArray IOUArray) Float where
205 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
206 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
207 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
209 instance IArray (IOToDiffArray IOUArray) Double where
210 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
211 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
212 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
214 instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
215 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
216 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
217 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
219 instance IArray (IOToDiffArray IOUArray) Int8 where
220 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
221 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
222 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
224 instance IArray (IOToDiffArray IOUArray) Int16 where
225 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
226 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
227 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
229 instance IArray (IOToDiffArray IOUArray) Int32 where
230 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
231 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
232 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
234 instance IArray (IOToDiffArray IOUArray) Int64 where
235 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
236 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
237 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
239 instance IArray (IOToDiffArray IOUArray) Word8 where
240 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
241 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
242 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
244 instance IArray (IOToDiffArray IOUArray) Word16 where
245 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
246 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
247 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
249 instance IArray (IOToDiffArray IOUArray) Word32 where
250 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
251 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
252 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
254 instance IArray (IOToDiffArray IOUArray) Word64 where
255 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
256 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
257 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
261 ------------------------------------------------------------------------
262 -- The important stuff.
264 newDiffArray :: (MArray a e IO, Ix i)
267 -> IO (IOToDiffArray a i e)
268 newDiffArray (l,u) ies = do
270 sequence_ [unsafeWrite a i e | (i, e) <- ies]
271 var <- newMVar (Current a)
272 return (DiffArray var)
274 readDiffArray :: (MArray a e IO, Ix i)
275 => IOToDiffArray a i e
278 a `readDiffArray` i = do
279 d <- readMVar (varDiffArray a)
281 Current a' -> unsafeRead a' i
282 Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)
284 replaceDiffArray :: (MArray a e IO, Ix i)
285 => IOToDiffArray a i e
287 -> IO (IOToDiffArray a i e)
288 a `replaceDiffArray` ies = do
289 d <- takeMVar (varDiffArray a)
291 Current a' -> case ies of
293 -- We don't do the copy when there is nothing to change
294 -- and this is the current version. But see below.
295 putMVar (varDiffArray a) d
298 diff <- sequence [do e <- unsafeRead a' i; return (i, e)
300 sequence_ [unsafeWrite a' i e | (i, e) <- ies]
301 var' <- newMVar (Current a')
302 putMVar (varDiffArray a) (Diff (DiffArray var') diff)
303 return (DiffArray var')
305 -- We still do the copy when there is nothing to change
306 -- but this is not the current version. So you can use
307 -- 'a // []' to make sure that the resulting array has
308 -- fast element access.
309 putMVar (varDiffArray a) d
310 a' <- thawDiffArray a
311 -- thawDiffArray gives a fresh array which we can
313 sequence_ [unsafeWrite a' i e | (i, e) <- ies]
314 var' <- newMVar (Current a')
315 return (DiffArray var')
317 -- The elements of the diff list might recursively reference the
318 -- array, so we must seq them before taking the MVar to avoid
320 replaceDiffArray1 :: (MArray a e IO, Ix i)
321 => IOToDiffArray a i e
323 -> IO (IOToDiffArray a i e)
324 a `replaceDiffArray1` ies = do
325 mapM_ (evaluate . fst) ies
326 a `replaceDiffArray` ies
328 -- If the array contains unboxed elements, then the elements of the
329 -- diff list may also recursively reference the array from inside
330 -- replaceDiffArray, so we must seq them too.
331 replaceDiffArray2 :: (MArray a e IO, Ix i)
332 => IOToDiffArray a i e
334 -> IO (IOToDiffArray a i e)
335 a `replaceDiffArray2` ies = do
336 mapM_ (\(a,b) -> do evaluate a; evaluate b) ies
337 a `replaceDiffArray` ies
340 boundsDiffArray :: (HasBounds a, Ix ix)
341 => IOToDiffArray a ix e
343 boundsDiffArray a = do
344 d <- readMVar (varDiffArray a)
346 Current a' -> return (bounds a')
347 Diff a' _ -> boundsDiffArray a'
349 freezeDiffArray :: (MArray a e IO, Ix ix)
351 -> IO (IOToDiffArray a ix e)
352 freezeDiffArray a = case bounds a of
354 a' <- newArray_ (l,u)
355 sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
356 var <- newMVar (Current a')
357 return (DiffArray var)
360 "freeze/DiffArray" freeze = freezeDiffArray
363 -- unsafeFreezeDiffArray is really unsafe. Better don't use the old
364 -- array at all after freezing. The contents of the source array will
365 -- be changed when '//' is applied to the resulting array.
367 unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)
369 -> IO (IOToDiffArray a ix e)
370 unsafeFreezeDiffArray a = do
371 var <- newMVar (Current a)
372 return (DiffArray var)
375 "unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray
378 thawDiffArray :: (MArray a e IO, Ix ix)
379 => IOToDiffArray a ix e
382 d <- readMVar (varDiffArray a)
384 Current a' -> case bounds a' of
386 a'' <- newArray_ (l,u)
387 sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]
390 a'' <- thawDiffArray a'
391 sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
395 "thaw/DiffArray" thaw = thawDiffArray
398 -- unsafeThawDiffArray is really unsafe. Better don't use the old
399 -- array at all after thawing. The contents of the resulting array
400 -- will be changed when '//' is applied to the source array.
402 unsafeThawDiffArray :: (MArray a e IO, Ix ix)
403 => IOToDiffArray a ix e
405 unsafeThawDiffArray a = do
406 d <- readMVar (varDiffArray a)
408 Current a' -> return a'
410 a'' <- unsafeThawDiffArray a'
411 sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
415 "unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray