1 -----------------------------------------------------------------------------
4 -- Copyright : (c) The University of Glasgow, CWI 2001--2004
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (local universal quantification)
11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell.
12 -- See <http://www.cs.vu.nl/boilerplate/>. This module provides
13 -- the 'Data' class with its primitives for generic programming, along
14 -- with instances for many datatypes. It corresponds to a merge between
15 -- the previous "Data.Generics.Basics" and almost all of
16 -- "Data.Generics.Instances". The instances that are not present
17 -- in this module are available in "Data.Generics.Instances".
20 -----------------------------------------------------------------------------
24 -- * Module Data.Typeable re-exported for convenience
27 -- * The Data class for processing constructor applications
29 gfoldl, -- :: ... -> a -> c a
30 gunfold, -- :: ... -> Constr -> c a
31 toConstr, -- :: a -> Constr
32 dataTypeOf, -- :: a -> DataType
33 dataCast1, -- mediate types and unary type constructors
34 dataCast2, -- mediate types and binary type constructors
35 -- Generic maps defined in terms of gfoldl
46 -- * Datatype representations
47 DataType, -- abstract, instance of: Show
49 mkDataType, -- :: String -> [Constr] -> DataType
50 mkIntType, -- :: String -> DataType
51 mkFloatType, -- :: String -> DataType
52 mkStringType, -- :: String -> DataType
53 mkNorepType, -- :: String -> DataType
55 dataTypeName, -- :: DataType -> String
56 DataRep(..), -- instance of: Eq, Show
57 dataTypeRep, -- :: DataType -> DataRep
58 -- ** Convenience functions
59 repConstr, -- :: DataType -> ConstrRep -> Constr
60 isAlgType, -- :: DataType -> Bool
61 dataTypeConstrs,-- :: DataType -> [Constr]
62 indexConstr, -- :: DataType -> ConIndex -> Constr
63 maxConstrIndex, -- :: DataType -> ConIndex
64 isNorepType, -- :: DataType -> Bool
66 -- * Data constructor representations
67 Constr, -- abstract, instance of: Eq, Show
68 ConIndex, -- alias for Int, start at 1
69 Fixity(..), -- instance of: Eq, Show
71 mkConstr, -- :: DataType -> String -> Fixity -> Constr
72 mkIntConstr, -- :: DataType -> Integer -> Constr
73 mkFloatConstr, -- :: DataType -> Double -> Constr
74 mkStringConstr, -- :: DataType -> String -> Constr
76 constrType, -- :: Constr -> DataType
77 ConstrRep(..), -- instance of: Eq, Show
78 constrRep, -- :: Constr -> ConstrRep
79 constrFields, -- :: Constr -> [String]
80 constrFixity, -- :: Constr -> Fixity
81 -- ** Convenience function: algebraic data types
82 constrIndex, -- :: Constr -> ConIndex
83 -- ** From strings to constructors and vice versa: all data types
84 showConstr, -- :: Constr -> String
85 readConstr, -- :: DataType -> String -> Maybe Constr
87 -- * Convenience functions: take type constructors apart
88 tyconUQname, -- :: String -> String
89 tyconModule, -- :: String -> String
91 -- * Generic operations defined in terms of 'gunfold'
92 fromConstr, -- :: Constr -> a
93 fromConstrB, -- :: ... -> Constr -> a
94 fromConstrM -- :: Monad m => ... -> Constr -> m a
99 ------------------------------------------------------------------------------
101 import Prelude -- necessary to get dependencies right
107 -- Imports for the instances
109 import Data.Int -- So we can give Data instance for Int8, ...
110 import Data.Word -- So we can give Data instance for Word8, ...
111 #ifdef __GLASGOW_HASKELL__
112 import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
113 --import GHC.IOBase -- So we can give Data instance for IO, Handle
114 import GHC.Ptr -- So we can give Data instance for Ptr
115 import GHC.ForeignPtr -- So we can give Data instance for ForeignPtr
116 --import GHC.Stable -- So we can give Data instance for StablePtr
117 --import GHC.ST -- So we can give Data instance for ST
118 --import GHC.Conc -- So we can give Data instance for MVar & Co.
119 import GHC.Arr -- So we can give Data instance for Array
122 import Hugs.Prelude( Ratio(..) )
125 import Foreign.ForeignPtr
129 #include "Typeable.h"
133 ------------------------------------------------------------------------------
137 ------------------------------------------------------------------------------
140 The 'Data' class comprehends a fundamental primitive 'gfoldl' for
141 folding over constructor applications, say terms. This primitive can
142 be instantiated in several ways to map over the immediate subterms
143 of a term; see the @gmap@ combinators later in this class. Indeed, a
144 generic programmer does not necessarily need to use the ingenious gfoldl
145 primitive but rather the intuitive @gmap@ combinators. The 'gfoldl'
146 primitive is completed by means to query top-level constructors, to
147 turn constructor representations into proper terms, and to list all
148 possible datatype constructors. This completion allows us to serve
149 generic programming scenarios like read, show, equality, term generation.
151 The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
152 default definitions in terms of 'gfoldl', leaving open the opportunity
153 to provide datatype-specific definitions.
154 (The inclusion of the @gmap@ combinators as members of class 'Data'
155 allows the programmer or the compiler to derive specialised, and maybe
156 more efficient code per datatype. /Note/: 'gfoldl' is more higher-order
157 than the @gmap@ combinators. This is subject to ongoing benchmarking
158 experiments. It might turn out that the @gmap@ combinators will be
159 moved out of the class 'Data'.)
161 Conceptually, the definition of the @gmap@ combinators in terms of the
162 primitive 'gfoldl' requires the identification of the 'gfoldl' function
163 arguments. Technically, we also need to identify the type constructor
164 @c@ for the construction of the result type from the folded term type.
166 In the definition of @gmapQ@/x/ combinators, we use phantom type
167 constructors for the @c@ in the type of 'gfoldl' because the result type
168 of a query does not involve the (polymorphic) type of the term argument.
169 In the definition of 'gmapQl' we simply use the plain constant type
170 constructor because 'gfoldl' is left-associative anyway and so it is
171 readily suited to fold a left-associative binary operation over the
172 immediate subterms. In the definition of gmapQr, extra effort is
173 needed. We use a higher-order accumulation trick to mediate between
174 left-associative constructor application vs. right-associative binary
175 operation (e.g., @(:)@). When the query is meant to compute a value
176 of type @r@, then the result type withing generic folding is @r -> r@.
177 So the result of folding is a function to which we finally pass the
180 With the @-XDeriveDataTypeable@ option, GHC can generate instances of the
181 'Data' class automatically. For example, given the declaration
183 > data T a b = C1 a b | C2 deriving (Typeable, Data)
185 GHC will generate an instance that is equivalent to
187 > instance (Data a, Data b) => Data (T a b) where
188 > gfoldl k z (C1 a b) = z C1 `k` a `k` b
189 > gfoldl k z C2 = z C2
191 > gunfold k z c = case constrIndex c of
195 > toConstr (C1 _ _) = con_C1
196 > toConstr C2 = con_C2
198 > dataTypeOf _ = ty_T
200 > con_C1 = mkConstr ty_T "C1" [] Prefix
201 > con_C2 = mkConstr ty_T "C2" [] Prefix
202 > ty_T = mkDataType "Module.T" [con_C1, con_C2]
204 This is suitable for datatypes that are exported transparently.
208 class Typeable a => Data a where
210 -- | Left-associative fold operation for constructor applications.
212 -- The type of 'gfoldl' is a headache, but operationally it is a simple
213 -- generalisation of a list fold.
215 -- The default definition for 'gfoldl' is @'const' 'id'@, which is
216 -- suitable for abstract datatypes with no substructures.
217 gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
218 -- ^ defines how nonempty constructor applications are
219 -- folded. It takes the folded tail of the constructor
220 -- application and its head, i.e., an immediate subterm,
221 -- and combines them in some way.
222 -> (forall g. g -> c g)
223 -- ^ defines how the empty constructor application is
224 -- folded, like the neutral \/ start element for list
227 -- ^ structure to be folded.
229 -- ^ result, with a type defined in terms of @a@, but
230 -- variability is achieved by means of type constructor
231 -- @c@ for the construction of the actual result type.
233 -- See the 'Data' instances in this file for an illustration of 'gfoldl'.
237 -- | Unfolding constructor applications
238 gunfold :: (forall b r. Data b => c (b -> r) -> c r)
239 -> (forall r. r -> c r)
243 -- | Obtaining the constructor from a given datum.
244 -- For proper terms, this is meant to be the top-level constructor.
245 -- Primitive datatypes are here viewed as potentially infinite sets of
246 -- values (i.e., constructors).
247 toConstr :: a -> Constr
250 -- | The outer type constructor of the type
251 dataTypeOf :: a -> DataType
255 ------------------------------------------------------------------------------
257 -- Mediate types and type constructors
259 ------------------------------------------------------------------------------
261 -- | Mediate types and unary type constructors.
262 -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined
265 -- The default definition is @'const' 'Nothing'@, which is appropriate
266 -- for non-unary type constructors.
267 dataCast1 :: Typeable1 t
268 => (forall d. Data d => c (t d))
270 dataCast1 _ = Nothing
272 -- | Mediate types and binary type constructors.
273 -- In 'Data' instances of the form @T a b@, 'dataCast2' should be
274 -- defined as 'gcast2'.
276 -- The default definition is @'const' 'Nothing'@, which is appropriate
277 -- for non-binary type constructors.
278 dataCast2 :: Typeable2 t
279 => (forall d e. (Data d, Data e) => c (t d e))
281 dataCast2 _ = Nothing
285 ------------------------------------------------------------------------------
287 -- Typical generic maps defined in terms of gfoldl
289 ------------------------------------------------------------------------------
292 -- | A generic transformation that maps over the immediate subterms
294 -- The default definition instantiates the type constructor @c@ in the
295 -- type of 'gfoldl' to an identity datatype constructor, using the
296 -- isomorphism pair as injection and projection.
297 gmapT :: (forall b. Data b => b -> b) -> a -> a
299 -- Use an identity datatype constructor ID (see below)
300 -- to instantiate the type constructor c in the type of gfoldl,
301 -- and perform injections ID and projections unID accordingly.
303 gmapT f x0 = unID (gfoldl k ID x0)
305 k (ID c) x = ID (c (f x))
308 -- | A generic query with a left-associative binary operator
309 gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
310 gmapQl o r f = unCONST . gfoldl k z
312 k c x = CONST $ (unCONST c) `o` f x
315 -- | A generic query with a right-associative binary operator
316 gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
317 gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
319 k (Qr c) x = Qr (\r -> c (f x `o` r))
322 -- | A generic query that processes the immediate subterms and returns a list
323 -- of results. The list is given in the same order as originally specified
324 -- in the declaratoin of the data constructors.
325 gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
326 gmapQ f = gmapQr (:) [] f
329 -- | A generic query that processes one child by index (zero-based)
330 gmapQi :: Int -> (forall d. Data d => d -> u) -> a -> u
331 gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
333 k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
337 -- | A generic monadic transformation that maps over the immediate subterms
339 -- The default definition instantiates the type constructor @c@ in
340 -- the type of 'gfoldl' to the monad datatype constructor, defining
341 -- injection and projection using 'return' and '>>='.
342 gmapM :: Monad m => (forall d. Data d => d -> m d) -> a -> m a
344 -- Use immediately the monad datatype constructor
345 -- to instantiate the type constructor c in the type of gfoldl,
346 -- so injection and projection is done by return and >>=.
348 gmapM f = gfoldl k return
355 -- | Transformation of at least one immediate subterm does not fail
356 gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
360 The type constructor that we use here simply keeps track of the fact
361 if we already succeeded for an immediate subterm; see Mp below. To
362 this end, we couple the monadic computation with a Boolean.
366 gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
367 if b then return x' else mzero
369 z g = Mp (return (g,False))
371 = Mp ( c >>= \(h, b) ->
372 (f y >>= \y' -> return (h y', True))
373 `mplus` return (h y, b)
376 -- | Transformation of one immediate subterm with success
377 gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
381 We use the same pairing trick as for gmapMp,
382 i.e., we use an extra Bool component to keep track of the
383 fact whether an immediate subterm was processed successfully.
384 However, we cut of mapping over subterms once a first subterm
385 was transformed successfully.
389 gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
390 if b then return x' else mzero
392 z g = Mp (return (g,False))
394 = Mp ( c >>= \(h,b) -> if b
396 else (f y >>= \y' -> return (h y',True))
397 `mplus` return (h y, b)
401 -- | The identity type constructor needed for the definition of gmapT
402 newtype ID x = ID { unID :: x }
405 -- | The constant type constructor needed for the definition of gmapQl
406 newtype CONST c a = CONST { unCONST :: c }
409 -- | Type constructor for adding counters to queries
410 data Qi q a = Qi Int (Maybe q)
413 -- | The type constructor used in definition of gmapQr
414 newtype Qr r a = Qr { unQr :: r -> r }
417 -- | The type constructor used in definition of gmapMp
418 newtype Mp m x = Mp { unMp :: m (x, Bool) }
422 ------------------------------------------------------------------------------
426 ------------------------------------------------------------------------------
429 -- | Build a term skeleton
430 fromConstr :: Data a => Constr -> a
431 fromConstr = fromConstrB undefined
434 -- | Build a term and use a generic function for subterms
435 fromConstrB :: Data a
436 => (forall d. Data d => d)
439 fromConstrB f = unID . gunfold k z
445 -- | Monadic variation on 'fromConstrB'
446 fromConstrM :: (Monad m, Data a)
447 => (forall d. Data d => m d)
450 fromConstrM f = gunfold k z
452 k c = do { c' <- c; b <- f; return (c' b) }
457 ------------------------------------------------------------------------------
459 -- Datatype and constructor representations
461 ------------------------------------------------------------------------------
465 -- | Representation of datatypes.
466 -- A package of constructor representations with names of type and module.
468 data DataType = DataType
476 -- | Representation of constructors
478 { conrep :: ConstrRep
479 , constring :: String
480 , confields :: [String] -- for AlgRep only
481 , confixity :: Fixity -- for AlgRep only
482 , datatype :: DataType
485 instance Show Constr where
489 -- | Equality of constructors
490 instance Eq Constr where
491 c == c' = constrRep c == constrRep c'
494 -- | Public representation of datatypes
495 data DataRep = AlgRep [Constr]
502 -- The list of constructors could be an array, a balanced tree, or others.
505 -- | Public representation of constructors
506 data ConstrRep = AlgConstr ConIndex
509 | StringConstr String
514 -- | Unique index for datatype constructors,
515 -- counting from 1 in the order they are given in the program text.
519 -- | Fixity of constructors
521 | Infix -- Later: add associativity and precedence
526 ------------------------------------------------------------------------------
528 -- Observers for datatype representations
530 ------------------------------------------------------------------------------
533 -- | Gets the type constructor including the module
534 dataTypeName :: DataType -> String
539 -- | Gets the public presentation of a datatype
540 dataTypeRep :: DataType -> DataRep
541 dataTypeRep = datarep
544 -- | Gets the datatype of a constructor
545 constrType :: Constr -> DataType
546 constrType = datatype
549 -- | Gets the public presentation of constructors
550 constrRep :: Constr -> ConstrRep
554 -- | Look up a constructor by its representation
555 repConstr :: DataType -> ConstrRep -> Constr
557 case (dataTypeRep dt, cr) of
558 (AlgRep cs, AlgConstr i) -> cs !! (i-1)
559 (IntRep, IntConstr i) -> mkIntConstr dt i
560 (FloatRep, FloatConstr f) -> mkFloatConstr dt f
561 (StringRep, StringConstr str) -> mkStringConstr dt str
562 _ -> error "repConstr"
566 ------------------------------------------------------------------------------
568 -- Representations of algebraic data types
570 ------------------------------------------------------------------------------
573 -- | Constructs an algebraic datatype
574 mkDataType :: String -> [Constr] -> DataType
575 mkDataType str cs = DataType
577 , datarep = AlgRep cs
581 -- | Constructs a constructor
582 mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
583 mkConstr dt str fields fix =
585 { conrep = AlgConstr idx
592 idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
593 showConstr c == str ]
596 -- | Gets the constructors of an algebraic datatype
597 dataTypeConstrs :: DataType -> [Constr]
598 dataTypeConstrs dt = case datarep dt of
599 (AlgRep cons) -> cons
600 _ -> error "dataTypeConstrs"
603 -- | Gets the field labels of a constructor. The list of labels
604 -- is returned in the same order as they were given in the original
605 -- constructor declaration.
606 constrFields :: Constr -> [String]
607 constrFields = confields
610 -- | Gets the fixity of a constructor
611 constrFixity :: Constr -> Fixity
612 constrFixity = confixity
616 ------------------------------------------------------------------------------
618 -- From strings to constr's and vice versa: all data types
620 ------------------------------------------------------------------------------
623 -- | Gets the string for a constructor
624 showConstr :: Constr -> String
625 showConstr = constring
628 -- | Lookup a constructor via a string
629 readConstr :: DataType -> String -> Maybe Constr
631 case dataTypeRep dt of
632 AlgRep cons -> idx cons
633 IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
634 FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
635 StringRep -> Just (mkStringConstr dt str)
639 -- Read a value and build a constructor
640 mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
641 mkReadCon f = case (reads str) of
642 [(t,"")] -> Just (f t)
645 -- Traverse list of algebraic datatype constructors
646 idx :: [Constr] -> Maybe Constr
647 idx cons = let fit = filter ((==) str . showConstr) cons
653 ------------------------------------------------------------------------------
655 -- Convenience funtions: algebraic data types
657 ------------------------------------------------------------------------------
660 -- | Test for an algebraic type
661 isAlgType :: DataType -> Bool
662 isAlgType dt = case datarep dt of
667 -- | Gets the constructor for an index (algebraic datatypes only)
668 indexConstr :: DataType -> ConIndex -> Constr
669 indexConstr dt idx = case datarep dt of
670 (AlgRep cs) -> cs !! (idx-1)
671 _ -> error "indexConstr"
674 -- | Gets the index of a constructor (algebraic datatypes only)
675 constrIndex :: Constr -> ConIndex
676 constrIndex con = case constrRep con of
677 (AlgConstr idx) -> idx
678 _ -> error "constrIndex"
681 -- | Gets the maximum constructor index of an algebraic datatype
682 maxConstrIndex :: DataType -> ConIndex
683 maxConstrIndex dt = case dataTypeRep dt of
684 AlgRep cs -> length cs
685 _ -> error "maxConstrIndex"
689 ------------------------------------------------------------------------------
691 -- Representation of primitive types
693 ------------------------------------------------------------------------------
696 -- | Constructs the 'Int' type
697 mkIntType :: String -> DataType
698 mkIntType = mkPrimType IntRep
701 -- | Constructs the 'Float' type
702 mkFloatType :: String -> DataType
703 mkFloatType = mkPrimType FloatRep
706 -- | Constructs the 'String' type
707 mkStringType :: String -> DataType
708 mkStringType = mkPrimType StringRep
711 -- | Helper for 'mkIntType', 'mkFloatType', 'mkStringType'
712 mkPrimType :: DataRep -> String -> DataType
713 mkPrimType dr str = DataType
719 -- Makes a constructor for primitive types
720 mkPrimCon :: DataType -> String -> ConstrRep -> Constr
721 mkPrimCon dt str cr = Constr
725 , confields = error "constrFields"
726 , confixity = error "constrFixity"
730 mkIntConstr :: DataType -> Integer -> Constr
731 mkIntConstr dt i = case datarep dt of
732 IntRep -> mkPrimCon dt (show i) (IntConstr i)
733 _ -> error "mkIntConstr"
736 mkFloatConstr :: DataType -> Double -> Constr
737 mkFloatConstr dt f = case datarep dt of
738 FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
739 _ -> error "mkFloatConstr"
742 mkStringConstr :: DataType -> String -> Constr
743 mkStringConstr dt str = case datarep dt of
744 StringRep -> mkPrimCon dt str (StringConstr str)
745 _ -> error "mkStringConstr"
748 ------------------------------------------------------------------------------
750 -- Non-representations for non-presentable types
752 ------------------------------------------------------------------------------
755 -- | Constructs a non-representation for a non-presentable type
756 mkNorepType :: String -> DataType
757 mkNorepType str = DataType
763 -- | Test for a non-representable type
764 isNorepType :: DataType -> Bool
765 isNorepType dt = case datarep dt of
771 ------------------------------------------------------------------------------
773 -- Convenience for qualified type constructors
775 ------------------------------------------------------------------------------
778 -- | Gets the unqualified type constructor:
779 -- drop *.*.*... before name
781 tyconUQname :: String -> String
782 tyconUQname x = let x' = dropWhile (not . (==) '.') x
783 in if x' == [] then x else tyconUQname (tail x')
786 -- | Gets the module of a type constructor:
787 -- take *.*.*... before name
788 tyconModule :: String -> String
789 tyconModule x = let (a,b) = break ((==) '.') x
792 else a ++ tyconModule' (tail b)
794 tyconModule' y = let y' = tyconModule y
795 in if y' == "" then "" else ('.':y')
800 ------------------------------------------------------------------------------
801 ------------------------------------------------------------------------------
803 -- Instances of the Data class for Prelude-like types.
804 -- We define top-level definitions for representations.
806 ------------------------------------------------------------------------------
809 falseConstr :: Constr
810 falseConstr = mkConstr boolDataType "False" [] Prefix
812 trueConstr = mkConstr boolDataType "True" [] Prefix
814 boolDataType :: DataType
815 boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
817 instance Data Bool where
818 toConstr False = falseConstr
819 toConstr True = trueConstr
820 gunfold _ z c = case constrIndex c of
824 dataTypeOf _ = boolDataType
827 ------------------------------------------------------------------------------
830 charType = mkStringType "Prelude.Char"
832 instance Data Char where
833 toConstr x = mkStringConstr charType [x]
834 gunfold _ z c = case constrRep c of
835 (StringConstr [x]) -> z x
837 dataTypeOf _ = charType
840 ------------------------------------------------------------------------------
842 floatType :: DataType
843 floatType = mkFloatType "Prelude.Float"
845 instance Data Float where
846 toConstr x = mkFloatConstr floatType (realToFrac x)
847 gunfold _ z c = case constrRep c of
848 (FloatConstr x) -> z (realToFrac x)
850 dataTypeOf _ = floatType
853 ------------------------------------------------------------------------------
855 doubleType :: DataType
856 doubleType = mkFloatType "Prelude.Double"
858 instance Data Double where
859 toConstr = mkFloatConstr floatType
860 gunfold _ z c = case constrRep c of
861 (FloatConstr x) -> z x
863 dataTypeOf _ = doubleType
866 ------------------------------------------------------------------------------
869 intType = mkIntType "Prelude.Int"
871 instance Data Int where
872 toConstr x = mkIntConstr intType (fromIntegral x)
873 gunfold _ z c = case constrRep c of
874 (IntConstr x) -> z (fromIntegral x)
876 dataTypeOf _ = intType
879 ------------------------------------------------------------------------------
881 integerType :: DataType
882 integerType = mkIntType "Prelude.Integer"
884 instance Data Integer where
885 toConstr = mkIntConstr integerType
886 gunfold _ z c = case constrRep c of
889 dataTypeOf _ = integerType
892 ------------------------------------------------------------------------------
895 int8Type = mkIntType "Data.Int.Int8"
897 instance Data Int8 where
898 toConstr x = mkIntConstr int8Type (fromIntegral x)
899 gunfold _ z c = case constrRep c of
900 (IntConstr x) -> z (fromIntegral x)
902 dataTypeOf _ = int8Type
905 ------------------------------------------------------------------------------
907 int16Type :: DataType
908 int16Type = mkIntType "Data.Int.Int16"
910 instance Data Int16 where
911 toConstr x = mkIntConstr int16Type (fromIntegral x)
912 gunfold _ z c = case constrRep c of
913 (IntConstr x) -> z (fromIntegral x)
915 dataTypeOf _ = int16Type
918 ------------------------------------------------------------------------------
920 int32Type :: DataType
921 int32Type = mkIntType "Data.Int.Int32"
923 instance Data Int32 where
924 toConstr x = mkIntConstr int32Type (fromIntegral x)
925 gunfold _ z c = case constrRep c of
926 (IntConstr x) -> z (fromIntegral x)
928 dataTypeOf _ = int32Type
931 ------------------------------------------------------------------------------
933 int64Type :: DataType
934 int64Type = mkIntType "Data.Int.Int64"
936 instance Data Int64 where
937 toConstr x = mkIntConstr int64Type (fromIntegral x)
938 gunfold _ z c = case constrRep c of
939 (IntConstr x) -> z (fromIntegral x)
941 dataTypeOf _ = int64Type
944 ------------------------------------------------------------------------------
947 wordType = mkIntType "Data.Word.Word"
949 instance Data Word where
950 toConstr x = mkIntConstr wordType (fromIntegral x)
951 gunfold _ z c = case constrRep c of
952 (IntConstr x) -> z (fromIntegral x)
954 dataTypeOf _ = wordType
957 ------------------------------------------------------------------------------
959 word8Type :: DataType
960 word8Type = mkIntType "Data.Word.Word8"
962 instance Data Word8 where
963 toConstr x = mkIntConstr word8Type (fromIntegral x)
964 gunfold _ z c = case constrRep c of
965 (IntConstr x) -> z (fromIntegral x)
967 dataTypeOf _ = word8Type
970 ------------------------------------------------------------------------------
972 word16Type :: DataType
973 word16Type = mkIntType "Data.Word.Word16"
975 instance Data Word16 where
976 toConstr x = mkIntConstr word16Type (fromIntegral x)
977 gunfold _ z c = case constrRep c of
978 (IntConstr x) -> z (fromIntegral x)
980 dataTypeOf _ = word16Type
983 ------------------------------------------------------------------------------
985 word32Type :: DataType
986 word32Type = mkIntType "Data.Word.Word32"
988 instance Data Word32 where
989 toConstr x = mkIntConstr word32Type (fromIntegral x)
990 gunfold _ z c = case constrRep c of
991 (IntConstr x) -> z (fromIntegral x)
993 dataTypeOf _ = word32Type
996 ------------------------------------------------------------------------------
998 word64Type :: DataType
999 word64Type = mkIntType "Data.Word.Word64"
1001 instance Data Word64 where
1002 toConstr x = mkIntConstr word64Type (fromIntegral x)
1003 gunfold _ z c = case constrRep c of
1004 (IntConstr x) -> z (fromIntegral x)
1005 _ -> error "gunfold"
1006 dataTypeOf _ = word64Type
1009 ------------------------------------------------------------------------------
1011 ratioConstr :: Constr
1012 ratioConstr = mkConstr ratioDataType ":%" [] Infix
1014 ratioDataType :: DataType
1015 ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
1017 instance (Data a, Integral a) => Data (Ratio a) where
1018 gfoldl k z (a :% b) = z (:%) `k` a `k` b
1019 toConstr _ = ratioConstr
1020 gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
1021 gunfold _ _ _ = error "gunfold"
1022 dataTypeOf _ = ratioDataType
1025 ------------------------------------------------------------------------------
1028 nilConstr = mkConstr listDataType "[]" [] Prefix
1029 consConstr :: Constr
1030 consConstr = mkConstr listDataType "(:)" [] Infix
1032 listDataType :: DataType
1033 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
1035 instance Data a => Data [a] where
1036 gfoldl _ z [] = z []
1037 gfoldl f z (x:xs) = z (:) `f` x `f` xs
1038 toConstr [] = nilConstr
1039 toConstr (_:_) = consConstr
1040 gunfold k z c = case constrIndex c of
1043 _ -> error "gunfold"
1044 dataTypeOf _ = listDataType
1045 dataCast1 f = gcast1 f
1048 -- The gmaps are given as an illustration.
1049 -- This shows that the gmaps for lists are different from list maps.
1052 gmapT f (x:xs) = (f x:f xs)
1054 gmapQ f (x:xs) = [f x,f xs]
1055 gmapM _ [] = return []
1056 gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
1059 ------------------------------------------------------------------------------
1061 nothingConstr :: Constr
1062 nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
1063 justConstr :: Constr
1064 justConstr = mkConstr maybeDataType "Just" [] Prefix
1066 maybeDataType :: DataType
1067 maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
1069 instance Data a => Data (Maybe a) where
1070 gfoldl _ z Nothing = z Nothing
1071 gfoldl f z (Just x) = z Just `f` x
1072 toConstr Nothing = nothingConstr
1073 toConstr (Just _) = justConstr
1074 gunfold k z c = case constrIndex c of
1077 _ -> error "gunfold"
1078 dataTypeOf _ = maybeDataType
1079 dataCast1 f = gcast1 f
1082 ------------------------------------------------------------------------------
1085 ltConstr = mkConstr orderingDataType "LT" [] Prefix
1087 eqConstr = mkConstr orderingDataType "EQ" [] Prefix
1089 gtConstr = mkConstr orderingDataType "GT" [] Prefix
1091 orderingDataType :: DataType
1092 orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
1094 instance Data Ordering where
1095 gfoldl _ z LT = z LT
1096 gfoldl _ z EQ = z EQ
1097 gfoldl _ z GT = z GT
1098 toConstr LT = ltConstr
1099 toConstr EQ = eqConstr
1100 toConstr GT = gtConstr
1101 gunfold _ z c = case constrIndex c of
1105 _ -> error "gunfold"
1106 dataTypeOf _ = orderingDataType
1109 ------------------------------------------------------------------------------
1111 leftConstr :: Constr
1112 leftConstr = mkConstr eitherDataType "Left" [] Prefix
1114 rightConstr :: Constr
1115 rightConstr = mkConstr eitherDataType "Right" [] Prefix
1117 eitherDataType :: DataType
1118 eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
1120 instance (Data a, Data b) => Data (Either a b) where
1121 gfoldl f z (Left a) = z Left `f` a
1122 gfoldl f z (Right a) = z Right `f` a
1123 toConstr (Left _) = leftConstr
1124 toConstr (Right _) = rightConstr
1125 gunfold k z c = case constrIndex c of
1128 _ -> error "gunfold"
1129 dataTypeOf _ = eitherDataType
1130 dataCast2 f = gcast2 f
1133 ------------------------------------------------------------------------------
1137 -- A last resort for functions
1140 instance (Data a, Data b) => Data (a -> b) where
1141 toConstr _ = error "toConstr"
1142 gunfold _ _ = error "gunfold"
1143 dataTypeOf _ = mkNorepType "Prelude.(->)"
1144 dataCast2 f = gcast2 f
1147 ------------------------------------------------------------------------------
1149 tuple0Constr :: Constr
1150 tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
1152 tuple0DataType :: DataType
1153 tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
1155 instance Data () where
1156 toConstr () = tuple0Constr
1157 gunfold _ z c | constrIndex c == 1 = z ()
1158 gunfold _ _ _ = error "gunfold"
1159 dataTypeOf _ = tuple0DataType
1162 ------------------------------------------------------------------------------
1164 tuple2Constr :: Constr
1165 tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
1167 tuple2DataType :: DataType
1168 tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
1170 instance (Data a, Data b) => Data (a,b) where
1171 gfoldl f z (a,b) = z (,) `f` a `f` b
1172 toConstr (_,_) = tuple2Constr
1173 gunfold k z c | constrIndex c == 1 = k (k (z (,)))
1174 gunfold _ _ _ = error "gunfold"
1175 dataTypeOf _ = tuple2DataType
1176 dataCast2 f = gcast2 f
1179 ------------------------------------------------------------------------------
1181 tuple3Constr :: Constr
1182 tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
1184 tuple3DataType :: DataType
1185 tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr]
1187 instance (Data a, Data b, Data c) => Data (a,b,c) where
1188 gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
1189 toConstr (_,_,_) = tuple3Constr
1190 gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
1191 gunfold _ _ _ = error "gunfold"
1192 dataTypeOf _ = tuple3DataType
1195 ------------------------------------------------------------------------------
1197 tuple4Constr :: Constr
1198 tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
1200 tuple4DataType :: DataType
1201 tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
1203 instance (Data a, Data b, Data c, Data d)
1204 => Data (a,b,c,d) where
1205 gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
1206 toConstr (_,_,_,_) = tuple4Constr
1207 gunfold k z c = case constrIndex c of
1208 1 -> k (k (k (k (z (,,,)))))
1209 _ -> error "gunfold"
1210 dataTypeOf _ = tuple4DataType
1213 ------------------------------------------------------------------------------
1215 tuple5Constr :: Constr
1216 tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
1218 tuple5DataType :: DataType
1219 tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
1221 instance (Data a, Data b, Data c, Data d, Data e)
1222 => Data (a,b,c,d,e) where
1223 gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
1224 toConstr (_,_,_,_,_) = tuple5Constr
1225 gunfold k z c = case constrIndex c of
1226 1 -> k (k (k (k (k (z (,,,,))))))
1227 _ -> error "gunfold"
1228 dataTypeOf _ = tuple5DataType
1231 ------------------------------------------------------------------------------
1233 tuple6Constr :: Constr
1234 tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
1236 tuple6DataType :: DataType
1237 tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
1239 instance (Data a, Data b, Data c, Data d, Data e, Data f)
1240 => Data (a,b,c,d,e,f) where
1241 gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
1242 toConstr (_,_,_,_,_,_) = tuple6Constr
1243 gunfold k z c = case constrIndex c of
1244 1 -> k (k (k (k (k (k (z (,,,,,)))))))
1245 _ -> error "gunfold"
1246 dataTypeOf _ = tuple6DataType
1249 ------------------------------------------------------------------------------
1251 tuple7Constr :: Constr
1252 tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
1254 tuple7DataType :: DataType
1255 tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
1257 instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
1258 => Data (a,b,c,d,e,f,g) where
1259 gfoldl f z (a,b,c,d,e,f',g) =
1260 z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
1261 toConstr (_,_,_,_,_,_,_) = tuple7Constr
1262 gunfold k z c = case constrIndex c of
1263 1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
1264 _ -> error "gunfold"
1265 dataTypeOf _ = tuple7DataType
1268 ------------------------------------------------------------------------------
1270 instance Typeable a => Data (Ptr a) where
1271 toConstr _ = error "toConstr"
1272 gunfold _ _ = error "gunfold"
1273 dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"
1276 ------------------------------------------------------------------------------
1278 instance Typeable a => Data (ForeignPtr a) where
1279 toConstr _ = error "toConstr"
1280 gunfold _ _ = error "gunfold"
1281 dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr"
1284 ------------------------------------------------------------------------------
1285 -- The Data instance for Array preserves data abstraction at the cost of
1286 -- inefficiency. We omit reflection services for the sake of data abstraction.
1287 instance (Typeable a, Data b, Ix a) => Data (Array a b)
1289 gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
1290 toConstr _ = error "toConstr"
1291 gunfold _ _ = error "gunfold"
1292 dataTypeOf _ = mkNorepType "Data.Array.Array"