Data/Generics/Basics.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics.Basics
   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
  10 --
  11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell
  12 -- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
  13 -- the Data class with its primitives for generic programming.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Data.Generics.Basics (
  18
  19         -- Module Data.Typeable re-exported for convenience
  20         module Data.Typeable,
  21
  22         -- * The Data class for processing constructor applications
  23         Data(
  24                 gfoldl,         -- :: ... -> a -> c a
  25                 toConstr,       -- :: a -> Constr
  26                 fromConstr,     -- :: Constr -> a
  27                 dataTypeOf,     -- :: a -> DataType
  28                 cast0to1,       -- mediate types and unary type constructors
  29                 cast0to2        -- mediate types and binary type constructors
  30             ),
  31
  32         -- * Datatype representations (incl. constructors)
  33         Constr,         -- abstract, instance of: Eq, Show
  34         PrimRep(..),    -- instance of: Eq, Show
  35         ConIndex,       -- alias for Int, start at 1
  36         Fixity(..),     -- instance of: Eq, Show
  37         DataType,       -- abstract, instance of: Show
  38         PrimCons(..),   -- instance of: Eq, Show
  39
  40         -- * Constructing datatype representations
  41         mkDataConstr,   -- :: ConIndex -> String -> Fixity -> Constr
  42         mkPrimConstr,   -- :: PrimRep -> Constr
  43         mkDataType,     -- :: [Constr] -> DataType
  44         mkPrimType,     -- :: Typeable a => PrimCons -> a -> DataType
  45
  46         -- * Observing datatype representations
  47         dataTyCon,      -- :: DataType -> String
  48         dataTyMod,      -- :: DataType -> String
  49         isPrimType,     -- :: DataType -> Bool
  50         dataCons,       -- :: DataType -> [Constr]
  51         primCons,       -- :: DataType -> PrimCons
  52         constrPrimRep,  -- :: Constr -> PrimRep
  53         conString,      -- :: Constr -> String
  54         conFixity,      -- :: Constr -> Fixity
  55         conIndex,       -- :: Constr -> ConIndex
  56         stringCon,      -- :: DataType -> String -> Maybe Constr
  57         indexCon,       -- :: DataType -> ConIndex -> Constr
  58         maxConIndex,    -- :: DataType -> ConIndex
  59
  60         -- * Generic maps defined in terms of gfoldl
  61         gmapT,
  62         gmapQ,
  63         gmapQl,
  64         gmapQr,
  65         gmapQi,
  66         gmapM,
  67         gmapMp,
  68         gmapMo,
  69
  70   ) where
  71
  72
  73 ------------------------------------------------------------------------------
  74
  75 #ifdef __HADDOCK__
  76 import Prelude
  77 #endif
  78
  79 import Data.Typeable
  80 import Data.Maybe
  81 import Control.Monad
  82 import Data.Int              -- So we can give Data instance for Int8, ...
  83 import Data.Word             -- So we can give Data instance for Word8, ...
  84
  85 import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
  86 -- import GHC.Ptr            -- So we can give Data instance for Ptr
  87 -- import GHC.Stable         -- So we can give Data instance for StablePtr
  88 #include "Typeable.h"
  89
  90
  91 ------------------------------------------------------------------------------
  92 --
  93 --      The Data class
  94 --
  95 ------------------------------------------------------------------------------
  96
  97 {-
  98
  99 The Data class comprehends a fundamental primitive "gfoldl" for
 100 folding over constructor applications, say terms. This primitive can
 101 be instantiated in several ways to map over the immediate subterms of
 102 a term; see the "gmap" combinators later in this module. Indeed, a
 103 generic programmer does not necessarily need to use the ingenious
 104 gfoldl primitive but rather the intuitive "gmap" combinators. The
 105 "gfoldl" primitive is completed by means to query top-level
 106 constructors, to turn constructor representations into proper terms,
 107 and to list all possible datatype constructors. This completion
 108 allows us to serve generic programming scenarios like read, show,
 109 equality, term generation.
 110
 111 -}
 112
 113 class Typeable a => Data a where
 114
 115 {-
 116
 117 Folding constructor applications ("gfoldl")
 118
 119 The combinator takes two arguments "f" and "z" to fold over a term
 120 "x".  The result type is defined in terms of "x" but variability is
 121 achieved by means of type constructor "c" for the construction of the
 122 actual result type. The purpose of the argument "z" is to define how
 123 the empty constructor application is folded. So "z" is like the
 124 neutral / start element for list folding. The purpose of the argument
 125 "f" is to define how the nonempty constructor application is
 126 folded. That is, "f" takes the folded "tail" of the constructor
 127 application and its head, i.e., an immediate subterm, and combines
 128 them in some way. See the Data instances in this file for an
 129 illustration of "gfoldl". Conclusion: the type of gfoldl is a
 130 headache, but operationally it is simple generalisation of a list
 131 fold.
 132
 133 -}
 134
 135   -- | Left-associative fold operation for constructor applications
 136   gfoldl  :: (forall a b. Data a => c (a -> b) -> a -> c b)
 137           -> (forall g. g -> c g)
 138           -> a -> c a
 139
 140   -- Default definition for gfoldl
 141   -- which copes immediately with basic datatypes
 142   --
 143   gfoldl _ z = z
 144
 145   -- | Obtaining the constructor from a given datum.
 146   -- For proper terms, this is meant to be the top-level constructor.
 147   -- Primitive datatypes are here viewed as potentially infinite sets of
 148   -- values (i.e., constructors).
 149   --
 150   toConstr   :: a -> Constr
 151
 152
 153   -- | Building a term from a constructor
 154   fromConstr   :: Constr -> a
 155
 156
 157   -- | Provide access to list of all constructors
 158   dataTypeOf  :: a -> DataType
 159
 160
 161
 162 ------------------------------------------------------------------------------
 163 --
 164 -- Mediate types and type constructors
 165 --
 166 ------------------------------------------------------------------------------
 167
 168   -- | Mediate types and unary type constructors
 169   cast0to1 :: Typeable1 t
 170            => (forall a. Data a => c (t a))
 171            -> Maybe (c a)
 172   cast0to1 _ = Nothing
 173
 174   -- | Mediate types and binary type constructors
 175   cast0to2 :: Typeable2 t
 176            => (forall a b. (Data a, Data b) => c (t a b))
 177            -> Maybe (c a)
 178   cast0to2 _ = Nothing
 179
 180
 181
 182 ------------------------------------------------------------------------------
 183 --
 184 --      Typical generic maps defined in terms of gfoldl
 185 --
 186 ------------------------------------------------------------------------------
 187
 188 {-
 189
 190 The combinators gmapT, gmapQ, gmapM, ... can all be defined in terms
 191 of gfoldl. We provide corresponding default definitions leaving open
 192 the opportunity to provide datatype-specific definitions.
 193
 194 (The inclusion of the gmap combinators as members of class Data allows
 195 the programmer or the compiler to derive specialised, and maybe more
 196 efficient code per datatype. Note: gfoldl is more higher-order than
 197 the gmap combinators. This is subject to ongoing benchmarking
 198 experiments. It might turn out that the gmap combinators will be moved
 199 out of the class Data.)
 200
 201 Conceptually, the definition of the gmap combinators in terms of the
 202 primitive gfoldl requires the identification of the gfoldl function
 203 arguments. Technically, we also need to identify the type constructor
 204 "c" for the construction of the result type from the folded term type.
 205
 206 -}
 207
 208
 209   -- | A generic transformation that maps over the immediate subterms
 210   gmapT :: (forall b. Data b => b -> b) -> a -> a
 211
 212   -- Use an identity datatype constructor ID (see below)
 213   -- to instantiate the type constructor c in the type of gfoldl,
 214   -- and perform injections ID and projections unID accordingly.
 215   --
 216   gmapT f x = unID (gfoldl k ID x)
 217     where
 218       k (ID c) x = ID (c (f x))
 219
 220
 221   -- | A generic query with a left-associative binary operator
 222   gmapQl :: (r -> r' -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
 223   gmapQl o r f = unCONST . gfoldl k z
 224     where
 225       k c x = CONST $ (unCONST c) `o` f x
 226       z _   = CONST r
 227
 228 {-
 229
 230 In the definition of gmapQ? combinators, we use phantom type
 231 constructors for the "c" in the type of "gfoldl" because the result
 232 type of a query does not involve the (polymorphic) type of the term
 233 argument. In the definition of gmapQl we simply use the plain constant
 234 type constructor because gfoldl is left-associative anyway and so it
 235 is readily suited to fold a left-associative binary operation over the
 236 immediate subterms. In the definition of gmapQr, extra effort is
 237 needed. We use a higher-order accumulation trick to mediate between
 238 left-associative constructor application vs. right-associative binary
 239 operation (e.g., (:)). When the query is meant to compute a value of
 240 type r, then the result type withing generic folding is r -> r. So the
 241 result of folding is a function to which we finally pass the right
 242 unit.
 243
 244 -}
 245
 246   -- | A generic query with a right-associative binary operator
 247   gmapQr :: (r' -> r -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
 248   gmapQr o r f x = unQr (gfoldl k (const (Qr id)) x) r
 249     where
 250       k (Qr c) x = Qr (\r -> c (f x `o` r))
 251
 252
 253   -- | A generic query that processes the immediate subterms and returns a list
 254   gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
 255   gmapQ f = gmapQr (:) [] f
 256
 257
 258   -- | A generic query that processes one child by index (zero-based)
 259   gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
 260   gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
 261     where
 262       k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
 263       z f           = Qi 0 Nothing
 264
 265
 266   -- | A generic monadic transformation that maps over the immediate subterms
 267   gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
 268
 269   -- Use immediately the monad datatype constructor
 270   -- to instantiate the type constructor c in the type of gfoldl,
 271   -- so injection and projection is done by return and >>=.
 272   --
 273   gmapM f = gfoldl k return
 274     where
 275       k c x = do c' <- c
 276                  x' <- f x
 277                  return (c' x')
 278
 279
 280   -- | Transformation of at least one immediate subterm does not fail
 281   gmapMp :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 282
 283 {-
 284
 285 The type constructor that we use here simply keeps track of the fact
 286 if we already succeeded for an immediate subterm; see Mp below. To
 287 this end, we couple the monadic computation with a Boolean.
 288
 289 -}
 290
 291   gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
 292                 if b then return x' else mzero
 293     where
 294       z g = Mp (return (g,False))
 295       k (Mp c) x
 296         = Mp ( c >>= \(h,b) ->
 297                  (f x >>= \x' -> return (h x',True))
 298                  `mplus` return (h x,b)
 299              )
 300
 301   -- | Transformation of one immediate subterm with success
 302   gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 303
 304 {-
 305
 306 We use the same pairing trick as for gmapMp,
 307 i.e., we use an extra Bool component to keep track of the
 308 fact whether an immediate subterm was processed successfully.
 309 However, we cut of mapping over subterms once a first subterm
 310 was transformed successfully.
 311
 312 -}
 313
 314   gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
 315                 if b then return x' else mzero
 316     where
 317       z g = Mp (return (g,False))
 318       k (Mp c) x
 319         = Mp ( c >>= \(h,b) -> if b
 320                         then return (h x,b)
 321                         else (f x >>= \x' -> return (h x',True))
 322                              `mplus` return (h x,b)
 323              )
 324
 325
 326 -- | The identity type constructor needed for the definition of gmapT
 327 newtype ID x = ID { unID :: x }
 328
 329
 330 -- | The constant type constructor needed for the definition of gmapQl
 331 newtype CONST c a = CONST { unCONST :: c }
 332
 333
 334 -- | Type constructor for adding counters to queries
 335 data Qi q a = Qi Int (Maybe q)
 336
 337
 338 -- | The type constructor used in definition of gmapQr
 339 newtype Qr r a = Qr { unQr  :: r -> r }
 340
 341
 342 -- | The type constructor used in definition of gmapMp
 343 newtype Mp m x = Mp { unMp :: m (x, Bool) }
 344
 345
 346
 347 ------------------------------------------------------------------------------
 348 --
 349 --      Datatype and constructor representations
 350 --
 351 ------------------------------------------------------------------------------
 352
 353 -- | Representation of datatypes.
 354 --   A package of constructor representations with names of type and module.
 355 --   The list of constructors could be an array, a balanced tree, or others.
 356 --
 357 data DataType = DataType
 358          { tycon    :: String,
 359            tymod    :: String,
 360            datacons :: DataCons
 361          }
 362
 363               deriving Show
 364
 365
 366 -- | Datatype constructors
 367 data DataCons = DataCons [Constr]
 368               | PrimCons PrimCons
 369
 370               deriving Show
 371
 372
 373 -- | Primitive constructors
 374 data PrimCons = PrimStringCons
 375               | PrimIntCons
 376               | PrimFloatCons
 377
 378               deriving (Eq, Show)
 379
 380
 381 -- | Representation of constructors
 382 data Constr =
 383               -- The prime case for algebraic datatypes
 384               DataConstr ConIndex String Fixity
 385
 386               -- Provision for primitive types
 387             | PrimConstr PrimRep
 388
 389               -- Provision for function types
 390             | FunConstr
 391
 392               deriving Show
 393
 394
 395 -- | Primitive types
 396 data PrimRep
 397         = PrimStringRep String
 398         | PrimIntRep    Integer
 399         | PrimFloatRep  Double
 400
 401               deriving (Eq, Show)
 402
 403
 404 -- | Select primitive representation
 405 constrPrimRep :: Constr -> PrimRep
 406 constrPrimRep (PrimConstr x) = x
 407 constrPrimRep _              = error "constrPrimRep"
 408
 409
 410 --
 411 -- Equality of datatype constructors via index.
 412 -- Use designated equalities for primitive types.
 413 --
 414 instance Eq Constr where
 415   (DataConstr i1 _ _) == (DataConstr i2 _ _) = i1 == i2
 416   (PrimConstr x)      == (PrimConstr y)      = x  == y
 417   _                   == _                   = False
 418
 419
 420 -- | Unique index for datatype constructors.
 421 --   Textual order is respected. Starts at 1.
 422 --
 423 type ConIndex = Int
 424
 425
 426 -- | Fixity of constructors
 427 data Fixity = Prefix
 428             | Infix     -- Later: add associativity and precedence
 429             deriving (Eq,Show)
 430
 431
 432
 433 ------------------------------------------------------------------------------
 434 --
 435 --      Constructing representations
 436 --
 437 ------------------------------------------------------------------------------
 438
 439
 440 -- | Make a datatype constructor
 441 mkDataConstr   :: ConIndex -> String -> Fixity -> Constr
 442 --      ToDo: consider adding arity?
 443 mkDataConstr = DataConstr
 444
 445
 446 -- | Make a constructor for primitive types
 447 mkPrimConstr :: PrimRep -> Constr
 448 mkPrimConstr = PrimConstr
 449
 450
 451 -- | Make a package of constructor representations
 452 mkDataType :: Typeable a => [Constr] -> a -> DataType
 453 mkDataType cs x = DataType { tycon    = typeTyCon x
 454                            , tymod    = typeMod x
 455                            , datacons = DataCons cs }
 456
 457
 458 -- | Make a datatype representation for a primitive type
 459 mkPrimType :: Typeable a => PrimCons -> a -> DataType
 460 mkPrimType pc x = DataType { tycon    = typeTyCon x
 461                            , tymod    = typeMod x
 462                            , datacons = PrimCons pc }
 463
 464
 465 ------------------------------------------------------------------------------
 466 --
 467 --      Observing representations
 468 --
 469 ------------------------------------------------------------------------------
 470
 471
 472 -- | Gets the type constructor
 473 dataTyCon :: DataType -> String
 474 dataTyCon = tycon
 475
 476
 477 -- | Gets the module
 478 dataTyMod :: DataType -> String
 479 dataTyMod = tymod
 480
 481
 482 -- | Tests for primitive types
 483 isPrimType :: DataType -> Bool
 484 isPrimType dt = case datacons dt of
 485                      (DataCons _) -> False
 486                      _            -> True
 487
 488
 489 -- | Gets datatype constructors in increasing order of indicies;
 490 dataCons :: DataType -> [Constr]
 491 dataCons dt = case datacons dt of
 492                (DataCons cs) -> cs
 493                _             -> error "dataCons"
 494
 495
 496 -- | Gets datatype constructors in increasing order of indicies;
 497 primCons :: DataType -> PrimCons
 498 primCons dt = case datacons dt of
 499                (PrimCons pc) -> pc
 500                _             -> error "primCons"
 501
 502
 503 -- | Turn a constructor into a string
 504 conString :: Constr -> String
 505 conString (DataConstr _ str _) = str
 506 conString (PrimConstr (PrimStringRep x)) = x
 507 conString (PrimConstr (PrimIntRep x))    = show x
 508 conString (PrimConstr (PrimFloatRep x))  = show x
 509 conString FunConstr = "->"
 510
 511
 512 -- | Determine fixity of a constructor;
 513 --   undefined for primitive types.
 514 conFixity :: Constr -> Fixity
 515 conFixity (DataConstr _ _ fix) = fix
 516 conFixity _                    = undefined
 517
 518
 519 -- | Determine index of a constructor.
 520 --   Undefined for primitive types.
 521 conIndex   :: Constr -> ConIndex
 522 conIndex (DataConstr idx _ _) = idx
 523 conIndex _                    = undefined
 524
 525
 526 -- | Lookup a constructor via a string
 527 stringCon :: DataType -> String -> Maybe Constr
 528 stringCon dt str | not (isPrimType dt)
 529  = worker (dataCons dt)
 530   where
 531     worker []     = Nothing
 532     worker (c:cs) =
 533       case c of
 534         (DataConstr _ str' _) -> if str == str'
 535                                    then Just c
 536                                    else worker cs
 537
 538         -- other forms of Constr not valid here
 539         _ -> error "stringCon"
 540
 541 stringCon dt str | primCons dt == PrimStringCons =
 542   Just $ mkPrimConstr (PrimStringRep str)
 543
 544 stringCon dt str | primCons dt == PrimIntCons =
 545   Just $ mkPrimConstr (PrimIntRep (read str))
 546
 547 stringCon dt str | primCons dt == PrimFloatCons =
 548   Just $ mkPrimConstr (PrimFloatRep (read str))
 549
 550 stringCon _ _ = error "stringCon"
 551
 552
 553 -- | Lookup a constructor by its index;
 554 ---  not defined for primitive types.
 555 indexCon :: DataType -> ConIndex -> Constr
 556 indexCon dt idx = (dataCons dt) !! (idx-1)
 557
 558
 559 -- | Return maximum index;
 560 ---  not defined for primitive types.
 561 maxConIndex :: DataType -> ConIndex
 562 maxConIndex dt = length (dataCons dt)
 563
 564
 565 -- | Determine type constructor for a typeable
 566 typeTyCon :: Typeable a => a -> String
 567 typeTyCon = select         -- Drop module prefix
 568           . typeString     -- Determine full string for type
 569  where
 570   -- Drop *.*.*... before name
 571   select :: String -> String
 572   select x = let x' = dropWhile (not . (==) '.') x
 573               in if x' == [] then x else select (tail x')
 574
 575
 576 -- | Determine module of a typeable
 577 typeMod :: Typeable a => a -> String
 578 typeMod = select         -- Take module prefix
 579         . typeString     -- Determine full string for type
 580  where
 581   -- Take *.*.*... before name
 582   select :: String -> String
 583   select x = let (a,b) = break ((==) '.') x
 584               in if b == ""
 585                   then b
 586                   else a++select' (tail b)
 587     where
 588      select' x = let x' = select x
 589                   in if x' == "" then "" else ('.':x')
 590
 591
 592 -- | Determine full string for type
 593 typeString :: Typeable a => a -> String
 594 typeString = tyconString   -- Turn into string
 595            . typerepTyCon  -- Extract type constructor
 596            . typeOf        -- Query type of term
 597
 598
 599
 600 ------------------------------------------------------------------------------
 601 --
 602 --      Instances of the Data class for Prelude types
 603 --      We define top-level definitions for representations.
 604 --
 605 ------------------------------------------------------------------------------
 606
 607
 608 falseConstr    = mkDataConstr 1 "False" Prefix
 609 trueConstr     = mkDataConstr 2 "True"  Prefix
 610 boolDataType x = mkDataType [falseConstr,trueConstr] x
 611
 612 instance Data Bool where
 613   toConstr False = falseConstr
 614   toConstr True  = trueConstr
 615   fromConstr c = case conIndex c of
 616                    1 -> False
 617                    2 -> True
 618                    _ -> error "fromConstr"
 619   dataTypeOf = boolDataType
 620
 621
 622 ------------------------------------------------------------------------------
 623
 624
 625 instance Data Char where
 626   toConstr x = mkPrimConstr (PrimStringRep [x])
 627   fromConstr (PrimConstr (PrimStringRep [x])) = x
 628   fromConstr _ = error "fromConstr"
 629   dataTypeOf = mkPrimType PrimStringCons
 630
 631
 632 ------------------------------------------------------------------------------
 633
 634
 635 instance Data Float where
 636   toConstr x = mkPrimConstr (PrimFloatRep (realToFrac x))
 637   fromConstr (PrimConstr (PrimFloatRep x)) = realToFrac x
 638   fromConstr _ = error "fromConstr"
 639   dataTypeOf = mkPrimType PrimFloatCons
 640
 641
 642 ------------------------------------------------------------------------------
 643
 644
 645 instance Data Double where
 646   toConstr x = mkPrimConstr (PrimFloatRep x)
 647   fromConstr (PrimConstr (PrimFloatRep x)) = x
 648   fromConstr _ = error "fromConstr"
 649   dataTypeOf = mkPrimType PrimFloatCons
 650
 651
 652 ------------------------------------------------------------------------------
 653
 654
 655 instance Data Int where
 656   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 657   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 658   fromConstr _ = error "fromConstr"
 659   dataTypeOf = mkPrimType PrimIntCons
 660
 661
 662 ------------------------------------------------------------------------------
 663
 664
 665 instance Data Integer where
 666   toConstr x = mkPrimConstr (PrimIntRep x)
 667   fromConstr (PrimConstr (PrimIntRep x)) = x
 668   fromConstr _ = error "fromConstr"
 669   dataTypeOf = mkPrimType PrimIntCons
 670
 671
 672 ------------------------------------------------------------------------------
 673
 674
 675 instance Data Int8 where
 676   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 677   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 678   fromConstr _ = error "fromConstr"
 679   dataTypeOf = mkPrimType PrimIntCons
 680
 681
 682 ------------------------------------------------------------------------------
 683
 684
 685 instance Data Int16 where
 686   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 687   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 688   fromConstr _ = error "fromConstr"
 689   dataTypeOf = mkPrimType PrimIntCons
 690
 691
 692 ------------------------------------------------------------------------------
 693
 694
 695 instance Data Int32 where
 696   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 697   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 698   fromConstr _ = error "fromConstr"
 699   dataTypeOf = mkPrimType PrimIntCons
 700
 701
 702 ------------------------------------------------------------------------------
 703
 704
 705 instance Data Int64 where
 706   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 707   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 708   fromConstr _ = error "fromConstr"
 709   dataTypeOf = mkPrimType PrimIntCons
 710
 711
 712 ------------------------------------------------------------------------------
 713
 714
 715 instance Data Word8 where
 716   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 717   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 718   fromConstr _ = error "fromConstr"
 719   dataTypeOf = mkPrimType PrimIntCons
 720
 721
 722 instance Data Word where
 723   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 724   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 725   fromConstr _ = error "fromConstr"
 726   dataTypeOf = mkPrimType PrimIntCons
 727
 728
 729 ------------------------------------------------------------------------------
 730
 731
 732 instance Data Word16 where
 733   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 734   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 735   fromConstr _ = error "fromConstr"
 736   dataTypeOf = mkPrimType PrimIntCons
 737
 738
 739 ------------------------------------------------------------------------------
 740
 741
 742 instance Data Word32 where
 743   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 744   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 745   fromConstr _ = error "fromConstr"
 746   dataTypeOf = mkPrimType PrimIntCons
 747
 748
 749 ------------------------------------------------------------------------------
 750
 751
 752 instance Data Word64 where
 753   toConstr x = mkPrimConstr (PrimIntRep (fromIntegral x))
 754   fromConstr (PrimConstr (PrimIntRep x)) = fromIntegral x
 755   fromConstr _ = error "fromConstr"
 756   dataTypeOf = mkPrimType PrimIntCons
 757
 758
 759 ------------------------------------------------------------------------------
 760
 761
 762 ratioConstr    = mkDataConstr 1 ":%" Infix
 763 ratioDataType x = mkDataType [ratioConstr] x
 764
 765 instance (Data a, Integral a) => Data (Ratio a) where
 766   toConstr _ = ratioConstr
 767   fromConstr c | conIndex c == 1 = undefined :% undefined
 768   fromConstr _ = error "fromConstr"
 769   dataTypeOf = ratioDataType
 770
 771
 772
 773 ------------------------------------------------------------------------------
 774
 775
 776
 777 nilConstr      = mkDataConstr 1 "[]"  Prefix
 778 consConstr     = mkDataConstr 2 "(:)" Infix
 779 listDataType x = mkDataType [nilConstr,consConstr] x
 780
 781 instance Data a => Data [a] where
 782   gfoldl f z []     = z []
 783   gfoldl f z (x:xs) = z (:) `f` x `f` xs
 784   toConstr []    = nilConstr
 785   toConstr (_:_) = consConstr
 786   fromConstr c = case conIndex c of
 787                    1 -> []
 788                    2 -> undefined:undefined
 789                    _ -> error "fromConstr"
 790   dataTypeOf = listDataType
 791   cast0to1   = cast1
 792
 793 --
 794 -- The gmaps are given as an illustration.
 795 -- This shows that the gmaps for lists are different from list maps.
 796 --
 797   gmapT  f   []     = []
 798   gmapT  f   (x:xs) = (f x:f xs)
 799   gmapQ  f   []     = []
 800   gmapQ  f   (x:xs) = [f x,f xs]
 801   gmapM  f   []     = return []
 802   gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
 803
 804
 805 ------------------------------------------------------------------------------
 806
 807
 808 nothingConstr   = mkDataConstr 1 "Nothing" Prefix
 809 justConstr      = mkDataConstr 2 "Just"    Prefix
 810 maybeDataType x = mkDataType [nothingConstr,justConstr] x
 811
 812 instance Data a => Data (Maybe a) where
 813   gfoldl f z Nothing  = z Nothing
 814   gfoldl f z (Just x) = z Just `f` x
 815   toConstr Nothing  = nothingConstr
 816   toConstr (Just _) = justConstr
 817   fromConstr c = case conIndex c of
 818                    1 -> Nothing
 819                    2 -> Just undefined
 820                    _ -> error "fromConstr"
 821   dataTypeOf = maybeDataType
 822   cast0to1   = cast1
 823
 824
 825 ------------------------------------------------------------------------------
 826
 827
 828 ltConstr           = mkDataConstr 1 "LT" Prefix
 829 eqConstr           = mkDataConstr 2 "EQ" Prefix
 830 gtConstr           = mkDataConstr 3 "GT" Prefix
 831 orderingDataType x = mkDataType [ltConstr,eqConstr,gtConstr] x
 832
 833 instance Data Ordering where
 834   gfoldl f z LT  = z LT
 835   gfoldl f z EQ  = z EQ
 836   gfoldl f z GT  = z GT
 837   toConstr LT  = ltConstr
 838   toConstr EQ  = eqConstr
 839   toConstr GT  = gtConstr
 840   fromConstr c = case conIndex c of
 841                    1 -> LT
 842                    2 -> EQ
 843                    3 -> GT
 844                    _ -> error "fromConstr"
 845   dataTypeOf = orderingDataType
 846
 847
 848 ------------------------------------------------------------------------------
 849
 850
 851 leftConstr       = mkDataConstr 1 "Left"  Prefix
 852 rightConstr      = mkDataConstr 2 "Right" Prefix
 853 eitherDataType x = mkDataType [leftConstr,rightConstr] x
 854
 855 instance (Data a, Data b) => Data (Either a b) where
 856   gfoldl f z (Left a)   = z Left  `f` a
 857   gfoldl f z (Right a)  = z Right `f` a
 858   toConstr (Left _)  = leftConstr
 859   toConstr (Right _) = rightConstr
 860   fromConstr c = case conIndex c of
 861                    1 -> Left undefined
 862                    2 -> Right undefined
 863                    _ -> error "fromConstr"
 864   dataTypeOf = eitherDataType
 865   cast0to2   = cast2
 866
 867
 868 ------------------------------------------------------------------------------
 869
 870
 871 --
 872 -- A last resort for functions
 873 --
 874
 875 instance (Data a, Data b) => Data (a -> b) where
 876   toConstr _   = FunConstr
 877   fromConstr _ = error "fromConstr"
 878   dataTypeOf   = error "dataTypeOf"
 879   cast0to2     = cast2
 880
 881
 882 ------------------------------------------------------------------------------
 883
 884
 885 tuple0Constr     = mkDataConstr 1 "()" Prefix
 886 tuple0DataType x = mkDataType [tuple0Constr] x
 887
 888 instance Data () where
 889   toConstr _ = tuple0Constr
 890   fromConstr c | conIndex c == 1 = ()
 891   fromConstr _ = error "fromConstr"
 892   dataTypeOf = tuple0DataType
 893
 894
 895 ------------------------------------------------------------------------------
 896
 897
 898 tuple2Constr     = mkDataConstr 1 "(,)" Infix
 899 tuple2DataType x = mkDataType [tuple2Constr] x
 900
 901 instance (Data a, Data b) => Data (a,b) where
 902   gfoldl f z (a,b) = z (,) `f` a `f` b
 903   toConstr _ = tuple2Constr
 904   fromConstr c = case conIndex c of
 905                    1 -> (undefined,undefined)
 906                    _ -> error "fromConstr"
 907   dataTypeOf = tuple2DataType
 908   cast0to2   = cast2
 909
 910
 911 ------------------------------------------------------------------------------
 912
 913
 914 tuple3Constr     = mkDataConstr 1 "(,,)" Infix
 915 tuple3DataType x = mkDataType [tuple3Constr] x
 916
 917 instance (Data a, Data b, Data c) => Data (a,b,c) where
 918   gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
 919   toConstr _ = tuple3Constr
 920   fromConstr c = case conIndex c of
 921                    1 -> (undefined,undefined,undefined)
 922                    _ -> error "fromConstr"
 923   dataTypeOf = tuple3DataType
 924
 925
 926 ------------------------------------------------------------------------------
 927
 928
 929 tuple4Constr     = mkDataConstr 1 "(,,,)" Infix
 930 tuple4DataType x = mkDataType [tuple4Constr] x
 931
 932 instance (Data a, Data b, Data c, Data d)
 933          => Data (a,b,c,d) where
 934   gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
 935   toConstr _ = tuple4Constr
 936   fromConstr c = case conIndex c of
 937                    1 -> (undefined,undefined,undefined,undefined)
 938                    _ -> error "fromConstr"
 939   dataTypeOf = tuple4DataType
 940
 941
 942 ------------------------------------------------------------------------------
 943
 944
 945 tuple5Constr     = mkDataConstr 1 "(,,,,)" Infix
 946 tuple5DataType x = mkDataType [tuple5Constr] x
 947
 948 instance (Data a, Data b, Data c, Data d, Data e)
 949          => Data (a,b,c,d,e) where
 950   gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
 951   toConstr _ = tuple5Constr
 952   fromConstr c = case conIndex c of
 953                    1 -> (undefined,undefined,undefined,undefined,undefined)
 954                    _ -> error "fromConstr"
 955   dataTypeOf = tuple5DataType
 956
 957
 958 ------------------------------------------------------------------------------
 959
 960
 961 tuple6Constr     = mkDataConstr 1 "(,,,,,)" Infix
 962 tuple6DataType x = mkDataType [tuple6Constr] x
 963
 964 instance (Data a, Data b, Data c, Data d, Data e, Data f)
 965          => Data (a,b,c,d,e,f) where
 966   gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
 967   toConstr _ = tuple6Constr
 968   fromConstr c =
 969     case conIndex c of
 970            1 -> (undefined,undefined,undefined,undefined,undefined,undefined)
 971            _ -> error "fromConstr"
 972   dataTypeOf = tuple6DataType
 973
 974
 975 ------------------------------------------------------------------------------
 976
 977
 978 tuple7Constr     = mkDataConstr 1 "(,,,,,,)" Infix
 979 tuple7DataType x = mkDataType [tuple7Constr] x
 980
 981 instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
 982          => Data (a,b,c,d,e,f,g) where
 983   gfoldl f z (a,b,c,d,e,f',g) =
 984     z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
 985   toConstr _ = tuple7Constr
 986   fromConstr c = case conIndex c of
 987    1 -> (undefined,undefined,undefined,undefined,undefined,undefined,undefined)
 988    _ -> error "fromConstr"
 989   dataTypeOf = tuple7DataType
 990
 991
 992 ------------------------------------------------------------------------------
 993
 994
 995 instance Data TypeRep where
 996   toConstr _   = error "toConstr"
 997   fromConstr _ = error "fromConstr"
 998   dataTypeOf   = error "dataTypeOf"
 999
1000
1001 ------------------------------------------------------------------------------
1002
1003
1004 instance Data TyCon where
1005   toConstr _   = error "toConstr"
1006   fromConstr _ = error "fromConstr"
1007   dataTypeOf   = error "dataTypeOf"
1008
1009
1010 ------------------------------------------------------------------------------
1011
1012
1013 INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType")
1014
1015 instance Data DataType where
1016   toConstr _   = error "toConstr"
1017   fromConstr _ = error "fromConstr"
1018   dataTypeOf   = error "dataTypeOf"
1019
1020
1021 ------------------------------------------------------------------------------
1022
1023
1024 INSTANCE_TYPEABLE0(DataCons,dataConsTc,"DataCons")
1025
1026 instance Data DataCons where
1027   toConstr _   = error "toConstr"
1028   fromConstr _ = error "fromConstr"
1029   dataTypeOf   = error "dataTypeOf"
1030
1031
1032 ------------------------------------------------------------------------------
1033
1034
1035 INSTANCE_TYPEABLE0(PrimCons,primConsTc,"PrimCons")
1036
1037 instance Data PrimCons where
1038   toConstr _   = error "toConstr"
1039   fromConstr _ = error "fromConstr"
1040   dataTypeOf   = error "dataTypeOf"
1041
1042
1043 ------------------------------------------------------------------------------
1044
1045
1046 INSTANCE_TYPEABLE0(Constr,constrTc,"Constr")
1047
1048 instance Data Constr where
1049   toConstr _   = error "toConstr"
1050   fromConstr _ = error "fromConstr"
1051   dataTypeOf   = error "dataTypeOf"
1052
1053
1054 ------------------------------------------------------------------------------
1055
1056
1057 INSTANCE_TYPEABLE0(PrimRep,primRepTc,"PrimRep")
1058
1059 instance Data PrimRep where
1060   toConstr _   = error "toConstr"
1061   fromConstr _ = error "fromConstr"
1062   dataTypeOf   = error "dataTypeOf"
1063
1064
1065 ------------------------------------------------------------------------------
1066
1067
1068 INSTANCE_TYPEABLE0(Fixity,fixityTc,"Fixity")
1069
1070 instance Data Fixity where
1071   toConstr _   = error "toConstr"
1072   fromConstr _ = error "fromConstr"
1073   dataTypeOf   = error "dataTypeOf"
1074
1075
1076 ------------------------------------------------------------------------------