Fix #2759: add mkRealConstr and mkIntegralConstr, deprecate mkFloatConstr and mkIntConstr
[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 {-# DEPRECATED StringRep "Use CharRep instead" #-}
505 data DataRep = AlgRep [Constr]
506              | IntRep
507              | FloatRep
508              | StringRep -- ^ Deprecated. Please use 'CharRep' instead.
509              | CharRep
510              | NoRep
511
512             deriving (Eq,Show)
513 -- The list of constructors could be an array, a balanced tree, or others.
514
515
516 -- | Public representation of constructors
517 {-# DEPRECATED StringConstr "Use CharConstr instead" #-}
518 data ConstrRep = AlgConstr    ConIndex
519                | IntConstr    Integer
520                | FloatConstr  Rational
521                | StringConstr String -- ^ Deprecated. Please use 'CharConstr' instead.
522                | CharConstr   Char
523
524                deriving (Eq,Show)
525
526
527 -- | Unique index for datatype constructors,
528 -- counting from 1 in the order they are given in the program text.
529 type ConIndex = Int
530
531
532 -- | Fixity of constructors
533 data Fixity = Prefix
534             | Infix     -- Later: add associativity and precedence
535
536             deriving (Eq,Show)
537
538
539 ------------------------------------------------------------------------------
540 --
541 --      Observers for datatype representations
542 --
543 ------------------------------------------------------------------------------
544
545
546 -- | Gets the type constructor including the module
547 dataTypeName :: DataType -> String
548 dataTypeName = tycon
549
550
551
552 -- | Gets the public presentation of a datatype
553 dataTypeRep :: DataType -> DataRep
554 dataTypeRep = datarep
555
556
557 -- | Gets the datatype of a constructor
558 constrType :: Constr -> DataType
559 constrType = datatype
560
561
562 -- | Gets the public presentation of constructors
563 constrRep :: Constr -> ConstrRep
564 constrRep = conrep
565
566
567 -- | Look up a constructor by its representation
568 repConstr :: DataType -> ConstrRep -> Constr
569 repConstr dt cr =
570       case (dataTypeRep dt, cr) of
571         (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
572         (IntRep,    IntConstr i)      -> mkIntConstr dt i
573         (FloatRep,  FloatConstr f)    -> mkRealConstr dt f
574         (StringRep, StringConstr str) -> mkStringConstr dt str
575         (CharRep,   CharConstr c)     -> mkCharConstr dt c
576         _ -> error "repConstr"
577
578
579
580 ------------------------------------------------------------------------------
581 --
582 --      Representations of algebraic data types
583 --
584 ------------------------------------------------------------------------------
585
586
587 -- | Constructs an algebraic datatype
588 mkDataType :: String -> [Constr] -> DataType
589 mkDataType str cs = DataType
590                         { tycon   = str
591                         , datarep = AlgRep cs
592                         }
593
594
595 -- | Constructs a constructor
596 mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
597 mkConstr dt str fields fix =
598         Constr
599                 { conrep    = AlgConstr idx
600                 , constring = str
601                 , confields = fields
602                 , confixity = fix
603                 , datatype  = dt
604                 }
605   where
606     idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
607                      showConstr c == str ]
608
609
610 -- | Gets the constructors of an algebraic datatype
611 dataTypeConstrs :: DataType -> [Constr]
612 dataTypeConstrs dt = case datarep dt of
613                         (AlgRep cons) -> cons
614                         _ -> error "dataTypeConstrs"
615
616
617 -- | Gets the field labels of a constructor.  The list of labels
618 -- is returned in the same order as they were given in the original 
619 -- constructor declaration.
620 constrFields :: Constr -> [String]
621 constrFields = confields
622
623
624 -- | Gets the fixity of a constructor
625 constrFixity :: Constr -> Fixity
626 constrFixity = confixity
627
628
629
630 ------------------------------------------------------------------------------
631 --
632 --      From strings to constr's and vice versa: all data types
633 --      
634 ------------------------------------------------------------------------------
635
636
637 -- | Gets the string for a constructor
638 showConstr :: Constr -> String
639 showConstr = constring
640
641
642 -- | Lookup a constructor via a string
643 readConstr :: DataType -> String -> Maybe Constr
644 readConstr dt str =
645       case dataTypeRep dt of
646         AlgRep cons -> idx cons
647         IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
648         FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
649         StringRep   -> Just (mkStringConstr dt str)
650         CharRep     -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
651         NoRep       -> Nothing
652   where
653
654     -- Read a value and build a constructor
655     mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
656     mkReadCon f = case (reads str) of
657                     [(t,"")] -> Just (f t)
658                     _ -> Nothing
659
660     -- Traverse list of algebraic datatype constructors
661     idx :: [Constr] -> Maybe Constr
662     idx cons = let fit = filter ((==) str . showConstr) cons
663                 in if fit == []
664                      then Nothing
665                      else Just (head fit)
666
667
668 ------------------------------------------------------------------------------
669 --
670 --      Convenience funtions: algebraic data types
671 --
672 ------------------------------------------------------------------------------
673
674
675 -- | Test for an algebraic type
676 isAlgType :: DataType -> Bool
677 isAlgType dt = case datarep dt of
678                  (AlgRep _) -> True
679                  _ -> False
680
681
682 -- | Gets the constructor for an index (algebraic datatypes only)
683 indexConstr :: DataType -> ConIndex -> Constr
684 indexConstr dt idx = case datarep dt of
685                         (AlgRep cs) -> cs !! (idx-1)
686                         _           -> error "indexConstr"
687
688
689 -- | Gets the index of a constructor (algebraic datatypes only)
690 constrIndex :: Constr -> ConIndex
691 constrIndex con = case constrRep con of
692                     (AlgConstr idx) -> idx
693                     _ -> error "constrIndex"
694
695
696 -- | Gets the maximum constructor index of an algebraic datatype
697 maxConstrIndex :: DataType -> ConIndex
698 maxConstrIndex dt = case dataTypeRep dt of
699                         AlgRep cs -> length cs
700                         _            -> error "maxConstrIndex"
701
702
703
704 ------------------------------------------------------------------------------
705 --
706 --      Representation of primitive types
707 --
708 ------------------------------------------------------------------------------
709
710
711 -- | Constructs the 'Int' type
712 mkIntType :: String -> DataType
713 mkIntType = mkPrimType IntRep
714
715
716 -- | Constructs the 'Float' type
717 mkFloatType :: String -> DataType
718 mkFloatType = mkPrimType FloatRep
719
720
721 -- | This function is now deprecated. Please use 'mkCharType' instead.
722 {-# DEPRECATED mkStringType "Use mkCharType instead" #-}
723 mkStringType :: String -> DataType
724 mkStringType = mkPrimType StringRep
725
726 -- | Constructs the 'Char' type
727 mkCharType :: String -> DataType
728 mkCharType = mkPrimType CharRep
729
730
731 -- | Helper for 'mkIntType', 'mkFloatType', 'mkStringType'
732 mkPrimType :: DataRep -> String -> DataType
733 mkPrimType dr str = DataType
734                         { tycon   = str
735                         , datarep = dr
736                         }
737
738
739 -- Makes a constructor for primitive types
740 mkPrimCon :: DataType -> String -> ConstrRep -> Constr
741 mkPrimCon dt str cr = Constr
742                         { datatype  = dt
743                         , conrep    = cr
744                         , constring = str
745                         , confields = error "constrFields"
746                         , confixity = error "constrFixity"
747                         }
748
749 -- | This function is now deprecated. Please use 'mkIntegralConstr' instead.
750 {-# DEPRECATED mkIntConstr "Use mkIntegralConstr instead" #-}
751 mkIntConstr :: DataType -> Integer -> Constr
752 mkIntConstr = mkIntegralConstr
753
754 mkIntegralConstr :: (Integral a) => DataType -> a -> Constr
755 mkIntegralConstr dt i = case datarep dt of
756                   IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))
757                   _ -> error "mkIntegralConstr"
758
759 -- | This function is now deprecated. Please use 'mkRealConstr' instead.
760 {-# DEPRECATED mkFloatConstr "Use mkRealConstr instead" #-}
761 mkFloatConstr :: DataType -> Double -> Constr
762 mkFloatConstr dt = mkRealConstr dt . toRational
763
764 mkRealConstr :: (Real a) => DataType -> a -> Constr
765 mkRealConstr dt f = case datarep dt of
766                     FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
767                     _ -> error "mkRealConstr"
768
769 -- | This function is now deprecated. Please use 'mkCharConstr' instead.
770 {-# DEPRECATED mkStringConstr "Use mkCharConstr instead" #-}
771 mkStringConstr :: DataType -> String -> Constr
772 mkStringConstr dt str = case datarep dt of
773                        StringRep -> mkPrimCon dt str (StringConstr str)
774                        _ -> error "mkStringConstr"
775
776 -- | Makes a constructor for 'Char'.
777 mkCharConstr :: DataType -> Char -> Constr
778 mkCharConstr dt c = case datarep dt of
779                    CharRep -> mkPrimCon dt (show c) (CharConstr c)
780                    _ -> error "mkCharConstr"
781
782
783 ------------------------------------------------------------------------------
784 --
785 --      Non-representations for non-presentable types
786 --
787 ------------------------------------------------------------------------------
788
789
790 -- | Deprecated version (misnamed)
791 {-# DEPRECATED mkNorepType "Use mkNoRepType instead" #-}
792 mkNorepType :: String -> DataType
793 mkNorepType str = DataType
794                         { tycon   = str
795                         , datarep = NoRep
796                         }
797
798 -- | Constructs a non-representation for a non-presentable type
799 mkNoRepType :: String -> DataType
800 mkNoRepType str = DataType
801                         { tycon   = str
802                         , datarep = NoRep
803                         }
804
805 -- | Test for a non-representable type
806 isNorepType :: DataType -> Bool
807 isNorepType dt = case datarep dt of
808                    NoRep -> True
809                    _ -> False
810
811
812
813 ------------------------------------------------------------------------------
814 --
815 --      Convenience for qualified type constructors
816 --
817 ------------------------------------------------------------------------------
818
819
820 -- | Gets the unqualified type constructor:
821 -- drop *.*.*... before name
822 --
823 tyconUQname :: String -> String
824 tyconUQname x = let x' = dropWhile (not . (==) '.') x
825                  in if x' == [] then x else tyconUQname (tail x')
826
827
828 -- | Gets the module of a type constructor:
829 -- take *.*.*... before name
830 tyconModule :: String -> String
831 tyconModule x = let (a,b) = break ((==) '.') x
832                  in if b == ""
833                       then b
834                       else a ++ tyconModule' (tail b)
835   where
836     tyconModule' y = let y' = tyconModule y
837                       in if y' == "" then "" else ('.':y')
838
839
840
841
842 ------------------------------------------------------------------------------
843 ------------------------------------------------------------------------------
844 --
845 --      Instances of the Data class for Prelude-like types.
846 --      We define top-level definitions for representations.
847 --
848 ------------------------------------------------------------------------------
849
850
851 falseConstr :: Constr
852 falseConstr  = mkConstr boolDataType "False" [] Prefix
853 trueConstr :: Constr
854 trueConstr   = mkConstr boolDataType "True"  [] Prefix
855
856 boolDataType :: DataType
857 boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
858
859 instance Data Bool where
860   toConstr False = falseConstr
861   toConstr True  = trueConstr
862   gunfold _ z c  = case constrIndex c of
863                      1 -> z False
864                      2 -> z True
865                      _ -> error "gunfold"
866   dataTypeOf _ = boolDataType
867
868
869 ------------------------------------------------------------------------------
870
871 charType :: DataType
872 charType = mkCharType "Prelude.Char"
873
874 instance Data Char where
875   toConstr x = mkCharConstr charType x
876   gunfold _ z c = case constrRep c of
877                     (CharConstr x) -> z x
878                     _ -> error "gunfold"
879   dataTypeOf _ = charType
880
881
882 ------------------------------------------------------------------------------
883
884 floatType :: DataType
885 floatType = mkFloatType "Prelude.Float"
886
887 instance Data Float where
888   toConstr = mkRealConstr floatType
889   gunfold _ z c = case constrRep c of
890                     (FloatConstr x) -> z (realToFrac x)
891                     _ -> error "gunfold"
892   dataTypeOf _ = floatType
893
894
895 ------------------------------------------------------------------------------
896
897 doubleType :: DataType
898 doubleType = mkFloatType "Prelude.Double"
899
900 instance Data Double where
901   toConstr = mkRealConstr doubleType
902   gunfold _ z c = case constrRep c of
903                     (FloatConstr x) -> z (realToFrac x)
904                     _ -> error "gunfold"
905   dataTypeOf _ = doubleType
906
907
908 ------------------------------------------------------------------------------
909
910 intType :: DataType
911 intType = mkIntType "Prelude.Int"
912
913 instance Data Int where
914   toConstr x = mkIntConstr intType (fromIntegral x)
915   gunfold _ z c = case constrRep c of
916                     (IntConstr x) -> z (fromIntegral x)
917                     _ -> error "gunfold"
918   dataTypeOf _ = intType
919
920
921 ------------------------------------------------------------------------------
922
923 integerType :: DataType
924 integerType = mkIntType "Prelude.Integer"
925
926 instance Data Integer where
927   toConstr = mkIntConstr integerType
928   gunfold _ z c = case constrRep c of
929                     (IntConstr x) -> z x
930                     _ -> error "gunfold"
931   dataTypeOf _ = integerType
932
933
934 ------------------------------------------------------------------------------
935
936 int8Type :: DataType
937 int8Type = mkIntType "Data.Int.Int8"
938
939 instance Data Int8 where
940   toConstr x = mkIntConstr int8Type (fromIntegral x)
941   gunfold _ z c = case constrRep c of
942                     (IntConstr x) -> z (fromIntegral x)
943                     _ -> error "gunfold"
944   dataTypeOf _ = int8Type
945
946
947 ------------------------------------------------------------------------------
948
949 int16Type :: DataType
950 int16Type = mkIntType "Data.Int.Int16"
951
952 instance Data Int16 where
953   toConstr x = mkIntConstr int16Type (fromIntegral x)
954   gunfold _ z c = case constrRep c of
955                     (IntConstr x) -> z (fromIntegral x)
956                     _ -> error "gunfold"
957   dataTypeOf _ = int16Type
958
959
960 ------------------------------------------------------------------------------
961
962 int32Type :: DataType
963 int32Type = mkIntType "Data.Int.Int32"
964
965 instance Data Int32 where
966   toConstr x = mkIntConstr int32Type (fromIntegral x)
967   gunfold _ z c = case constrRep c of
968                     (IntConstr x) -> z (fromIntegral x)
969                     _ -> error "gunfold"
970   dataTypeOf _ = int32Type
971
972
973 ------------------------------------------------------------------------------
974
975 int64Type :: DataType
976 int64Type = mkIntType "Data.Int.Int64"
977
978 instance Data Int64 where
979   toConstr x = mkIntConstr int64Type (fromIntegral x)
980   gunfold _ z c = case constrRep c of
981                     (IntConstr x) -> z (fromIntegral x)
982                     _ -> error "gunfold"
983   dataTypeOf _ = int64Type
984
985
986 ------------------------------------------------------------------------------
987
988 wordType :: DataType
989 wordType = mkIntType "Data.Word.Word"
990
991 instance Data Word where
992   toConstr x = mkIntConstr wordType (fromIntegral x)
993   gunfold _ z c = case constrRep c of
994                     (IntConstr x) -> z (fromIntegral x)
995                     _ -> error "gunfold"
996   dataTypeOf _ = wordType
997
998
999 ------------------------------------------------------------------------------
1000
1001 word8Type :: DataType
1002 word8Type = mkIntType "Data.Word.Word8"
1003
1004 instance Data Word8 where
1005   toConstr x = mkIntConstr word8Type (fromIntegral x)
1006   gunfold _ z c = case constrRep c of
1007                     (IntConstr x) -> z (fromIntegral x)
1008                     _ -> error "gunfold"
1009   dataTypeOf _ = word8Type
1010
1011
1012 ------------------------------------------------------------------------------
1013
1014 word16Type :: DataType
1015 word16Type = mkIntType "Data.Word.Word16"
1016
1017 instance Data Word16 where
1018   toConstr x = mkIntConstr word16Type (fromIntegral x)
1019   gunfold _ z c = case constrRep c of
1020                     (IntConstr x) -> z (fromIntegral x)
1021                     _ -> error "gunfold"
1022   dataTypeOf _ = word16Type
1023
1024
1025 ------------------------------------------------------------------------------
1026
1027 word32Type :: DataType
1028 word32Type = mkIntType "Data.Word.Word32"
1029
1030 instance Data Word32 where
1031   toConstr x = mkIntConstr word32Type (fromIntegral x)
1032   gunfold _ z c = case constrRep c of
1033                     (IntConstr x) -> z (fromIntegral x)
1034                     _ -> error "gunfold"
1035   dataTypeOf _ = word32Type
1036
1037
1038 ------------------------------------------------------------------------------
1039
1040 word64Type :: DataType
1041 word64Type = mkIntType "Data.Word.Word64"
1042
1043 instance Data Word64 where
1044   toConstr x = mkIntConstr word64Type (fromIntegral x)
1045   gunfold _ z c = case constrRep c of
1046                     (IntConstr x) -> z (fromIntegral x)
1047                     _ -> error "gunfold"
1048   dataTypeOf _ = word64Type
1049
1050
1051 ------------------------------------------------------------------------------
1052
1053 ratioConstr :: Constr
1054 ratioConstr = mkConstr ratioDataType ":%" [] Infix
1055
1056 ratioDataType :: DataType
1057 ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
1058
1059 instance (Data a, Integral a) => Data (Ratio a) where
1060   gfoldl k z (a :% b) = z (:%) `k` a `k` b
1061   toConstr _ = ratioConstr
1062   gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
1063   gunfold _ _ _ = error "gunfold"
1064   dataTypeOf _  = ratioDataType
1065
1066
1067 ------------------------------------------------------------------------------
1068
1069 nilConstr :: Constr
1070 nilConstr    = mkConstr listDataType "[]" [] Prefix
1071 consConstr :: Constr
1072 consConstr   = mkConstr listDataType "(:)" [] Infix
1073
1074 listDataType :: DataType
1075 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
1076
1077 instance Data a => Data [a] where
1078   gfoldl _ z []     = z []
1079   gfoldl f z (x:xs) = z (:) `f` x `f` xs
1080   toConstr []    = nilConstr
1081   toConstr (_:_) = consConstr
1082   gunfold k z c = case constrIndex c of
1083                     1 -> z []
1084                     2 -> k (k (z (:)))
1085                     _ -> error "gunfold"
1086   dataTypeOf _ = listDataType
1087   dataCast1 f  = gcast1 f
1088
1089 --
1090 -- The gmaps are given as an illustration.
1091 -- This shows that the gmaps for lists are different from list maps.
1092 --
1093   gmapT  _   []     = []
1094   gmapT  f   (x:xs) = (f x:f xs)
1095   gmapQ  _   []     = []
1096   gmapQ  f   (x:xs) = [f x,f xs]
1097   gmapM  _   []     = return []
1098   gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
1099
1100
1101 ------------------------------------------------------------------------------
1102
1103 nothingConstr :: Constr
1104 nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
1105 justConstr :: Constr
1106 justConstr    = mkConstr maybeDataType "Just"    [] Prefix
1107
1108 maybeDataType :: DataType
1109 maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
1110
1111 instance Data a => Data (Maybe a) where
1112   gfoldl _ z Nothing  = z Nothing
1113   gfoldl f z (Just x) = z Just `f` x
1114   toConstr Nothing  = nothingConstr
1115   toConstr (Just _) = justConstr
1116   gunfold k z c = case constrIndex c of
1117                     1 -> z Nothing
1118                     2 -> k (z Just)
1119                     _ -> error "gunfold"
1120   dataTypeOf _ = maybeDataType
1121   dataCast1 f  = gcast1 f
1122
1123
1124 ------------------------------------------------------------------------------
1125
1126 ltConstr :: Constr
1127 ltConstr         = mkConstr orderingDataType "LT" [] Prefix
1128 eqConstr :: Constr
1129 eqConstr         = mkConstr orderingDataType "EQ" [] Prefix
1130 gtConstr :: Constr
1131 gtConstr         = mkConstr orderingDataType "GT" [] Prefix
1132
1133 orderingDataType :: DataType
1134 orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
1135
1136 instance Data Ordering where
1137   gfoldl _ z LT  = z LT
1138   gfoldl _ z EQ  = z EQ
1139   gfoldl _ z GT  = z GT
1140   toConstr LT  = ltConstr
1141   toConstr EQ  = eqConstr
1142   toConstr GT  = gtConstr
1143   gunfold _ z c = case constrIndex c of
1144                     1 -> z LT
1145                     2 -> z EQ
1146                     3 -> z GT
1147                     _ -> error "gunfold"
1148   dataTypeOf _ = orderingDataType
1149
1150
1151 ------------------------------------------------------------------------------
1152
1153 leftConstr :: Constr
1154 leftConstr     = mkConstr eitherDataType "Left"  [] Prefix
1155
1156 rightConstr :: Constr
1157 rightConstr    = mkConstr eitherDataType "Right" [] Prefix
1158
1159 eitherDataType :: DataType
1160 eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
1161
1162 instance (Data a, Data b) => Data (Either a b) where
1163   gfoldl f z (Left a)   = z Left  `f` a
1164   gfoldl f z (Right a)  = z Right `f` a
1165   toConstr (Left _)  = leftConstr
1166   toConstr (Right _) = rightConstr
1167   gunfold k z c = case constrIndex c of
1168                     1 -> k (z Left)
1169                     2 -> k (z Right)
1170                     _ -> error "gunfold"
1171   dataTypeOf _ = eitherDataType
1172   dataCast2 f  = gcast2 f
1173
1174
1175 ------------------------------------------------------------------------------
1176
1177 tuple0Constr :: Constr
1178 tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
1179
1180 tuple0DataType :: DataType
1181 tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
1182
1183 instance Data () where
1184   toConstr ()   = tuple0Constr
1185   gunfold _ z c | constrIndex c == 1 = z ()
1186   gunfold _ _ _ = error "gunfold"
1187   dataTypeOf _  = tuple0DataType
1188
1189
1190 ------------------------------------------------------------------------------
1191
1192 tuple2Constr :: Constr
1193 tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
1194
1195 tuple2DataType :: DataType
1196 tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
1197
1198 instance (Data a, Data b) => Data (a,b) where
1199   gfoldl f z (a,b) = z (,) `f` a `f` b
1200   toConstr (_,_) = tuple2Constr
1201   gunfold k z c | constrIndex c == 1 = k (k (z (,)))
1202   gunfold _ _ _ = error "gunfold"
1203   dataTypeOf _  = tuple2DataType
1204   dataCast2 f   = gcast2 f
1205
1206
1207 ------------------------------------------------------------------------------
1208
1209 tuple3Constr :: Constr
1210 tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
1211
1212 tuple3DataType :: DataType
1213 tuple3DataType = mkDataType "Prelude.(,,)" [tuple3Constr]
1214
1215 instance (Data a, Data b, Data c) => Data (a,b,c) where
1216   gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
1217   toConstr (_,_,_) = tuple3Constr
1218   gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
1219   gunfold _ _ _ = error "gunfold"
1220   dataTypeOf _  = tuple3DataType
1221
1222
1223 ------------------------------------------------------------------------------
1224
1225 tuple4Constr :: Constr
1226 tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
1227
1228 tuple4DataType :: DataType
1229 tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
1230
1231 instance (Data a, Data b, Data c, Data d)
1232          => Data (a,b,c,d) where
1233   gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
1234   toConstr (_,_,_,_) = tuple4Constr
1235   gunfold k z c = case constrIndex c of
1236                     1 -> k (k (k (k (z (,,,)))))
1237                     _ -> error "gunfold"
1238   dataTypeOf _ = tuple4DataType
1239
1240
1241 ------------------------------------------------------------------------------
1242
1243 tuple5Constr :: Constr
1244 tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
1245
1246 tuple5DataType :: DataType
1247 tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
1248
1249 instance (Data a, Data b, Data c, Data d, Data e)
1250          => Data (a,b,c,d,e) where
1251   gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
1252   toConstr (_,_,_,_,_) = tuple5Constr
1253   gunfold k z c = case constrIndex c of
1254                     1 -> k (k (k (k (k (z (,,,,))))))
1255                     _ -> error "gunfold"
1256   dataTypeOf _ = tuple5DataType
1257
1258
1259 ------------------------------------------------------------------------------
1260
1261 tuple6Constr :: Constr
1262 tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
1263
1264 tuple6DataType :: DataType
1265 tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
1266
1267 instance (Data a, Data b, Data c, Data d, Data e, Data f)
1268          => Data (a,b,c,d,e,f) where
1269   gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
1270   toConstr (_,_,_,_,_,_) = tuple6Constr
1271   gunfold k z c = case constrIndex c of
1272                     1 -> k (k (k (k (k (k (z (,,,,,)))))))
1273                     _ -> error "gunfold"
1274   dataTypeOf _ = tuple6DataType
1275
1276
1277 ------------------------------------------------------------------------------
1278
1279 tuple7Constr :: Constr
1280 tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
1281
1282 tuple7DataType :: DataType
1283 tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
1284
1285 instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
1286          => Data (a,b,c,d,e,f,g) where
1287   gfoldl f z (a,b,c,d,e,f',g) =
1288     z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
1289   toConstr  (_,_,_,_,_,_,_) = tuple7Constr
1290   gunfold k z c = case constrIndex c of
1291                     1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
1292                     _ -> error "gunfold"
1293   dataTypeOf _ = tuple7DataType
1294
1295
1296 ------------------------------------------------------------------------------
1297
1298 instance Typeable a => Data (Ptr a) where
1299   toConstr _   = error "toConstr"
1300   gunfold _ _  = error "gunfold"
1301   dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"
1302
1303
1304 ------------------------------------------------------------------------------
1305
1306 instance Typeable a => Data (ForeignPtr a) where
1307   toConstr _   = error "toConstr"
1308   gunfold _ _  = error "gunfold"
1309   dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"
1310
1311
1312 ------------------------------------------------------------------------------
1313 -- The Data instance for Array preserves data abstraction at the cost of 
1314 -- inefficiency. We omit reflection services for the sake of data abstraction.
1315 instance (Typeable a, Data b, Ix a) => Data (Array a b)
1316  where
1317   gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
1318   toConstr _   = error "toConstr"
1319   gunfold _ _  = error "gunfold"
1320   dataTypeOf _ = mkNoRepType "Data.Array.Array"
1321