9c65e6cde095baa11999fd48ff6c29b78f17d908
[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/core/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
10 --
11 -- Functional arrays with constant-time update.
12 --
13 -----------------------------------------------------------------------------
14
15 module Data.Array.Diff (
16
17 -- Diff arrays have immutable interface, but rely on internal
18 -- updates in place to provide fast functional update operator
19 -- '//'.
20 --
21 -- When the '//' operator is applied to a diff array, its contents
22 -- are physically updated in place. The old array silently changes
23 -- its representation without changing the visible behavior:
24 -- it stores a link to the new current array along with the
25 -- difference to be applied to get the old contents.
26 --
27 -- So if a diff array is used in a single-threaded style,
28 -- i.e. after '//' application the old version is no longer used,
29 -- 'a!i' takes O(1) time and 'a // d' takes O(length d). Accessing
30 -- elements of older versions gradually becomes slower.
31 --
32 -- Updating an array which is not current makes a physical copy.
33 -- The resulting array is unlinked from the old family. So you
34 -- can obtain a version which is guaranteed to be current and
35 -- thus have fast element access by 'a // []'.
36
37 -- Possible improvement for the future (not implemented now):
38 -- make it possible to say "I will make an update now, but when
39 -- I later return to the old version, I want it to mutate back
40 -- instead of being copied".
41
42 -- An arbitrary MArray type living in the IO monad can be converted
43 -- to a diff array.
44 IOToDiffArray, -- data IOToDiffArray
45 -- (a :: * -> * -> *) -- internal mutable array
46 -- (i :: *) -- indices
47 -- (e :: *) -- elements
48
49 -- Two most important diff array types are fully polymorphic
50 -- lazy boxed DiffArray:
51 DiffArray, -- = IOToDiffArray IOArray
52 -- ...and strict unboxed DiffUArray, working only for elements
53 -- of primitive types but more compact and usually faster:
54 DiffUArray, -- = IOToDiffArray IOUArray
55
56 -- Module IArray provides the interface of diff arrays. They are
57 -- instances of class IArray.
58 module Data.Array.IArray,
59
60 -- These are really internal functions, but you will need them
61 -- to make further IArray instances of various DiffArrays (for
62 -- either more MArray types or more unboxed element types).
63 newDiffArray, readDiffArray, replaceDiffArray
64 )
65 where
66
67 ------------------------------------------------------------------------
68 -- Imports.
69
70 import Prelude
71
72 import Data.Ix
73 import Data.Array.Base
74 import Data.Array.IArray
75 import Data.Array.IO
76
77 import Foreign.Ptr ( Ptr, FunPtr )
78 import Foreign.StablePtr ( StablePtr )
79 import Data.Int ( Int8, Int16, Int32, Int64 )
80 import Data.Word ( Word, Word8, Word16, Word32, Word64)
81
82 import System.IO.Unsafe ( unsafePerformIO )
83 import Control.Concurrent ( MVar, newMVar, takeMVar, putMVar, readMVar )
84
85 ------------------------------------------------------------------------
86 -- Diff array types.
87
88 -- Convert an IO array type to a diff array.
89 newtype IOToDiffArray a i e =
90 DiffArray {varDiffArray :: MVar (DiffArrayData a i e)}
91
92 -- Internal representation: either a mutable array, or a link to
93 -- another diff array patched with a list of index+element pairs.
94 data DiffArrayData a i e = Current (a i e)
95 | Diff (IOToDiffArray a i e) [(Int, e)]
96
97 -- Type synonyms for two most important IO array types.
98 type DiffArray = IOToDiffArray IOArray
99 type DiffUArray = IOToDiffArray IOUArray
100
101 -- Having 'MArray a e IO' in instance context would require
102 -- -fallow-undecidable-instances, so each instance is separate here.
103
104 ------------------------------------------------------------------------
105 -- Showing DiffArrays
106
107 instance (Ix ix, Show ix, Show e) => Show (DiffArray ix e) where
108 showsPrec = showsIArray
109
110 instance (Ix ix, Show ix) => Show (DiffUArray ix Char) where
111 showsPrec = showsIArray
112
113 instance (Ix ix, Show ix) => Show (DiffUArray ix Int) where
114 showsPrec = showsIArray
115
116 instance (Ix ix, Show ix) => Show (DiffUArray ix Word) where
117 showsPrec = showsIArray
118
119 instance (Ix ix, Show ix) => Show (DiffUArray ix Float) where
120 showsPrec = showsIArray
121
122 instance (Ix ix, Show ix) => Show (DiffUArray ix Double) where
123 showsPrec = showsIArray
124
125 instance (Ix ix, Show ix) => Show (DiffUArray ix Int8) where
126 showsPrec = showsIArray
127
128 instance (Ix ix, Show ix) => Show (DiffUArray ix Int16) where
129 showsPrec = showsIArray
130
131 instance (Ix ix, Show ix) => Show (DiffUArray ix Int32) where
132 showsPrec = showsIArray
133
134 instance (Ix ix, Show ix) => Show (DiffUArray ix Int64) where
135 showsPrec = showsIArray
136
137 instance (Ix ix, Show ix) => Show (DiffUArray ix Word8) where
138 showsPrec = showsIArray
139
140 instance (Ix ix, Show ix) => Show (DiffUArray ix Word16) where
141 showsPrec = showsIArray
142
143 instance (Ix ix, Show ix) => Show (DiffUArray ix Word32) where
144 showsPrec = showsIArray
145
146 instance (Ix ix, Show ix) => Show (DiffUArray ix Word64) where
147 showsPrec = showsIArray
148
149 ------------------------------------------------------------------------
150 -- Boring instances.
151
152 instance HasBounds a => HasBounds (IOToDiffArray a) where
153 bounds a = unsafePerformIO $ boundsDiffArray a
154
155 instance IArray (IOToDiffArray IOArray) e where
156 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
157 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
158 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
159
160 instance IArray (IOToDiffArray IOUArray) Char where
161 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
162 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
163 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
164
165 instance IArray (IOToDiffArray IOUArray) Int where
166 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
167 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
168 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
169
170 instance IArray (IOToDiffArray IOUArray) Word where
171 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
172 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
173 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
174
175 instance IArray (IOToDiffArray IOUArray) (Ptr a) where
176 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
177 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
178 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
179
180 instance IArray (IOToDiffArray IOUArray) (FunPtr a) where
181 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
182 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
183 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
184
185 instance IArray (IOToDiffArray IOUArray) Float where
186 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
187 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
188 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
189
190 instance IArray (IOToDiffArray IOUArray) Double where
191 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
192 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
193 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
194
195 instance IArray (IOToDiffArray IOUArray) (StablePtr a) where
196 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
197 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
198 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
199
200 instance IArray (IOToDiffArray IOUArray) Int8 where
201 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
202 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
203 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
204
205 instance IArray (IOToDiffArray IOUArray) Int16 where
206 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
207 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
208 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
209
210 instance IArray (IOToDiffArray IOUArray) Int32 where
211 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
212 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
213 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
214
215 instance IArray (IOToDiffArray IOUArray) Int64 where
216 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
217 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
218 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
219
220 instance IArray (IOToDiffArray IOUArray) Word8 where
221 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
222 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
223 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
224
225 instance IArray (IOToDiffArray IOUArray) Word16 where
226 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
227 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
228 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
229
230 instance IArray (IOToDiffArray IOUArray) Word32 where
231 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
232 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
233 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
234
235 instance IArray (IOToDiffArray IOUArray) Word64 where
236 unsafeArray lu ies = unsafePerformIO $ newDiffArray lu ies
237 unsafeAt a i = unsafePerformIO $ a `readDiffArray` i
238 unsafeReplace a ies = unsafePerformIO $ a `replaceDiffArray` ies
239
240
241
242 ------------------------------------------------------------------------
243 -- The important stuff.
244
245 newDiffArray :: (MArray a e IO, Ix i)
246 => (i,i)
247 -> [(Int, e)]
248 -> IO (IOToDiffArray a i e)
249 newDiffArray (l,u) ies = do
250 a <- newArray_ (l,u)
251 sequence_ [unsafeWrite a i e | (i, e) <- ies]
252 var <- newMVar (Current a)
253 return (DiffArray var)
254
255 readDiffArray :: (MArray a e IO, Ix i)
256 => IOToDiffArray a i e
257 -> Int
258 -> IO e
259 a `readDiffArray` i = do
260 d <- readMVar (varDiffArray a)
261 case d of
262 Current a' -> unsafeRead a' i
263 Diff a' ies -> maybe (readDiffArray a' i) return (lookup i ies)
264
265 replaceDiffArray :: (MArray a e IO, Ix i)
266 => IOToDiffArray a i e
267 -> [(Int, e)]
268 -> IO (IOToDiffArray a i e)
269 a `replaceDiffArray` ies = do
270 d <- takeMVar (varDiffArray a)
271 case d of
272 Current a' -> case ies of
273 [] -> do
274 -- We don't do the copy when there is nothing to change
275 -- and this is the current version. But see below.
276 putMVar (varDiffArray a) d
277 return a
278 _:_ -> do
279 diff <- sequence [do e <- unsafeRead a' i; return (i, e)
280 | (i, _) <- ies]
281 sequence_ [unsafeWrite a' i e | (i, e) <- ies]
282 var' <- newMVar (Current a')
283 putMVar (varDiffArray a) (Diff (DiffArray var') diff)
284 return (DiffArray var')
285 Diff _ _ -> do
286 -- We still do the copy when there is nothing to change
287 -- but this is not the current version. So you can use
288 -- 'a // []' to make sure that the resulting array has
289 -- fast element access.
290 putMVar (varDiffArray a) d
291 a' <- thawDiffArray a
292 -- thawDiffArray gives a fresh array which we can
293 -- safely mutate.
294 sequence_ [unsafeWrite a' i e | (i, e) <- ies]
295 var' <- newMVar (Current a')
296 return (DiffArray var')
297
298 boundsDiffArray :: (HasBounds a, Ix ix)
299 => IOToDiffArray a ix e
300 -> IO (ix,ix)
301 boundsDiffArray a = do
302 d <- readMVar (varDiffArray a)
303 case d of
304 Current a' -> return (bounds a')
305 Diff a' _ -> boundsDiffArray a'
306
307 freezeDiffArray :: (MArray a e IO, Ix ix)
308 => a ix e
309 -> IO (IOToDiffArray a ix e)
310 freezeDiffArray a | (l,u) <- bounds a = do
311 a' <- newArray_ (l,u)
312 sequence_ [unsafeRead a i >>= unsafeWrite a' i | i <- [0 .. rangeSize (l,u) - 1]]
313 var <- newMVar (Current a')
314 return (DiffArray var)
315
316 {-# RULES
317 "freeze/DiffArray" freeze = freezeDiffArray
318 #-}
319
320 -- unsafeFreezeDiffArray is really unsafe. Better don't use the old
321 -- array at all after freezing. The contents of the source array will
322 -- be changed when '//' is applied to the resulting array.
323
324 unsafeFreezeDiffArray :: (MArray a e IO, Ix ix)
325 => a ix e
326 -> IO (IOToDiffArray a ix e)
327 unsafeFreezeDiffArray a = do
328 var <- newMVar (Current a)
329 return (DiffArray var)
330
331 {-# RULES
332 "unsafeFreeze/DiffArray" unsafeFreeze = unsafeFreezeDiffArray
333 #-}
334
335 thawDiffArray :: (MArray a e IO, Ix ix)
336 => IOToDiffArray a ix e
337 -> IO (a ix e)
338 thawDiffArray a = do
339 d <- readMVar (varDiffArray a)
340 case d of
341 Current a' | (l,u) <- bounds a' -> do
342 a'' <- newArray_ (l,u)
343 sequence_ [unsafeRead a' i >>= unsafeWrite a'' i | i <- [0 .. rangeSize (l,u) - 1]]
344 return a''
345 Diff a' ies -> do
346 a'' <- thawDiffArray a'
347 sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
348 return a''
349
350 {-# RULES
351 "thaw/DiffArray" thaw = thawDiffArray
352 #-}
353
354 -- unsafeThawDiffArray is really unsafe. Better don't use the old
355 -- array at all after thawing. The contents of the resulting array
356 -- will be changed when '//' is applied to the source array.
357
358 unsafeThawDiffArray :: (MArray a e IO, Ix ix)
359 => IOToDiffArray a ix e
360 -> IO (a ix e)
361 unsafeThawDiffArray a = do
362 d <- readMVar (varDiffArray a)
363 case d of
364 Current a' -> return a'
365 Diff a' ies -> do
366 a'' <- unsafeThawDiffArray a'
367 sequence_ [unsafeWrite a'' i e | (i, e) <- ies]
368 return a''
369
370 {-# RULES
371 "unsafeThaw/DiffArray" unsafeThaw = unsafeThawDiffArray
372 #-}