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