Data/Data.hs

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