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