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