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