3e86f89524dc646ff894fadc7253366ed7ee3926
[packages/random.git] / Data / Array / Diff.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Array.Diff
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (uses Data.Array.IArray)
10 --
11 -- Functional arrays with constant-time update.
12 --
13 -----------------------------------------------------------------------------
14
15 module Data.Array.Diff (
16
17 -- * Diff array types
18
19 -- | Diff arrays have an immutable interface, but rely on internal
20 -- updates in place to provide fast functional update operator
21 -- '//'.
22 --
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.
28 --
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.
33 --
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 '//' []@.
38
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".
43
44 IOToDiffArray, -- data IOToDiffArray
45 -- (a :: * -> * -> *) -- internal mutable array
46 -- (i :: *) -- indices
47 -- (e :: *) -- elements
48
49 -- | Type synonyms for the two most important IO array types.
50
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
57
58 -- * Overloaded immutable array interface
59
60 -- | Module "Data.Array.IArray" provides the interface of diff arrays.
61 -- They are instances of class 'IArray'.
62 module Data.Array.IArray,
63
64 -- * Low-level interface
65
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
70 )
71 where
72
73 ------------------------------------------------------------------------
74 -- Imports.
75
76 import Prelude
77
78 import Data.Ix
79 import Data.Array.Base
80 import Data.Array.IArray
81 import Data.Array.IO
82
83 import Foreign.Ptr ( Ptr, FunPtr )
84 import Foreign.StablePtr ( StablePtr )
85 import Data.Int ( Int8, Int16, Int32, Int64 )
86 import Data.Word ( Word, Word8, Word16, Word32, Word64 )
87
88 import System.IO.Unsafe ( unsafePerformIO )
89 import Control.Exception ( evaluate )
90 import Control.Concurrent.MVar ( MVar, newMVar, takeMVar, putMVar, readMVar )
91
92 ------------------------------------------------------------------------
93 -- Diff array types.
94
95 -- | An arbitrary 'MArray' type living in the 'IO' monad can be converted
96 -- to a diff array.
97
98 newtype IOToDiffArray a i e =
99 DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}
100
101 -- Internal representation: either a mutable array, or a link to
102 -- another diff array patched with a list of index+element pairs.
103 data DiffArrayData a i e = Current (a i e)
104 | Diff (IOToDiffArray a i e) [(Int, e)]
105
106 -- | Fully polymorphic lazy boxed diff array.
107 type DiffArray = IOToDiffArray IOArray
108
109 -- | Strict unboxed diff array, working only for elements
110 -- of primitive types but more compact and usually faster than 'DiffArray'.
111 type DiffUArray = IOToDiffArray IOUArray
112
113 -- Having 'MArray a e IO' in instance context would require
114 -- -fallow-undecidable-instances, so each instance is separate here.
115
116 ------------------------------------------------------------------------
117 -- Showing DiffArrays
118
119 instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where
120 showsPrec = showsIArray
121
122 instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where
123 showsPrec = showsIArray
124
125 instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where
126 showsPrec = showsIArray
127
128 instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where
129 showsPrec = showsIArray
130
131 instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where
132 showsPrec = showsIArray
133
134 instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where
135 showsPrec = showsIArray
136
137 instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where
138 showsPrec = showsIArray
139
140 instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where
141 showsPrec = showsIArray
142
143 instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where
144 showsPrec = showsIArray
145
146 instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where
147 showsPrec = showsIArray
148
149 instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where
150 showsPrec = showsIArray
151
152 instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where
153 showsPrec = showsIArray
154
155 instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where
156 showsPrec = showsIArray
157
158 instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where
159 showsPrec = showsIArray
160
161 ------------------------------------------------------------------------
162 -- Boring instances.
163
164 instance IArray (IOToDiffArray IOArray) e where
165 bounds a = unsafePerformIO $ boundsDiffArray a
166 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
167 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
168 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray1` ies
169
170 instance IArray (IOToDiffArray IOUArray) Char where
171 bounds a = unsafePerformIO $ boundsDiffArray a
172 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
173 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
174 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
175
176 instance IArray (IOToDiffArray IOUArray) Int where
177 bounds a = unsafePerformIO $ boundsDiffArray a
178 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
179 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
180 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
181
182 instance IArray (IOToDiffArray IOUArray) Word where
183 bounds a = unsafePerformIO $ boundsDiffArray a
184 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
185 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
186 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
187
188 instance IArray (IOToDiffArray IOUArray) (Ptr a) where
189 bounds a = unsafePerformIO $ boundsDiffArray a
190 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
191 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
192 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
193
194 instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
195 bounds a = unsafePerformIO $ boundsDiffArray a
196 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
197 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
198 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
199
200 instance IArray (IOToDiffArray IOUArray) Float where
201 bounds a = unsafePerformIO $ boundsDiffArray a
202 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
203 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
204 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
205
206 instance IArray (IOToDiffArray IOUArray) Double where
207 bounds a = unsafePerformIO $ boundsDiffArray a
208 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
209 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
210 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
211
212 instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
213 bounds a = unsafePerformIO $ boundsDiffArray a
214 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
215 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
216 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
217
218 instance IArray (IOToDiffArray IOUArray) Int8 where
219 bounds a = unsafePerformIO $ boundsDiffArray a
220 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
221 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
222 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
223
224 instance IArray (IOToDiffArray IOUArray) Int16 where
225 bounds a = unsafePerformIO $ boundsDiffArray a
226 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
227 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
228 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
229
230 instance IArray (IOToDiffArray IOUArray) Int32 where
231 bounds a = unsafePerformIO $ boundsDiffArray a
232 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
233 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
234 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
235
236 instance IArray (IOToDiffArray IOUArray) Int64 where
237 bounds a = unsafePerformIO $ boundsDiffArray a
238 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
239 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
240 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
241
242 instance IArray (IOToDiffArray IOUArray) Word8 where
243 bounds a = unsafePerformIO $ boundsDiffArray a
244 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
245 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
246 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
247
248 instance IArray (IOToDiffArray IOUArray) Word16 where
249 bounds a = unsafePerformIO $ boundsDiffArray a
250 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
251 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
252 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
253
254 instance IArray (IOToDiffArray IOUArray) Word32 where
255 bounds a = unsafePerformIO $ boundsDiffArray a
256 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
257 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
258 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
259
260 instance IArray (IOToDiffArray IOUArray) Word64 where
261 bounds a = unsafePerformIO $ boundsDiffArray a
262 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
263 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
264 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray2` ies
265
266
267
268 ------------------------------------------------------------------------
269 -- The important stuff.
270
271 newDiffArray :: (MArray a e IO, Ix i)
272 => (i,i)
273 -> [(Int, e)]
274 -> IO (IOToDiffArray a i e)
275 newDiffArray (l,u) ies = do
276 a <- newArray_ (l,u)
277 sequence_ [unsafeWrite a i e | (i, e) <- ies]
278 var <- newMVar (Current a)
279 return (DiffArray var)
280
281 readDiffArray :: (MArray a e IO, Ix i)
282 => IOToDiffArray a i e
283 -> Int
284 -> IO e
285 a `readDiffArray` i = do
286 d <- readMVar (varDiffArray a)
287 case d of
288 Current a' -> unsafeRead a' i
289 Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)
290
291 replaceDiffArray :: (MArray a e IO, Ix i)
292 => IOToDiffArray a i e
293 -> [(Int, e)]
294 -> IO (IOToDiffArray a i e)
295 a `replaceDiffArray` ies = do
296 d <- takeMVar (varDiffArray a)
297 case d of
298 Current a' -> case ies of
299 [] -> do
300 -- We don't do the copy when there is nothing to change
301 -- and this is the current version. But see below.
302 putMVar (varDiffArray a) d
303 return a
304 _:_ -> do
305 diff <- sequence [do e <- unsafeRead a' i; return (i, e)
306 | (i, _) <- ies]
307 sequence_ [unsafeWrite a' i e | (i, e) <- ies]
308 var' <- newMVar (Current a')
309 putMVar (varDiffArray a) (Diff (DiffArray var') diff)
310 return (DiffArray var')
311 Diff _ _ -> do
312 -- We still do the copy when there is nothing to change
313 -- but this is not the current version. So you can use
314 -- 'a // []' to make sure that the resulting array has
315 -- fast element access.
316 putMVar (varDiffArray a) d
317 a' <- thawDiffArray a
318 -- thawDiffArray gives a fresh array which we can
319 -- safely mutate.
320 sequence_ [unsafeWrite a' i e | (i, e) <- ies]
321 var' <- newMVar (Current a')
322 return (DiffArray var')
323
324 -- The elements of the diff list might recursively reference the
325 -- array, so we must seq them before taking the MVar to avoid
326 -- deadlock.
327 replaceDiffArray1 :: (MArray a e IO, Ix i)
328 => IOToDiffArray a i e
329 -> [(Int, e)]
330 -> IO (IOToDiffArray a i e)
331 a `replaceDiffArray1` ies = do
332 mapM_ (evaluate . fst) ies
333 a `replaceDiffArray` ies
334
335 -- If the array contains unboxed elements, then the elements of the
336 -- diff list may also recursively reference the array from inside
337 -- replaceDiffArray, so we must seq them too.
338 replaceDiffArray2 :: (MArray a e IO, Ix i)
339 => IOToDiffArray a i e
340 -> [(Int, e)]
341 -> IO (IOToDiffArray a i e)
342 a `replaceDiffArray2` ies = do
343 mapM_ (\(a,b) -> do evaluate a; evaluate b) ies
344 a `replaceDiffArray` ies
345
346
347 boundsDiffArray :: (MArray a e IO, Ix ix)
348 => IOToDiffArray a ix e
349 -> IO (ix,ix)
350 boundsDiffArray a = do
351 d <- readMVar (varDiffArray a)
352 case d of
353 Current a' -> getBounds a'
354 Diff a' _ -> boundsDiffArray a'
355
356 freezeDiffArray :: (MArray a e IO, Ix ix)
357 => a ix e
358 -> IO (IOToDiffArray a ix e)
359 freezeDiffArray a = do
360 (l,u) <- getBounds a
361 a' <- newArray_ (l,u)
362 sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
363 var <- newMVar (Current a')
364 return (DiffArray var)
365
366 {-# RULES
367 "freeze/DiffArray" freeze = freezeDiffArray
368 #-}
369
370 -- unsafeFreezeDiffArray is really unsafe. Better don't use the old
371 -- array at all after freezing. The contents of the source array will
372 -- be changed when '//' is applied to the resulting array.
373
374 unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)
375 => a ix e
376 -> IO (IOToDiffArray a ix e)
377 unsafeFreezeDiffArray a = do
378 var <- newMVar (Current a)
379 return (DiffArray var)
380
381 {-# RULES
382 "unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray
383 #-}
384
385 thawDiffArray :: (MArray a e IO, Ix ix)
386 => IOToDiffArray a ix e
387 -> IO (a ix e)
388 thawDiffArray a = do
389 d <- readMVar (varDiffArray a)
390 case d of
391 Current a' -> do
392 (l,u) <- getBounds a'
393 a'' <- newArray_ (l,u)
394 sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]
395 return a''
396 Diff a' ies -> do
397 a'' <- thawDiffArray a'
398 sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
399 return a''
400
401 {-# RULES
402 "thaw/DiffArray" thaw = thawDiffArray
403 #-}
404
405 -- unsafeThawDiffArray is really unsafe. Better don't use the old
406 -- array at all after thawing. The contents of the resulting array
407 -- will be changed when '//' is applied to the source array.
408
409 unsafeThawDiffArray :: (MArray a e IO, Ix ix)
410 => IOToDiffArray a ix e
411 -> IO (a ix e)
412 unsafeThawDiffArray a = do
413 d <- readMVar (varDiffArray a)
414 case d of
415 Current a' -> return a'
416 Diff a' ies -> do
417 a'' <- unsafeThawDiffArray a'
418 sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
419 return a''
420
421 {-# RULES
422 "unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray
423 #-}