[project @ 2006-01-06 15:51:23 by simonpj]
[packages/random.git] / Data / Generics / Instances.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Generics.Instances
4 -- Copyright : (c) The University of Glasgow, CWI 2001--2004
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.Generics.Basics)
10 --
11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell
12 -- See <http://www.cs.vu.nl/boilerplate/>. The present module
13 -- instantiates the class Data for Prelude-like datatypes.
14 -- (This module does not export anything. It really just defines instances.)
15 --
16 -----------------------------------------------------------------------------
17
18 module Data.Generics.Instances
19
20 where
21
22
23 ------------------------------------------------------------------------------
24
25 #ifdef __HADDOCK__
26 import Prelude
27 #endif
28
29 import Data.Generics.Basics
30
31 import Data.Typeable
32 import Data.Int -- So we can give Data instance for Int8, ...
33 import Data.Word -- So we can give Data instance for Word8, ...
34 import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
35 import GHC.IOBase -- So we can give Data instance for IO, Handle
36 import GHC.Ptr -- So we can give Data instance for Ptr
37 import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr
38 import GHC.Stable -- So we can give Data instance for StablePtr
39 import GHC.ST -- So we can give Data instance for ST
40 import GHC.Conc -- So we can give Data instance for MVar & Co.
41 import GHC.Arr -- So we can give Data instance for Array
42
43 #include "Typeable.h"
44
45
46
47 ------------------------------------------------------------------------------
48 --
49 -- Instances of the Data class for Prelude-like types.
50 -- We define top-level definitions for representations.
51 --
52 ------------------------------------------------------------------------------
53
54
55 falseConstr = mkConstr boolDataType "False" [] Prefix
56 trueConstr = mkConstr boolDataType "True" [] Prefix
57 boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
58
59
60 instance Data Bool where
61 toConstr False = falseConstr
62 toConstr True = trueConstr
63 gunfold k z c = case constrIndex c of
64 1 -> z False
65 2 -> z True
66 _ -> error "gunfold"
67 dataTypeOf _ = boolDataType
68
69
70 ------------------------------------------------------------------------------
71
72
73 charType = mkStringType "Prelude.Char"
74
75 instance Data Char where
76 toConstr x = mkStringConstr charType [x]
77 gunfold k z c = case constrRep c of
78 (StringConstr [x]) -> z x
79 _ -> error "gunfold"
80 dataTypeOf _ = charType
81
82
83 ------------------------------------------------------------------------------
84
85
86 floatType = mkFloatType "Prelude.Float"
87
88 instance Data Float where
89 toConstr x = mkFloatConstr floatType (realToFrac x)
90 gunfold k z c = case constrRep c of
91 (FloatConstr x) -> z (realToFrac x)
92 _ -> error "gunfold"
93 dataTypeOf _ = floatType
94
95
96 ------------------------------------------------------------------------------
97
98
99 doubleType = mkFloatType "Prelude.Double"
100
101 instance Data Double where
102 toConstr = mkFloatConstr floatType
103 gunfold k z c = case constrRep c of
104 (FloatConstr x) -> z x
105 _ -> error "gunfold"
106 dataTypeOf _ = doubleType
107
108
109 ------------------------------------------------------------------------------
110
111
112 intType = mkIntType "Prelude.Int"
113
114 instance Data Int where
115 toConstr x = mkIntConstr intType (fromIntegral x)
116 gunfold k z c = case constrRep c of
117 (IntConstr x) -> z (fromIntegral x)
118 _ -> error "gunfold"
119 dataTypeOf _ = intType
120
121
122 ------------------------------------------------------------------------------
123
124
125 integerType = mkIntType "Prelude.Integer"
126
127 instance Data Integer where
128 toConstr = mkIntConstr integerType
129 gunfold k z c = case constrRep c of
130 (IntConstr x) -> z x
131 _ -> error "gunfold"
132 dataTypeOf _ = integerType
133
134
135 ------------------------------------------------------------------------------
136
137
138 int8Type = mkIntType "Data.Int.Int8"
139
140 instance Data Int8 where
141 toConstr x = mkIntConstr int8Type (fromIntegral x)
142 gunfold k z c = case constrRep c of
143 (IntConstr x) -> z (fromIntegral x)
144 _ -> error "gunfold"
145 dataTypeOf _ = int8Type
146
147
148 ------------------------------------------------------------------------------
149
150
151 int16Type = mkIntType "Data.Int.Int16"
152
153 instance Data Int16 where
154 toConstr x = mkIntConstr int16Type (fromIntegral x)
155 gunfold k z c = case constrRep c of
156 (IntConstr x) -> z (fromIntegral x)
157 _ -> error "gunfold"
158 dataTypeOf _ = int16Type
159
160
161 ------------------------------------------------------------------------------
162
163
164 int32Type = mkIntType "Data.Int.Int32"
165
166 instance Data Int32 where
167 toConstr x = mkIntConstr int32Type (fromIntegral x)
168 gunfold k z c = case constrRep c of
169 (IntConstr x) -> z (fromIntegral x)
170 _ -> error "gunfold"
171 dataTypeOf _ = int32Type
172
173
174 ------------------------------------------------------------------------------
175
176
177 int64Type = mkIntType "Data.Int.Int64"
178
179 instance Data Int64 where
180 toConstr x = mkIntConstr int64Type (fromIntegral x)
181 gunfold k z c = case constrRep c of
182 (IntConstr x) -> z (fromIntegral x)
183 _ -> error "gunfold"
184 dataTypeOf _ = int64Type
185
186
187 ------------------------------------------------------------------------------
188
189
190 wordType = mkIntType "Data.Word.Word"
191
192 instance Data Word where
193 toConstr x = mkIntConstr wordType (fromIntegral x)
194 gunfold k z c = case constrRep c of
195 (IntConstr x) -> z (fromIntegral x)
196 _ -> error "gunfold"
197 dataTypeOf _ = wordType
198
199
200 ------------------------------------------------------------------------------
201
202
203 word8Type = mkIntType "Data.Word.Word8"
204
205 instance Data Word8 where
206 toConstr x = mkIntConstr word8Type (fromIntegral x)
207 gunfold k z c = case constrRep c of
208 (IntConstr x) -> z (fromIntegral x)
209 _ -> error "gunfold"
210 dataTypeOf _ = word8Type
211
212
213 ------------------------------------------------------------------------------
214
215
216 word16Type = mkIntType "Data.Word.Word16"
217
218 instance Data Word16 where
219 toConstr x = mkIntConstr word16Type (fromIntegral x)
220 gunfold k z c = case constrRep c of
221 (IntConstr x) -> z (fromIntegral x)
222 _ -> error "gunfold"
223 dataTypeOf _ = word16Type
224
225
226 ------------------------------------------------------------------------------
227
228
229 word32Type = mkIntType "Data.Word.Word32"
230
231 instance Data Word32 where
232 toConstr x = mkIntConstr word32Type (fromIntegral x)
233 gunfold k z c = case constrRep c of
234 (IntConstr x) -> z (fromIntegral x)
235 _ -> error "gunfold"
236 dataTypeOf _ = word32Type
237
238
239 ------------------------------------------------------------------------------
240
241
242 word64Type = mkIntType "Data.Word.Word64"
243
244 instance Data Word64 where
245 toConstr x = mkIntConstr word64Type (fromIntegral x)
246 gunfold k z c = case constrRep c of
247 (IntConstr x) -> z (fromIntegral x)
248 _ -> error "gunfold"
249 dataTypeOf _ = word64Type
250
251
252 ------------------------------------------------------------------------------
253
254
255 ratioConstr = mkConstr ratioDataType ":%" [] Infix
256 ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
257
258 instance (Data a, Integral a) => Data (Ratio a) where
259 toConstr _ = ratioConstr
260 gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
261 gunfold _ _ _ = error "gunfold"
262 dataTypeOf _ = ratioDataType
263
264
265 ------------------------------------------------------------------------------
266
267
268 nilConstr = mkConstr listDataType "[]" [] Prefix
269 consConstr = mkConstr listDataType "(:)" [] Infix
270 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
271
272 instance Data a => Data [a] where
273 gfoldl f z [] = z []
274 gfoldl f z (x:xs) = z (:) `f` x `f` xs
275 toConstr [] = nilConstr
276 toConstr (_:_) = consConstr
277 gunfold k z c = case constrIndex c of
278 1 -> z []
279 2 -> k (k (z (:)))
280 _ -> error "gunfold"
281 dataTypeOf _ = listDataType
282 dataCast1 f = gcast1 f
283
284 --
285 -- The gmaps are given as an illustration.
286 -- This shows that the gmaps for lists are different from list maps.
287 --
288 gmapT f [] = []
289 gmapT f (x:xs) = (f x:f xs)
290 gmapQ f [] = []
291 gmapQ f (x:xs) = [f x,f xs]
292 gmapM f [] = return []
293 gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
294
295
296 ------------------------------------------------------------------------------
297
298
299 nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
300 justConstr = mkConstr maybeDataType "Just" [] Prefix
301 maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
302
303 instance Data a => Data (Maybe a) where
304 gfoldl f z Nothing = z Nothing
305 gfoldl f z (Just x) = z Just `f` x
306 toConstr Nothing = nothingConstr
307 toConstr (Just _) = justConstr
308 gunfold k z c = case constrIndex c of
309 1 -> z Nothing
310 2 -> k (z Just)
311 _ -> error "gunfold"
312 dataTypeOf _ = maybeDataType
313 dataCast1 f = gcast1 f
314
315
316 ------------------------------------------------------------------------------
317
318
319 ltConstr = mkConstr orderingDataType "LT" [] Prefix
320 eqConstr = mkConstr orderingDataType "EQ" [] Prefix
321 gtConstr = mkConstr orderingDataType "GT" [] Prefix
322 orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
323
324 instance Data Ordering where
325 gfoldl f z LT = z LT
326 gfoldl f z EQ = z EQ
327 gfoldl f z GT = z GT
328 toConstr LT = ltConstr
329 toConstr EQ = eqConstr
330 toConstr GT = gtConstr
331 gunfold k z c = case constrIndex c of
332 1 -> z LT
333 2 -> z EQ
334 3 -> z GT
335 _ -> error "gunfold"
336 dataTypeOf _ = orderingDataType
337
338
339 ------------------------------------------------------------------------------
340
341
342 leftConstr = mkConstr eitherDataType "Left" [] Prefix
343 rightConstr = mkConstr eitherDataType "Right" [] Prefix
344 eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
345
346 instance (Data a, Data b) => Data (Either a b) where
347 gfoldl f z (Left a) = z Left `f` a
348 gfoldl f z (Right a) = z Right `f` a
349 toConstr (Left _) = leftConstr
350 toConstr (Right _) = rightConstr
351 gunfold k z c = case constrIndex c of
352 1 -> k (z Left)
353 2 -> k (z Right)
354 _ -> error "gunfold"
355 dataTypeOf _ = eitherDataType
356 dataCast2 f = gcast2 f
357
358
359 ------------------------------------------------------------------------------
360
361
362 --
363 -- A last resort for functions
364 --
365
366 instance (Data a, Data b) => Data (a -> b) where
367 toConstr _ = error "toConstr"
368 gunfold _ _ = error "gunfold"
369 dataTypeOf _ = mkNorepType "Prelude.(->)"
370 dataCast2 f = gcast2 f
371
372
373 ------------------------------------------------------------------------------
374
375
376 tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
377 tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
378
379 instance Data () where
380 toConstr () = tuple0Constr
381 gunfold k z c | constrIndex c == 1 = z ()
382 gunfold _ _ _ = error "gunfold"
383 dataTypeOf _ = tuple0DataType
384
385
386 ------------------------------------------------------------------------------
387
388
389 tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
390 tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
391
392 instance (Data a, Data b) => Data (a,b) where
393 gfoldl f z (a,b) = z (,) `f` a `f` b
394 toConstr (a,b) = tuple2Constr
395 gunfold k z c | constrIndex c == 1 = k (k (z (,)))
396 gunfold _ _ _ = error "gunfold"
397 dataTypeOf _ = tuple2DataType
398 dataCast2 f = gcast2 f
399
400
401 ------------------------------------------------------------------------------
402
403
404 tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
405 tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr]
406
407 instance (Data a, Data b, Data c) => Data (a,b,c) where
408 gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
409 toConstr (a,b,c) = tuple3Constr
410 gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
411 gunfold _ _ _ = error "gunfold"
412 dataTypeOf _ = tuple3DataType
413
414
415 ------------------------------------------------------------------------------
416
417
418 tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
419 tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
420
421 instance (Data a, Data b, Data c, Data d)
422 => Data (a,b,c,d) where
423 gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
424 toConstr (a,b,c,d) = tuple4Constr
425 gunfold k z c = case constrIndex c of
426 1 -> k (k (k (k (z (,,,)))))
427 _ -> error "gunfold"
428 dataTypeOf _ = tuple4DataType
429
430
431 ------------------------------------------------------------------------------
432
433
434 tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
435 tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
436
437 instance (Data a, Data b, Data c, Data d, Data e)
438 => Data (a,b,c,d,e) where
439 gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
440 toConstr (a,b,c,d,e) = tuple5Constr
441 gunfold k z c = case constrIndex c of
442 1 -> k (k (k (k (k (z (,,,,))))))
443 _ -> error "gunfold"
444 dataTypeOf _ = tuple5DataType
445
446
447 ------------------------------------------------------------------------------
448
449
450 tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
451 tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
452
453 instance (Data a, Data b, Data c, Data d, Data e, Data f)
454 => Data (a,b,c,d,e,f) where
455 gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
456 toConstr (a,b,c,d,e,f) = tuple6Constr
457 gunfold k z c = case constrIndex c of
458 1 -> k (k (k (k (k (k (z (,,,,,)))))))
459 _ -> error "gunfold"
460 dataTypeOf _ = tuple6DataType
461
462
463 ------------------------------------------------------------------------------
464
465
466 tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
467 tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
468
469 instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
470 => Data (a,b,c,d,e,f,g) where
471 gfoldl f z (a,b,c,d,e,f',g) =
472 z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
473 toConstr (a,b,c,d,e,f,g) = tuple7Constr
474 gunfold k z c = case constrIndex c of
475 1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
476 _ -> error "gunfold"
477 dataTypeOf _ = tuple7DataType
478
479
480 ------------------------------------------------------------------------------
481
482
483 instance Data TypeRep where
484 toConstr _ = error "toConstr"
485 gunfold _ _ = error "gunfold"
486 dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep"
487
488
489 ------------------------------------------------------------------------------
490
491
492 instance Data TyCon where
493 toConstr _ = error "toConstr"
494 gunfold _ _ = error "gunfold"
495 dataTypeOf _ = mkNorepType "Data.Typeable.TyCon"
496
497
498 ------------------------------------------------------------------------------
499
500
501 INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType")
502
503 instance Data DataType where
504 toConstr _ = error "toConstr"
505 gunfold _ _ = error "gunfold"
506 dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType"
507
508
509 ------------------------------------------------------------------------------
510
511
512 instance Typeable a => Data (IO a) where
513 toConstr _ = error "toConstr"
514 gunfold _ _ = error "gunfold"
515 dataTypeOf _ = mkNorepType "GHC.IOBase.IO"
516
517
518 ------------------------------------------------------------------------------
519
520
521 instance Data Handle where
522 toConstr _ = error "toConstr"
523 gunfold _ _ = error "gunfold"
524 dataTypeOf _ = mkNorepType "GHC.IOBase.Handle"
525
526
527 ------------------------------------------------------------------------------
528
529
530 instance Typeable a => Data (Ptr a) where
531 toConstr _ = error "toConstr"
532 gunfold _ _ = error "gunfold"
533 dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"
534
535
536 ------------------------------------------------------------------------------
537
538
539 instance Typeable a => Data (StablePtr a) where
540 toConstr _ = error "toConstr"
541 gunfold _ _ = error "gunfold"
542 dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr"
543
544
545 ------------------------------------------------------------------------------
546
547
548 instance Typeable a => Data (IORef a) where
549 toConstr _ = error "toConstr"
550 gunfold _ _ = error "gunfold"
551 dataTypeOf _ = mkNorepType "GHC.IOBase.IORef"
552
553
554 ------------------------------------------------------------------------------
555
556
557 instance Typeable a => Data (ForeignPtr a) where
558 toConstr _ = error "toConstr"
559 gunfold _ _ = error "gunfold"
560 dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr"
561
562
563 ------------------------------------------------------------------------------
564
565
566 instance (Typeable s, Typeable a) => Data (ST s a) where
567 toConstr _ = error "toConstr"
568 gunfold _ _ = error "gunfold"
569 dataTypeOf _ = mkNorepType "GHC.ST.ST"
570
571
572 ------------------------------------------------------------------------------
573
574
575 instance Data ThreadId where
576 toConstr _ = error "toConstr"
577 gunfold _ _ = error "gunfold"
578 dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId"
579
580
581 ------------------------------------------------------------------------------
582
583
584 instance Typeable a => Data (TVar a) where
585 toConstr _ = error "toConstr"
586 gunfold _ _ = error "gunfold"
587 dataTypeOf _ = mkNorepType "GHC.Conc.TVar"
588
589
590 ------------------------------------------------------------------------------
591
592
593 instance Typeable a => Data (MVar a) where
594 toConstr _ = error "toConstr"
595 gunfold _ _ = error "gunfold"
596 dataTypeOf _ = mkNorepType "GHC.Conc.MVar"
597
598
599 ------------------------------------------------------------------------------
600
601
602 instance Typeable a => Data (STM a) where
603 toConstr _ = error "toConstr"
604 gunfold _ _ = error "gunfold"
605 dataTypeOf _ = mkNorepType "GHC.Conc.STM"
606
607
608 ------------------------------------------------------------------------------
609 -- The Data instance for Array preserves data abstraction at the cost of inefficiency.
610 -- We omit reflection services for the sake of data abstraction.
611 instance (Typeable a, Data b, Ix a) => Data (Array a b)
612 where
613 gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
614 toConstr _ = error "toConstr"
615 gunfold _ _ = error "gunfold"
616 dataTypeOf _ = mkNorepType "Data.Array.Array"
617