Clarify the wording of the 'insert' haddock; fixes #7421
[packages/base.git] / Data / Data.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
3
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : Data.Data
7 -- Copyright : (c) The University of Glasgow, CWI 2001--2004
8 -- License : BSD-style (see the file libraries/base/LICENSE)
9 --
10 -- Maintainer : libraries@haskell.org
11 -- Stability : experimental
12 -- Portability : non-portable (local universal quantification)
13 --
14 -- \"Scrap your boilerplate\" --- Generic programming in Haskell.
15 -- See <http://www.cs.vu.nl/boilerplate/>. This module provides
16 -- the 'Data' class with its primitives for generic programming, along
17 -- with instances for many datatypes. It corresponds to a merge between
18 -- the previous "Data.Generics.Basics" and almost all of
19 -- "Data.Generics.Instances". The instances that are not present
20 -- in this module were moved to the @Data.Generics.Instances@ module
21 -- in the @syb@ package.
22 --
23 -- For more information, please visit the new
24 -- SYB wiki: <http://www.cs.uu.nl/wiki/bin/view/GenericProgramming/SYB>.
25 --
26 -----------------------------------------------------------------------------
27
28 module Data.Data (
29
30 -- * Module Data.Typeable re-exported for convenience
31 module Data.Typeable,
32
33 -- * The Data class for processing constructor applications
34 Data(
35 gfoldl,
36 gunfold,
37 toConstr,
38 dataTypeOf,
39 dataCast1, -- mediate types and unary type constructors
40 dataCast2, -- mediate types and binary type constructors
41 -- Generic maps defined in terms of gfoldl
42 gmapT,
43 gmapQ,
44 gmapQl,
45 gmapQr,
46 gmapQi,
47 gmapM,
48 gmapMp,
49 gmapMo
50 ),
51
52 -- * Datatype representations
53 DataType, -- abstract
54 -- ** Constructors
55 mkDataType,
56 mkIntType,
57 mkFloatType,
58 mkCharType,
59 mkNoRepType,
60 -- ** Observers
61 dataTypeName,
62 DataRep(..),
63 dataTypeRep,
64 -- ** Convenience functions
65 repConstr,
66 isAlgType,
67 dataTypeConstrs,
68 indexConstr,
69 maxConstrIndex,
70 isNorepType,
71
72 -- * Data constructor representations
73 Constr, -- abstract
74 ConIndex, -- alias for Int, start at 1
75 Fixity(..),
76 -- ** Constructors
77 mkConstr,
78 mkIntegralConstr,
79 mkRealConstr,
80 mkCharConstr,
81 -- ** Observers
82 constrType,
83 ConstrRep(..),
84 constrRep,
85 constrFields,
86 constrFixity,
87 -- ** Convenience function: algebraic data types
88 constrIndex,
89 -- ** From strings to constructors and vice versa: all data types
90 showConstr,
91 readConstr,
92
93 -- * Convenience functions: take type constructors apart
94 tyconUQname,
95 tyconModule,
96
97 -- * Generic operations defined in terms of 'gunfold'
98 fromConstr,
99 fromConstrB,
100 fromConstrM
101
102 ) where
103
104
105 ------------------------------------------------------------------------------
106
107 import Prelude -- necessary to get dependencies right
108
109 import Data.Typeable
110 import Data.Maybe
111 import Control.Monad
112
113 -- Imports for the instances
114 import Data.Int -- So we can give Data instance for Int8, ...
115 import Data.Word -- So we can give Data instance for Word8, ...
116 #ifdef __GLASGOW_HASKELL__
117 import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
118 --import GHC.IOBase -- So we can give Data instance for IO, Handle
119 import GHC.Ptr -- So we can give Data instance for Ptr
120 import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr
121 --import GHC.Stable -- So we can give Data instance for StablePtr
122 --import GHC.ST -- So we can give Data instance for ST
123 --import GHC.Conc -- So we can give Data instance for MVar & Co.
124 import GHC.Arr -- So we can give Data instance for Array
125 #else
126 # ifdef __HUGS__
127 import Hugs.Prelude( Ratio(..) )
128 # endif
129 import Foreign.Ptr
130 import Foreign.ForeignPtr
131 import Data.Array
132 #endif
133
134 #include "Typeable.h"
135
136
137
138 ------------------------------------------------------------------------------
139 --
140 -- The Data class
141 --
142 ------------------------------------------------------------------------------
143
144 {- |
145 The 'Data' class comprehends a fundamental primitive 'gfoldl' for
146 folding over constructor applications, say terms. This primitive can
147 be instantiated in several ways to map over the immediate subterms
148 of a term; see the @gmap@ combinators later in this class. Indeed, a
149 generic programmer does not necessarily need to use the ingenious gfoldl
150 primitive but rather the intuitive @gmap@ combinators. The 'gfoldl'
151 primitive is completed by means to query top-level constructors, to
152 turn constructor representations into proper terms, and to list all
153 possible datatype constructors. This completion allows us to serve
154 generic programming scenarios like read, show, equality, term generation.
155
156 The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
157 default definitions in terms of 'gfoldl', leaving open the opportunity
158 to provide datatype-specific definitions.
159 (The inclusion of the @gmap@ combinators as members of class 'Data'
160 allows the programmer or the compiler to derive specialised, and maybe
161 more efficient code per datatype. /Note/: 'gfoldl' is more higher-order
162 than the @gmap@ combinators. This is subject to ongoing benchmarking
163 experiments. It might turn out that the @gmap@ combinators will be
164 moved out of the class 'Data'.)
165
166 Conceptually, the definition of the @gmap@ combinators in terms of the
167 primitive 'gfoldl' requires the identification of the 'gfoldl' function
168 arguments. Technically, we also need to identify the type constructor
169 @c@ for the construction of the result type from the folded term type.
170
171 In the definition of @gmapQ@/x/ combinators, we use phantom type
172 constructors for the @c@ in the type of 'gfoldl' because the result type
173 of a query does not involve the (polymorphic) type of the term argument.
174 In the definition of 'gmapQl' we simply use the plain constant type
175 constructor because 'gfoldl' is left-associative anyway and so it is
176 readily suited to fold a left-associative binary operation over the
177 immediate subterms. In the definition of gmapQr, extra effort is
178 needed. We use a higher-order accumulation trick to mediate between
179 left-associative constructor application vs. right-associative binary
180 operation (e.g., @(:)@). When the query is meant to compute a value
181 of type @r@, then the result type withing generic folding is @r -> r@.
182 So the result of folding is a function to which we finally pass the
183 right unit.
184
185 With the @-XDeriveDataTypeable@ option, GHC can generate instances of the
186 'Data' class automatically. For example, given the declaration
187
188 > data T a b = C1 a b | C2 deriving (Typeable, Data)
189
190 GHC will generate an instance that is equivalent to
191
192 > instance (Data a, Data b) => Data (T a b) where
193 > gfoldl k z (C1 a b) = z C1 `k` a `k` b
194 > gfoldl k z C2 = z C2
195 >
196 > gunfold k z c = case constrIndex c of
197 > 1 -> k (k (z C1))
198 > 2 -> z C2
199 >
200 > toConstr (C1 _ _) = con_C1
201 > toConstr C2 = con_C2
202 >
203 > dataTypeOf _ = ty_T
204 >
205 > con_C1 = mkConstr ty_T "C1" [] Prefix
206 > con_C2 = mkConstr ty_T "C2" [] Prefix
207 > ty_T = mkDataType "Module.T" [con_C1, con_C2]
208
209 This is suitable for datatypes that are exported transparently.
210
211 -}
212
213 class Typeable a => Data a where
214
215 -- | Left-associative fold operation for constructor applications.
216 --
217 -- The type of 'gfoldl' is a headache, but operationally it is a simple
218 -- generalisation of a list fold.
219 --
220 -- The default definition for 'gfoldl' is @'const' 'id'@, which is
221 -- suitable for abstract datatypes with no substructures.
222 gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
223 -- ^ defines how nonempty constructor applications are
224 -- folded. It takes the folded tail of the constructor
225 -- application and its head, i.e., an immediate subterm,
226 -- and combines them in some way.
227 -> (forall g. g -> c g)
228 -- ^ defines how the empty constructor application is
229 -- folded, like the neutral \/ start element for list
230 -- folding.
231 -> a
232 -- ^ structure to be folded.
233 -> c a
234 -- ^ result, with a type defined in terms of @a@, but
235 -- variability is achieved by means of type constructor
236 -- @c@ for the construction of the actual result type.
237
238 -- See the 'Data' instances in this file for an illustration of 'gfoldl'.
239
240 gfoldl _ z = z
241
242 -- | Unfolding constructor applications
243 gunfold :: (forall b r. Data b => c (b -> r) -> c r)
244 -> (forall r. r -> c r)
245 -> Constr
246 -> c a
247
248 -- | Obtaining the constructor from a given datum.
249 -- For proper terms, this is meant to be the top-level constructor.
250 -- Primitive datatypes are here viewed as potentially infinite sets of
251 -- values (i.e., constructors).
252 toConstr :: a -> Constr
253
254
255 -- | The outer type constructor of the type
256 dataTypeOf :: a -> DataType
257
258
259
260 ------------------------------------------------------------------------------
261 --
262 -- Mediate types and type constructors
263 --
264 ------------------------------------------------------------------------------
265
266 -- | Mediate types and unary type constructors.
267 -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined
268 -- as 'gcast1'.
269 --
270 -- The default definition is @'const' 'Nothing'@, which is appropriate
271 -- for non-unary type constructors.
272 dataCast1 :: Typeable1 t
273 => (forall d. Data d => c (t d))
274 -> Maybe (c a)
275 dataCast1 _ = Nothing
276
277 -- | Mediate types and binary type constructors.
278 -- In 'Data' instances of the form @T a b@, 'dataCast2' should be
279 -- defined as 'gcast2'.
280 --
281 -- The default definition is @'const' 'Nothing'@, which is appropriate
282 -- for non-binary type constructors.
283 dataCast2 :: Typeable2 t
284 => (forall d e. (Data d, Data e) => c (t d e))
285 -> Maybe (c a)
286 dataCast2 _ = Nothing
287
288
289
290 ------------------------------------------------------------------------------
291 --
292 -- Typical generic maps defined in terms of gfoldl
293 --
294 ------------------------------------------------------------------------------
295
296
297 -- | A generic transformation that maps over the immediate subterms
298 --
299 -- The default definition instantiates the type constructor @c@ in the
300 -- type of 'gfoldl' to an identity datatype constructor, using the
301 -- isomorphism pair as injection and projection.
302 gmapT :: (forall b. Data b => b -> b) -> a -> a
303
304 -- Use an identity datatype constructor ID (see below)
305 -- to instantiate the type constructor c in the type of gfoldl,
306 -- and perform injections ID and projections unID accordingly.
307 --
308 gmapT f x0 = unID (gfoldl k ID x0)
309 where
310 k :: Data d => ID (d->b) -> d -> ID b
311 k (ID c) x = ID (c (f x))
312
313
314 -- | A generic query with a left-associative binary operator
315 gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
316 gmapQl o r f = unCONST . gfoldl k z
317 where
318 k :: Data d => CONST r (d->b) -> d -> CONST r b
319 k c x = CONST $ (unCONST c) `o` f x
320 z :: g -> CONST r g
321 z _ = CONST r
322
323 -- | A generic query with a right-associative binary operator
324 gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
325 gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
326 where
327 k :: Data d => Qr r (d->b) -> d -> Qr r b
328 k (Qr c) x = Qr (\r -> c (f x `o` r))
329
330
331 -- | A generic query that processes the immediate subterms and returns a list
332 -- of results. The list is given in the same order as originally specified
333 -- in the declaratoin of the data constructors.
334 gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
335 gmapQ f = gmapQr (:) [] f
336
337
338 -- | A generic query that processes one child by index (zero-based)
339 gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> a -> u
340 gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
341 where
342 k :: Data d => Qi u (d -> b) -> d -> Qi u b
343 k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
344 z :: g -> Qi q g
345 z _ = Qi 0 Nothing
346
347
348 -- | A generic monadic transformation that maps over the immediate subterms
349 --
350 -- The default definition instantiates the type constructor @c@ in
351 -- the type of 'gfoldl' to the monad datatype constructor, defining
352 -- injection and projection using 'return' and '>>='.
353 gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a
354
355 -- Use immediately the monad datatype constructor
356 -- to instantiate the type constructor c in the type of gfoldl,
357 -- so injection and projection is done by return and >>=.
358 --
359 gmapM f = gfoldl k return
360 where
361 k :: Data d => m (d -> b) -> d -> m b
362 k c x = do c' <- c
363 x' <- f x
364 return (c' x')
365
366
367 -- | Transformation of at least one immediate subterm does not fail
368 gmapMp :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
369
370 {-
371
372 The type constructor that we use here simply keeps track of the fact
373 if we already succeeded for an immediate subterm; see Mp below. To
374 this end, we couple the monadic computation with a Boolean.
375
376 -}
377
378 gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
379 if b then return x' else mzero
380 where
381 z :: g -> Mp m g
382 z g = Mp (return (g,False))
383 k :: Data d => Mp m (d -> b) -> d -> Mp m b
384 k (Mp c) y
385 = Mp ( c >>= \(h, b) ->
386 (f y >>= \y' -> return (h y', True))
387 `mplus` return (h y, b)
388 )
389
390 -- | Transformation of one immediate subterm with success
391 gmapMo :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
392
393 {-
394
395 We use the same pairing trick as for gmapMp,
396 i.e., we use an extra Bool component to keep track of the
397 fact whether an immediate subterm was processed successfully.
398 However, we cut of mapping over subterms once a first subterm
399 was transformed successfully.
400
401 -}
402
403 gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
404 if b then return x' else mzero
405 where
406 z :: g -> Mp m g
407 z g = Mp (return (g,False))
408 k :: Data d => Mp m (d -> b) -> d -> Mp m b
409 k (Mp c) y
410 = Mp ( c >>= \(h,b) -> if b
411 then return (h y, b)
412 else (f y >>= \y' -> return (h y',True))
413 `mplus` return (h y, b)
414 )
415
416
417 -- | The identity type constructor needed for the definition of gmapT
418 newtype ID x = ID { unID :: x }
419
420
421 -- | The constant type constructor needed for the definition of gmapQl
422 newtype CONST c a = CONST { unCONST :: c }
423
424
425 -- | Type constructor for adding counters to queries
426 data Qi q a = Qi Int (Maybe q)
427
428
429 -- | The type constructor used in definition of gmapQr
430 newtype Qr r a = Qr { unQr :: r -> r }
431
432
433 -- | The type constructor used in definition of gmapMp
434 newtype Mp m x = Mp { unMp :: m (x, Bool) }
435
436
437
438 ------------------------------------------------------------------------------
439 --
440 -- Generic unfolding
441 --
442 ------------------------------------------------------------------------------
443
444
445 -- | Build a term skeleton
446 fromConstr :: Data a => Constr -> a
447 fromConstr = fromConstrB (error "Data.Data.fromConstr")
448
449
450 -- | Build a term and use a generic function for subterms
451 fromConstrB :: Data a
452 => (forall d. Data d => d)
453 -> Constr
454 -> a
455 fromConstrB f = unID . gunfold k z
456 where
457 k :: forall b r. Data b => ID (b -> r) -> ID r
458 k c = ID (unID c f)
459
460 z :: forall r. r -> ID r
461 z = ID
462
463
464 -- | Monadic variation on 'fromConstrB'
465 fromConstrM :: forall m a. (Monad m, Data a)
466 => (forall d. Data d => m d)
467 -> Constr
468 -> m a
469 fromConstrM f = gunfold k z
470 where
471 k :: forall b r. Data b => m (b -> r) -> m r
472 k c = do { c' <- c; b <- f; return (c' b) }
473
474 z :: forall r. r -> m r
475 z = return
476
477
478
479 ------------------------------------------------------------------------------
480 --
481 -- Datatype and constructor representations
482 --
483 ------------------------------------------------------------------------------
484
485
486 --
487 -- | Representation of datatypes.
488 -- A package of constructor representations with names of type and module.
489 --
490 data DataType = DataType
491 { tycon :: String
492 , datarep :: DataRep
493 }
494
495 deriving Show
496
497 -- | Representation of constructors. Note that equality on constructors
498 -- with different types may not work -- i.e. the constructors for 'False' and
499 -- 'Nothing' may compare equal.
500 data Constr = Constr
501 { conrep :: ConstrRep
502 , constring :: String
503 , confields :: [String] -- for AlgRep only
504 , confixity :: Fixity -- for AlgRep only
505 , datatype :: DataType
506 }
507
508 instance Show Constr where
509 show = constring
510
511
512 -- | Equality of constructors
513 instance Eq Constr where
514 c == c' = constrRep c == constrRep c'
515
516
517 -- | Public representation of datatypes
518 data DataRep = AlgRep [Constr]
519 | IntRep
520 | FloatRep
521 | CharRep
522 | NoRep
523
524 deriving (Eq,Show)
525 -- The list of constructors could be an array, a balanced tree, or others.
526
527
528 -- | Public representation of constructors
529 data ConstrRep = AlgConstr ConIndex
530 | IntConstr Integer
531 | FloatConstr Rational
532 | CharConstr Char
533
534 deriving (Eq,Show)
535
536
537 -- | Unique index for datatype constructors,
538 -- counting from 1 in the order they are given in the program text.
539 type ConIndex = Int
540
541
542 -- | Fixity of constructors
543 data Fixity = Prefix
544 | Infix -- Later: add associativity and precedence
545
546 deriving (Eq,Show)
547
548
549 ------------------------------------------------------------------------------
550 --
551 -- Observers for datatype representations
552 --
553 ------------------------------------------------------------------------------
554
555
556 -- | Gets the type constructor including the module
557 dataTypeName :: DataType -> String
558 dataTypeName = tycon
559
560
561
562 -- | Gets the public presentation of a datatype
563 dataTypeRep :: DataType -> DataRep
564 dataTypeRep = datarep
565
566
567 -- | Gets the datatype of a constructor
568 constrType :: Constr -> DataType
569 constrType = datatype
570
571
572 -- | Gets the public presentation of constructors
573 constrRep :: Constr -> ConstrRep
574 constrRep = conrep
575
576
577 -- | Look up a constructor by its representation
578 repConstr :: DataType -> ConstrRep -> Constr
579 repConstr dt cr =
580 case (dataTypeRep dt, cr) of
581 (AlgRep cs, AlgConstr i) -> cs !! (i-1)
582 (IntRep, IntConstr i) -> mkIntegralConstr dt i
583 (FloatRep, FloatConstr f) -> mkRealConstr dt f
584 (CharRep, CharConstr c) -> mkCharConstr dt c
585 _ -> error "Data.Data.repConstr"
586
587
588
589 ------------------------------------------------------------------------------
590 --
591 -- Representations of algebraic data types
592 --
593 ------------------------------------------------------------------------------
594
595
596 -- | Constructs an algebraic datatype
597 mkDataType :: String -> [Constr] -> DataType
598 mkDataType str cs = DataType
599 { tycon = str
600 , datarep = AlgRep cs
601 }
602
603
604 -- | Constructs a constructor
605 mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
606 mkConstr dt str fields fix =
607 Constr
608 { conrep = AlgConstr idx
609 , constring = str
610 , confields = fields
611 , confixity = fix
612 , datatype = dt
613 }
614 where
615 idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
616 showConstr c == str ]
617
618
619 -- | Gets the constructors of an algebraic datatype
620 dataTypeConstrs :: DataType -> [Constr]
621 dataTypeConstrs dt = case datarep dt of
622 (AlgRep cons) -> cons
623 _ -> error "Data.Data.dataTypeConstrs"
624
625
626 -- | Gets the field labels of a constructor. The list of labels
627 -- is returned in the same order as they were given in the original
628 -- constructor declaration.
629 constrFields :: Constr -> [String]
630 constrFields = confields
631
632
633 -- | Gets the fixity of a constructor
634 constrFixity :: Constr -> Fixity
635 constrFixity = confixity
636
637
638
639 ------------------------------------------------------------------------------
640 --
641 -- From strings to constr's and vice versa: all data types
642 --
643 ------------------------------------------------------------------------------
644
645
646 -- | Gets the string for a constructor
647 showConstr :: Constr -> String
648 showConstr = constring
649
650
651 -- | Lookup a constructor via a string
652 readConstr :: DataType -> String -> Maybe Constr
653 readConstr dt str =
654 case dataTypeRep dt of
655 AlgRep cons -> idx cons
656 IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
657 FloatRep -> mkReadCon ffloat
658 CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
659 NoRep -> Nothing
660 where
661
662 -- Read a value and build a constructor
663 mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
664 mkReadCon f = case (reads str) of
665 [(t,"")] -> Just (f t)
666 _ -> Nothing
667
668 -- Traverse list of algebraic datatype constructors
669 idx :: [Constr] -> Maybe Constr
670 idx cons = let fit = filter ((==) str . showConstr) cons
671 in if fit == []
672 then Nothing
673 else Just (head fit)
674
675 ffloat :: Double -> Constr
676 ffloat = mkPrimCon dt str . FloatConstr . toRational
677
678 ------------------------------------------------------------------------------
679 --
680 -- Convenience funtions: algebraic data types
681 --
682 ------------------------------------------------------------------------------
683
684
685 -- | Test for an algebraic type
686 isAlgType :: DataType -> Bool
687 isAlgType dt = case datarep dt of
688 (AlgRep _) -> True
689 _ -> False
690
691
692 -- | Gets the constructor for an index (algebraic datatypes only)
693 indexConstr :: DataType -> ConIndex -> Constr
694 indexConstr dt idx = case datarep dt of
695 (AlgRep cs) -> cs !! (idx-1)
696 _ -> error "Data.Data.indexConstr"
697
698
699 -- | Gets the index of a constructor (algebraic datatypes only)
700 constrIndex :: Constr -> ConIndex
701 constrIndex con = case constrRep con of
702 (AlgConstr idx) -> idx
703 _ -> error "Data.Data.constrIndex"
704
705
706 -- | Gets the maximum constructor index of an algebraic datatype
707 maxConstrIndex :: DataType -> ConIndex
708 maxConstrIndex dt = case dataTypeRep dt of
709 AlgRep cs -> length cs
710 _ -> error "Data.Data.maxConstrIndex"
711
712
713
714 ------------------------------------------------------------------------------
715 --
716 -- Representation of primitive types
717 --
718 ------------------------------------------------------------------------------
719
720
721 -- | Constructs the 'Int' type
722 mkIntType :: String -> DataType
723 mkIntType = mkPrimType IntRep
724
725
726 -- | Constructs the 'Float' type
727 mkFloatType :: String -> DataType
728 mkFloatType = mkPrimType FloatRep
729
730
731 -- | Constructs the 'Char' type
732 mkCharType :: String -> DataType
733 mkCharType = mkPrimType CharRep
734
735
736 -- | Helper for 'mkIntType', 'mkFloatType'
737 mkPrimType :: DataRep -> String -> DataType
738 mkPrimType dr str = DataType
739 { tycon = str
740 , datarep = dr
741 }
742
743
744 -- Makes a constructor for primitive types
745 mkPrimCon :: DataType -> String -> ConstrRep -> Constr
746 mkPrimCon dt str cr = Constr
747 { datatype = dt
748 , conrep = cr
749 , constring = str
750 , confields = error "Data.Data.confields"
751 , confixity = error "Data.Data.confixity"
752 }
753
754 mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr
755 mkIntegralConstr dt i = case datarep dt of
756 IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger i))
757 _ -> error "Data.Data.mkIntegralConstr"
758
759 mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr
760 mkRealConstr dt f = case datarep dt of
761 FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
762 _ -> error "Data.Data.mkRealConstr"
763
764 -- | Makes a constructor for 'Char'.
765 mkCharConstr :: DataType -> Char -> Constr
766 mkCharConstr dt c = case datarep dt of
767 CharRep -> mkPrimCon dt (show c) (CharConstr c)
768 _ -> error "Data.Data.mkCharConstr"
769
770
771 ------------------------------------------------------------------------------
772 --
773 -- Non-representations for non-presentable types
774 --
775 ------------------------------------------------------------------------------
776
777
778 -- | Constructs a non-representation for a non-presentable type
779 mkNoRepType :: String -> DataType
780 mkNoRepType str = DataType
781 { tycon = str
782 , datarep = NoRep
783 }
784
785 -- | Test for a non-representable type
786 isNorepType :: DataType -> Bool
787 isNorepType dt = case datarep dt of
788 NoRep -> True
789 _ -> False
790
791
792
793 ------------------------------------------------------------------------------
794 --
795 -- Convenience for qualified type constructors
796 --
797 ------------------------------------------------------------------------------
798
799
800 -- | Gets the unqualified type constructor:
801 -- drop *.*.*... before name
802 --
803 tyconUQname :: String -> String
804 tyconUQname x = let x' = dropWhile (not . (==) '.') x
805 in if x' == [] then x else tyconUQname (tail x')
806
807
808 -- | Gets the module of a type constructor:
809 -- take *.*.*... before name
810 tyconModule :: String -> String
811 tyconModule x = let (a,b) = break ((==) '.') x
812 in if b == ""
813 then b
814 else a ++ tyconModule' (tail b)
815 where
816 tyconModule' y = let y' = tyconModule y
817 in if y' == "" then "" else ('.':y')
818
819
820
821
822 ------------------------------------------------------------------------------
823 ------------------------------------------------------------------------------
824 --
825 -- Instances of the Data class for Prelude-like types.
826 -- We define top-level definitions for representations.
827 --
828 ------------------------------------------------------------------------------
829
830
831 falseConstr :: Constr
832 falseConstr = mkConstr boolDataType "False" [] Prefix
833 trueConstr :: Constr
834 trueConstr = mkConstr boolDataType "True" [] Prefix
835
836 boolDataType :: DataType
837 boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
838
839 instance Data Bool where
840 toConstr False = falseConstr
841 toConstr True = trueConstr
842 gunfold _ z c = case constrIndex c of
843 1 -> z False
844 2 -> z True
845 _ -> error "Data.Data.gunfold(Bool)"
846 dataTypeOf _ = boolDataType
847
848
849 ------------------------------------------------------------------------------
850
851 charType :: DataType
852 charType = mkCharType "Prelude.Char"
853
854 instance Data Char where
855 toConstr x = mkCharConstr charType x
856 gunfold _ z c = case constrRep c of
857 (CharConstr x) -> z x
858 _ -> error "Data.Data.gunfold(Char)"
859 dataTypeOf _ = charType
860
861
862 ------------------------------------------------------------------------------
863
864 floatType :: DataType
865 floatType = mkFloatType "Prelude.Float"
866
867 instance Data Float where
868 toConstr = mkRealConstr floatType
869 gunfold _ z c = case constrRep c of
870 (FloatConstr x) -> z (realToFrac x)
871 _ -> error "Data.Data.gunfold(Float)"
872 dataTypeOf _ = floatType
873
874
875 ------------------------------------------------------------------------------
876
877 doubleType :: DataType
878 doubleType = mkFloatType "Prelude.Double"
879
880 instance Data Double where
881 toConstr = mkRealConstr doubleType
882 gunfold _ z c = case constrRep c of
883 (FloatConstr x) -> z (realToFrac x)
884 _ -> error "Data.Data.gunfold(Double)"
885 dataTypeOf _ = doubleType
886
887
888 ------------------------------------------------------------------------------
889
890 intType :: DataType
891 intType = mkIntType "Prelude.Int"
892
893 instance Data Int where
894 toConstr x = mkIntegralConstr intType x
895 gunfold _ z c = case constrRep c of
896 (IntConstr x) -> z (fromIntegral x)
897 _ -> error "Data.Data.gunfold(Int)"
898 dataTypeOf _ = intType
899
900
901 ------------------------------------------------------------------------------
902
903 integerType :: DataType
904 integerType = mkIntType "Prelude.Integer"
905
906 instance Data Integer where
907 toConstr = mkIntegralConstr integerType
908 gunfold _ z c = case constrRep c of
909 (IntConstr x) -> z x
910 _ -> error "Data.Data.gunfold(Integer)"
911 dataTypeOf _ = integerType
912
913
914 ------------------------------------------------------------------------------
915
916 int8Type :: DataType
917 int8Type = mkIntType "Data.Int.Int8"
918
919 instance Data Int8 where
920 toConstr x = mkIntegralConstr int8Type x
921 gunfold _ z c = case constrRep c of
922 (IntConstr x) -> z (fromIntegral x)
923 _ -> error "Data.Data.gunfold(Int8)"
924 dataTypeOf _ = int8Type
925
926
927 ------------------------------------------------------------------------------
928
929 int16Type :: DataType
930 int16Type = mkIntType "Data.Int.Int16"
931
932 instance Data Int16 where
933 toConstr x = mkIntegralConstr int16Type x
934 gunfold _ z c = case constrRep c of
935 (IntConstr x) -> z (fromIntegral x)
936 _ -> error "Data.Data.gunfold(Int16)"
937 dataTypeOf _ = int16Type
938
939
940 ------------------------------------------------------------------------------
941
942 int32Type :: DataType
943 int32Type = mkIntType "Data.Int.Int32"
944
945 instance Data Int32 where
946 toConstr x = mkIntegralConstr int32Type x
947 gunfold _ z c = case constrRep c of
948 (IntConstr x) -> z (fromIntegral x)
949 _ -> error "Data.Data.gunfold(Int32)"
950 dataTypeOf _ = int32Type
951
952
953 ------------------------------------------------------------------------------
954
955 int64Type :: DataType
956 int64Type = mkIntType "Data.Int.Int64"
957
958 instance Data Int64 where
959 toConstr x = mkIntegralConstr int64Type x
960 gunfold _ z c = case constrRep c of
961 (IntConstr x) -> z (fromIntegral x)
962 _ -> error "Data.Data.gunfold(Int64)"
963 dataTypeOf _ = int64Type
964
965
966 ------------------------------------------------------------------------------
967
968 wordType :: DataType
969 wordType = mkIntType "Data.Word.Word"
970
971 instance Data Word where
972 toConstr x = mkIntegralConstr wordType x
973 gunfold _ z c = case constrRep c of
974 (IntConstr x) -> z (fromIntegral x)
975 _ -> error "Data.Data.gunfold(Word)"
976 dataTypeOf _ = wordType
977
978
979 ------------------------------------------------------------------------------
980
981 word8Type :: DataType
982 word8Type = mkIntType "Data.Word.Word8"
983
984 instance Data Word8 where
985 toConstr x = mkIntegralConstr word8Type x
986 gunfold _ z c = case constrRep c of
987 (IntConstr x) -> z (fromIntegral x)
988 _ -> error "Data.Data.gunfold(Word8)"
989 dataTypeOf _ = word8Type
990
991
992 ------------------------------------------------------------------------------
993
994 word16Type :: DataType
995 word16Type = mkIntType "Data.Word.Word16"
996
997 instance Data Word16 where
998 toConstr x = mkIntegralConstr word16Type x
999 gunfold _ z c = case constrRep c of
1000 (IntConstr x) -> z (fromIntegral x)
1001 _ -> error "Data.Data.gunfold(Word16)"
1002 dataTypeOf _ = word16Type
1003
1004
1005 ------------------------------------------------------------------------------
1006
1007 word32Type :: DataType
1008 word32Type = mkIntType "Data.Word.Word32"
1009
1010 instance Data Word32 where
1011 toConstr x = mkIntegralConstr word32Type x
1012 gunfold _ z c = case constrRep c of
1013 (IntConstr x) -> z (fromIntegral x)
1014 _ -> error "Data.Data.gunfold(Word32)"
1015 dataTypeOf _ = word32Type
1016
1017
1018 ------------------------------------------------------------------------------
1019
1020 word64Type :: DataType
1021 word64Type = mkIntType "Data.Word.Word64"
1022
1023 instance Data Word64 where
1024 toConstr x = mkIntegralConstr word64Type x
1025 gunfold _ z c = case constrRep c of
1026 (IntConstr x) -> z (fromIntegral x)
1027 _ -> error "Data.Data.gunfold(Word64)"
1028 dataTypeOf _ = word64Type
1029
1030
1031 ------------------------------------------------------------------------------
1032
1033 ratioConstr :: Constr
1034 ratioConstr = mkConstr ratioDataType ":%" [] Infix
1035
1036 ratioDataType :: DataType
1037 ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
1038
1039 instance (Data a, Integral a) => Data (Ratio a) where
1040 gfoldl k z (a :% b) = z (:%) `k` a `k` b
1041 toConstr _ = ratioConstr
1042 gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
1043 gunfold _ _ _ = error "Data.Data.gunfold(Ratio)"
1044 dataTypeOf _ = ratioDataType
1045
1046
1047 ------------------------------------------------------------------------------
1048
1049 nilConstr :: Constr
1050 nilConstr = mkConstr listDataType "[]" [] Prefix
1051 consConstr :: Constr
1052 consConstr = mkConstr listDataType "(:)" [] Infix
1053
1054 listDataType :: DataType
1055 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
1056
1057 instance Data a => Data [a] where
1058 gfoldl _ z [] = z []
1059 gfoldl f z (x:xs) = z (:) `f` x `f` xs
1060 toConstr [] = nilConstr
1061 toConstr (_:_) = consConstr
1062 gunfold k z c = case constrIndex c of
1063 1 -> z []
1064 2 -> k (k (z (:)))
1065 _ -> error "Data.Data.gunfold(List)"
1066 dataTypeOf _ = listDataType
1067 dataCast1 f = gcast1 f
1068
1069 --
1070 -- The gmaps are given as an illustration.
1071 -- This shows that the gmaps for lists are different from list maps.
1072 --
1073 gmapT _ [] = []
1074 gmapT f (x:xs) = (f x:f xs)
1075 gmapQ _ [] = []
1076 gmapQ f (x:xs) = [f x,f xs]
1077 gmapM _ [] = return []
1078 gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
1079
1080
1081 ------------------------------------------------------------------------------
1082
1083 nothingConstr :: Constr
1084 nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
1085 justConstr :: Constr
1086 justConstr = mkConstr maybeDataType "Just" [] Prefix
1087
1088 maybeDataType :: DataType
1089 maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
1090
1091 instance Data a => Data (Maybe a) where
1092 gfoldl _ z Nothing = z Nothing
1093 gfoldl f z (Just x) = z Just `f` x
1094 toConstr Nothing = nothingConstr
1095 toConstr (Just _) = justConstr
1096 gunfold k z c = case constrIndex c of
1097 1 -> z Nothing
1098 2 -> k (z Just)
1099 _ -> error "Data.Data.gunfold(Maybe)"
1100 dataTypeOf _ = maybeDataType
1101 dataCast1 f = gcast1 f
1102
1103
1104 ------------------------------------------------------------------------------
1105
1106 ltConstr :: Constr
1107 ltConstr = mkConstr orderingDataType "LT" [] Prefix
1108 eqConstr :: Constr
1109 eqConstr = mkConstr orderingDataType "EQ" [] Prefix
1110 gtConstr :: Constr
1111 gtConstr = mkConstr orderingDataType "GT" [] Prefix
1112
1113 orderingDataType :: DataType
1114 orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
1115
1116 instance Data Ordering where
1117 gfoldl _ z LT = z LT
1118 gfoldl _ z EQ = z EQ
1119 gfoldl _ z GT = z GT
1120 toConstr LT = ltConstr
1121 toConstr EQ = eqConstr
1122 toConstr GT = gtConstr
1123 gunfold _ z c = case constrIndex c of
1124 1 -> z LT
1125 2 -> z EQ
1126 3 -> z GT
1127 _ -> error "Data.Data.gunfold(Ordering)"
1128 dataTypeOf _ = orderingDataType
1129
1130
1131 ------------------------------------------------------------------------------
1132
1133 leftConstr :: Constr
1134 leftConstr = mkConstr eitherDataType "Left" [] Prefix
1135
1136 rightConstr :: Constr
1137 rightConstr = mkConstr eitherDataType "Right" [] Prefix
1138
1139 eitherDataType :: DataType
1140 eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
1141
1142 instance (Data a, Data b) => Data (Either a b) where
1143 gfoldl f z (Left a) = z Left `f` a
1144 gfoldl f z (Right a) = z Right `f` a
1145 toConstr (Left _) = leftConstr
1146 toConstr (Right _) = rightConstr
1147 gunfold k z c = case constrIndex c of
1148 1 -> k (z Left)
1149 2 -> k (z Right)
1150 _ -> error "Data.Data.gunfold(Either)"
1151 dataTypeOf _ = eitherDataType
1152 dataCast2 f = gcast2 f
1153
1154
1155 ------------------------------------------------------------------------------
1156
1157 tuple0Constr :: Constr
1158 tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
1159
1160 tuple0DataType :: DataType
1161 tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
1162
1163 instance Data () where
1164 toConstr () = tuple0Constr
1165 gunfold _ z c | constrIndex c == 1 = z ()
1166 gunfold _ _ _ = error "Data.Data.gunfold(unit)"
1167 dataTypeOf _ = tuple0DataType
1168
1169
1170 ------------------------------------------------------------------------------
1171
1172 tuple2Constr :: Constr
1173 tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
1174
1175 tuple2DataType :: DataType
1176 tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
1177
1178 instance (Data a, Data b) => Data (a,b) where
1179 gfoldl f z (a,b) = z (,) `f` a `f` b
1180 toConstr (_,_) = tuple2Constr
1181 gunfold k z c | constrIndex c == 1 = k (k (z (,)))
1182 gunfold _ _ _ = error "Data.Data.gunfold(tup2)"
1183 dataTypeOf _ = tuple2DataType
1184 dataCast2 f = gcast2 f
1185
1186
1187 ------------------------------------------------------------------------------
1188
1189 tuple3Constr :: Constr
1190 tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
1191
1192 tuple3DataType :: DataType
1193 tuple3DataType = mkDataType "Prelude.(,,)" [tuple3Constr]
1194
1195 instance (Data a, Data b, Data c) => Data (a,b,c) where
1196 gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
1197 toConstr (_,_,_) = tuple3Constr
1198 gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
1199 gunfold _ _ _ = error "Data.Data.gunfold(tup3)"
1200 dataTypeOf _ = tuple3DataType
1201
1202
1203 ------------------------------------------------------------------------------
1204
1205 tuple4Constr :: Constr
1206 tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
1207
1208 tuple4DataType :: DataType
1209 tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
1210
1211 instance (Data a, Data b, Data c, Data d)
1212 => Data (a,b,c,d) where
1213 gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
1214 toConstr (_,_,_,_) = tuple4Constr
1215 gunfold k z c = case constrIndex c of
1216 1 -> k (k (k (k (z (,,,)))))
1217 _ -> error "Data.Data.gunfold(tup4)"
1218 dataTypeOf _ = tuple4DataType
1219
1220
1221 ------------------------------------------------------------------------------
1222
1223 tuple5Constr :: Constr
1224 tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
1225
1226 tuple5DataType :: DataType
1227 tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
1228
1229 instance (Data a, Data b, Data c, Data d, Data e)
1230 => Data (a,b,c,d,e) where
1231 gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
1232 toConstr (_,_,_,_,_) = tuple5Constr
1233 gunfold k z c = case constrIndex c of
1234 1 -> k (k (k (k (k (z (,,,,))))))
1235 _ -> error "Data.Data.gunfold(tup5)"
1236 dataTypeOf _ = tuple5DataType
1237
1238
1239 ------------------------------------------------------------------------------
1240
1241 tuple6Constr :: Constr
1242 tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
1243
1244 tuple6DataType :: DataType
1245 tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
1246
1247 instance (Data a, Data b, Data c, Data d, Data e, Data f)
1248 => Data (a,b,c,d,e,f) where
1249 gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
1250 toConstr (_,_,_,_,_,_) = tuple6Constr
1251 gunfold k z c = case constrIndex c of
1252 1 -> k (k (k (k (k (k (z (,,,,,)))))))
1253 _ -> error "Data.Data.gunfold(tup6)"
1254 dataTypeOf _ = tuple6DataType
1255
1256
1257 ------------------------------------------------------------------------------
1258
1259 tuple7Constr :: Constr
1260 tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
1261
1262 tuple7DataType :: DataType
1263 tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
1264
1265 instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
1266 => Data (a,b,c,d,e,f,g) where
1267 gfoldl f z (a,b,c,d,e,f',g) =
1268 z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
1269 toConstr (_,_,_,_,_,_,_) = tuple7Constr
1270 gunfold k z c = case constrIndex c of
1271 1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
1272 _ -> error "Data.Data.gunfold(tup7)"
1273 dataTypeOf _ = tuple7DataType
1274
1275
1276 ------------------------------------------------------------------------------
1277
1278 instance (Data a, Typeable a) => Data (Ptr a) where
1279 toConstr _ = error "Data.Data.toConstr(Ptr)"
1280 gunfold _ _ = error "Data.Data.gunfold(Ptr)"
1281 dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"
1282 dataCast1 x = gcast1 x
1283
1284 ------------------------------------------------------------------------------
1285
1286 instance (Data a, Typeable a) => Data (ForeignPtr a) where
1287 toConstr _ = error "Data.Data.toConstr(ForeignPtr)"
1288 gunfold _ _ = error "Data.Data.gunfold(ForeignPtr)"
1289 dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"
1290 dataCast1 x = gcast1 x
1291
1292 ------------------------------------------------------------------------------
1293 -- The Data instance for Array preserves data abstraction at the cost of
1294 -- inefficiency. We omit reflection services for the sake of data abstraction.
1295 instance (Typeable a, Data a, Data b, Ix a) => Data (Array a b)
1296 where
1297 gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
1298 toConstr _ = error "Data.Data.toConstr(Array)"
1299 gunfold _ _ = error "Data.Data.gunfold(Array)"
1300 dataTypeOf _ = mkNoRepType "Data.Array.Array"
1301 dataCast2 x = gcast2 x