Data.hs 42.2 KB
Newer Older
1
{-# LANGUAGE Trustworthy #-}
2
{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
3

dreixel's avatar
dreixel committed
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Data
-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (local universal quantification)
--
-- \"Scrap your boilerplate\" --- Generic programming in Haskell.
-- See <http://www.cs.vu.nl/boilerplate/>. This module provides
-- the 'Data' class with its primitives for generic programming, along
-- with instances for many datatypes. It corresponds to a merge between
-- the previous "Data.Generics.Basics" and almost all of 
-- "Data.Generics.Instances". The instances that are not present
jpm@cs.uu.nl's avatar
jpm@cs.uu.nl committed
20
21
-- in this module were moved to the @Data.Generics.Instances@ module
-- in the @syb@ package.
dreixel's avatar
dreixel committed
22
--
jpm@cs.uu.nl's avatar
jpm@cs.uu.nl committed
23
24
25
-- For more information, please visit the new
-- SYB wiki: <http://www.cs.uu.nl/wiki/bin/view/GenericProgramming/SYB>.
--
dreixel's avatar
dreixel committed
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
-----------------------------------------------------------------------------

module Data.Data (

        -- * Module Data.Typeable re-exported for convenience
        module Data.Typeable,

        -- * The Data class for processing constructor applications
        Data(
                gfoldl,         -- :: ... -> a -> c a
                gunfold,        -- :: ... -> Constr -> c a
                toConstr,       -- :: a -> Constr
                dataTypeOf,     -- :: a -> DataType
                dataCast1,      -- mediate types and unary type constructors
                dataCast2,      -- mediate types and binary type constructors
                -- Generic maps defined in terms of gfoldl 
                gmapT,
                gmapQ,
                gmapQl,
                gmapQr,
                gmapQi,
                gmapM,
                gmapMp,
                gmapMo
            ),

        -- * Datatype representations
        DataType,       -- abstract, instance of: Show
        -- ** Constructors
        mkDataType,     -- :: String   -> [Constr] -> DataType
        mkIntType,      -- :: String -> DataType
        mkFloatType,    -- :: String -> DataType
dreixel's avatar
dreixel committed
58
        mkCharType,     -- :: String -> DataType
59
        mkNoRepType,    -- :: String -> DataType
dreixel's avatar
dreixel committed
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
        -- ** Observers
        dataTypeName,   -- :: DataType -> String
        DataRep(..),    -- instance of: Eq, Show
        dataTypeRep,    -- :: DataType -> DataRep
        -- ** Convenience functions
        repConstr,      -- :: DataType -> ConstrRep -> Constr
        isAlgType,      -- :: DataType -> Bool
        dataTypeConstrs,-- :: DataType -> [Constr]
        indexConstr,    -- :: DataType -> ConIndex -> Constr
        maxConstrIndex, -- :: DataType -> ConIndex
        isNorepType,    -- :: DataType -> Bool

        -- * Data constructor representations
        Constr,         -- abstract, instance of: Eq, Show
        ConIndex,       -- alias for Int, start at 1
        Fixity(..),     -- instance of: Eq, Show
        -- ** Constructors
        mkConstr,       -- :: DataType -> String -> Fixity -> Constr
78
79
        mkIntegralConstr,-- :: (Integral a) => DataType -> a -> Constr
        mkRealConstr,   -- :: (Real a) => DataType -> a -> Constr
dreixel's avatar
dreixel committed
80
        mkCharConstr,   -- :: DataType -> Char -> Constr
dreixel's avatar
dreixel committed
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
        -- ** Observers
        constrType,     -- :: Constr   -> DataType
        ConstrRep(..),  -- instance of: Eq, Show
        constrRep,      -- :: Constr   -> ConstrRep
        constrFields,   -- :: Constr   -> [String]
        constrFixity,   -- :: Constr   -> Fixity
        -- ** Convenience function: algebraic data types
        constrIndex,    -- :: Constr   -> ConIndex
        -- ** From strings to constructors and vice versa: all data types
        showConstr,     -- :: Constr   -> String
        readConstr,     -- :: DataType -> String -> Maybe Constr

        -- * Convenience functions: take type constructors apart
        tyconUQname,    -- :: String -> String
        tyconModule,    -- :: String -> String

        -- * Generic operations defined in terms of 'gunfold'
        fromConstr,     -- :: Constr -> a
        fromConstrB,    -- :: ... -> Constr -> a
        fromConstrM     -- :: Monad m => ... -> Constr -> m a

  ) where


------------------------------------------------------------------------------

import Prelude -- necessary to get dependencies right

import Data.Typeable
import Data.Maybe
import Control.Monad

-- Imports for the instances
import Data.Int              -- So we can give Data instance for Int8, ...
import Data.Word             -- So we can give Data instance for Word8, ...
#ifdef __GLASGOW_HASKELL__
import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
--import GHC.IOBase            -- So we can give Data instance for IO, Handle
import GHC.Ptr               -- So we can give Data instance for Ptr
import GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr
--import GHC.Stable            -- So we can give Data instance for StablePtr
--import GHC.ST                -- So we can give Data instance for ST
--import GHC.Conc              -- So we can give Data instance for MVar & Co.
import GHC.Arr               -- So we can give Data instance for Array
#else
# ifdef __HUGS__
import Hugs.Prelude( Ratio(..) )
# endif
import Foreign.Ptr
import Foreign.ForeignPtr
import Data.Array
#endif

#include "Typeable.h"



------------------------------------------------------------------------------
--
--      The Data class
--
------------------------------------------------------------------------------

{- |
The 'Data' class comprehends a fundamental primitive 'gfoldl' for
folding over constructor applications, say terms. This primitive can
be instantiated in several ways to map over the immediate subterms
of a term; see the @gmap@ combinators later in this class.  Indeed, a
generic programmer does not necessarily need to use the ingenious gfoldl
primitive but rather the intuitive @gmap@ combinators.  The 'gfoldl'
primitive is completed by means to query top-level constructors, to
turn constructor representations into proper terms, and to list all
possible datatype constructors.  This completion allows us to serve
generic programming scenarios like read, show, equality, term generation.

The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
default definitions in terms of 'gfoldl', leaving open the opportunity
to provide datatype-specific definitions.
(The inclusion of the @gmap@ combinators as members of class 'Data'
allows the programmer or the compiler to derive specialised, and maybe
more efficient code per datatype.  /Note/: 'gfoldl' is more higher-order
than the @gmap@ combinators.  This is subject to ongoing benchmarking
experiments.  It might turn out that the @gmap@ combinators will be
moved out of the class 'Data'.)

Conceptually, the definition of the @gmap@ combinators in terms of the
primitive 'gfoldl' requires the identification of the 'gfoldl' function
arguments.  Technically, we also need to identify the type constructor
@c@ for the construction of the result type from the folded term type.

In the definition of @gmapQ@/x/ combinators, we use phantom type
constructors for the @c@ in the type of 'gfoldl' because the result type
of a query does not involve the (polymorphic) type of the term argument.
In the definition of 'gmapQl' we simply use the plain constant type
constructor because 'gfoldl' is left-associative anyway and so it is
readily suited to fold a left-associative binary operation over the
immediate subterms.  In the definition of gmapQr, extra effort is
needed. We use a higher-order accumulation trick to mediate between
left-associative constructor application vs. right-associative binary
operation (e.g., @(:)@).  When the query is meant to compute a value
of type @r@, then the result type withing generic folding is @r -> r@.
So the result of folding is a function to which we finally pass the
right unit.

With the @-XDeriveDataTypeable@ option, GHC can generate instances of the
'Data' class automatically.  For example, given the declaration

> data T a b = C1 a b | C2 deriving (Typeable, Data)

GHC will generate an instance that is equivalent to

> instance (Data a, Data b) => Data (T a b) where
>     gfoldl k z (C1 a b) = z C1 `k` a `k` b
>     gfoldl k z C2       = z C2
>
>     gunfold k z c = case constrIndex c of
>                         1 -> k (k (z C1))
>                         2 -> z C2
>
>     toConstr (C1 _ _) = con_C1
>     toConstr C2       = con_C2
>
>     dataTypeOf _ = ty_T
>
> con_C1 = mkConstr ty_T "C1" [] Prefix
> con_C2 = mkConstr ty_T "C2" [] Prefix
> ty_T   = mkDataType "Module.T" [con_C1, con_C2]

This is suitable for datatypes that are exported transparently.

-}

class Typeable a => Data a where

  -- | Left-associative fold operation for constructor applications.
  --
  -- The type of 'gfoldl' is a headache, but operationally it is a simple
  -- generalisation of a list fold.
  --
  -- The default definition for 'gfoldl' is @'const' 'id'@, which is
  -- suitable for abstract datatypes with no substructures.
  gfoldl  :: (forall d b. Data d => c (d -> b) -> d -> c b)
                -- ^ defines how nonempty constructor applications are
                -- folded.  It takes the folded tail of the constructor
                -- application and its head, i.e., an immediate subterm,
                -- and combines them in some way.
          -> (forall g. g -> c g)
                -- ^ defines how the empty constructor application is
                -- folded, like the neutral \/ start element for list
                -- folding.
          -> a
                -- ^ structure to be folded.
          -> c a
                -- ^ result, with a type defined in terms of @a@, but
                -- variability is achieved by means of type constructor
                -- @c@ for the construction of the actual result type.

  -- See the 'Data' instances in this file for an illustration of 'gfoldl'.

  gfoldl _ z = z

  -- | Unfolding constructor applications
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
          -> (forall r. r -> c r)
          -> Constr
          -> c a

  -- | Obtaining the constructor from a given datum.
  -- For proper terms, this is meant to be the top-level constructor.
  -- Primitive datatypes are here viewed as potentially infinite sets of
  -- values (i.e., constructors).
  toConstr   :: a -> Constr


  -- | The outer type constructor of the type
  dataTypeOf  :: a -> DataType



------------------------------------------------------------------------------
--
-- Mediate types and type constructors
--
------------------------------------------------------------------------------

  -- | Mediate types and unary type constructors.
  -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined
  -- as 'gcast1'.
  --
  -- The default definition is @'const' 'Nothing'@, which is appropriate
  -- for non-unary type constructors.
  dataCast1 :: Typeable1 t
            => (forall d. Data d => c (t d))
            -> Maybe (c a)
  dataCast1 _ = Nothing

  -- | Mediate types and binary type constructors.
  -- In 'Data' instances of the form @T a b@, 'dataCast2' should be
  -- defined as 'gcast2'.
  --
  -- The default definition is @'const' 'Nothing'@, which is appropriate
  -- for non-binary type constructors.
  dataCast2 :: Typeable2 t
            => (forall d e. (Data d, Data e) => c (t d e))
            -> Maybe (c a)
  dataCast2 _ = Nothing



------------------------------------------------------------------------------
--
--      Typical generic maps defined in terms of gfoldl
--
------------------------------------------------------------------------------


  -- | A generic transformation that maps over the immediate subterms
  --
  -- The default definition instantiates the type constructor @c@ in the
  -- type of 'gfoldl' to an identity datatype constructor, using the
  -- isomorphism pair as injection and projection.
  gmapT :: (forall b. Data b => b -> b) -> a -> a

  -- Use an identity datatype constructor ID (see below)
  -- to instantiate the type constructor c in the type of gfoldl,
  -- and perform injections ID and projections unID accordingly.
  --
  gmapT f x0 = unID (gfoldl k ID x0)
    where
310
      k :: Data d => ID (d->b) -> d -> ID b
dreixel's avatar
dreixel committed
311
312
313
314
      k (ID c) x = ID (c (f x))


  -- | A generic query with a left-associative binary operator
315
  gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
dreixel's avatar
dreixel committed
316
317
  gmapQl o r f = unCONST . gfoldl k z
    where
318
      k :: Data d => CONST r (d->b) -> d -> CONST r b
dreixel's avatar
dreixel committed
319
      k c x = CONST $ (unCONST c) `o` f x
320
      z :: g -> CONST r g
dreixel's avatar
dreixel committed
321
322
323
      z _   = CONST r

  -- | A generic query with a right-associative binary operator
324
  gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
dreixel's avatar
dreixel committed
325
326
  gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
    where
327
      k :: Data d => Qr r (d->b) -> d -> Qr r b
dreixel's avatar
dreixel committed
328
329
330
331
332
333
334
335
336
337
338
      k (Qr c) x = Qr (\r -> c (f x `o` r))


  -- | A generic query that processes the immediate subterms and returns a list
  -- of results.  The list is given in the same order as originally specified
  -- in the declaratoin of the data constructors.
  gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
  gmapQ f = gmapQr (:) [] f


  -- | A generic query that processes one child by index (zero-based)
339
  gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> a -> u
dreixel's avatar
dreixel committed
340
341
  gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
    where
342
      k :: Data d => Qi u (d -> b) -> d -> Qi u b
dreixel's avatar
dreixel committed
343
      k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
344
      z :: g -> Qi q g
dreixel's avatar
dreixel committed
345
346
347
348
349
350
351
352
      z _           = Qi 0 Nothing


  -- | A generic monadic transformation that maps over the immediate subterms
  --
  -- The default definition instantiates the type constructor @c@ in
  -- the type of 'gfoldl' to the monad datatype constructor, defining
  -- injection and projection using 'return' and '>>='.
353
  gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a
dreixel's avatar
dreixel committed
354
355
356
357
358
359
360

  -- Use immediately the monad datatype constructor 
  -- to instantiate the type constructor c in the type of gfoldl,
  -- so injection and projection is done by return and >>=.
  --  
  gmapM f = gfoldl k return
    where
361
      k :: Data d => m (d -> b) -> d -> m b
dreixel's avatar
dreixel committed
362
363
364
365
366
367
      k c x = do c' <- c
                 x' <- f x
                 return (c' x')


  -- | Transformation of at least one immediate subterm does not fail
368
  gmapMp :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
dreixel's avatar
dreixel committed
369
370
371
372
373
374
375
376
377
378
379
380

{-

The type constructor that we use here simply keeps track of the fact
if we already succeeded for an immediate subterm; see Mp below. To
this end, we couple the monadic computation with a Boolean.

-}

  gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
                if b then return x' else mzero
    where
381
      z :: g -> Mp m g
dreixel's avatar
dreixel committed
382
      z g = Mp (return (g,False))
383
      k :: Data d => Mp m (d -> b) -> d -> Mp m b
dreixel's avatar
dreixel committed
384
385
386
387
388
389
390
      k (Mp c) y
        = Mp ( c >>= \(h, b) ->
                 (f y >>= \y' -> return (h y', True))
                 `mplus` return (h y, b)
             )

  -- | Transformation of one immediate subterm with success
391
  gmapMo :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
dreixel's avatar
dreixel committed
392
393
394
395
396
397
398
399
400
401
402
403
404
405

{-

We use the same pairing trick as for gmapMp, 
i.e., we use an extra Bool component to keep track of the 
fact whether an immediate subterm was processed successfully.
However, we cut of mapping over subterms once a first subterm
was transformed successfully.

-}

  gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
                if b then return x' else mzero
    where
406
      z :: g -> Mp m g
dreixel's avatar
dreixel committed
407
      z g = Mp (return (g,False))
408
      k :: Data d => Mp m (d -> b) -> d -> Mp m b
dreixel's avatar
dreixel committed
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
      k (Mp c) y
        = Mp ( c >>= \(h,b) -> if b
                        then return (h y, b)
                        else (f y >>= \y' -> return (h y',True))
                             `mplus` return (h y, b)
             )


-- | The identity type constructor needed for the definition of gmapT
newtype ID x = ID { unID :: x }


-- | The constant type constructor needed for the definition of gmapQl
newtype CONST c a = CONST { unCONST :: c }


-- | Type constructor for adding counters to queries
data Qi q a = Qi Int (Maybe q)


-- | The type constructor used in definition of gmapQr
newtype Qr r a = Qr { unQr  :: r -> r }


-- | The type constructor used in definition of gmapMp
newtype Mp m x = Mp { unMp :: m (x, Bool) }



------------------------------------------------------------------------------
--
--      Generic unfolding
--
------------------------------------------------------------------------------


-- | Build a term skeleton
fromConstr :: Data a => Constr -> a
447
fromConstr = fromConstrB (error "Data.Data.fromConstr")
dreixel's avatar
dreixel committed
448
449
450
451
452
453
454
455
456


-- | Build a term and use a generic function for subterms
fromConstrB :: Data a
            => (forall d. Data d => d)
            -> Constr
            -> a
fromConstrB f = unID . gunfold k z
 where
457
  k :: forall b r. Data b => ID (b -> r) -> ID r
dreixel's avatar
dreixel committed
458
  k c = ID (unID c f)
459
460
 
  z :: forall r. r -> ID r
dreixel's avatar
dreixel committed
461
462
463
464
  z = ID


-- | Monadic variation on 'fromConstrB'
465
fromConstrM :: forall m a. (Monad m, Data a)
dreixel's avatar
dreixel committed
466
467
468
469
470
            => (forall d. Data d => m d)
            -> Constr
            -> m a
fromConstrM f = gunfold k z
 where
471
  k :: forall b r. Data b => m (b -> r) -> m r
dreixel's avatar
dreixel committed
472
  k c = do { c' <- c; b <- f; return (c' b) }
473
474

  z :: forall r. r -> m r
dreixel's avatar
dreixel committed
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
  z = return



------------------------------------------------------------------------------
--
--      Datatype and constructor representations
--
------------------------------------------------------------------------------


--
-- | Representation of datatypes.
-- A package of constructor representations with names of type and module.
--
data DataType = DataType
                        { tycon   :: String
                        , datarep :: DataRep
                        }

              deriving Show

497
498
499
-- | Representation of constructors. Note that equality on constructors
-- with different types may not work -- i.e. the constructors for 'False' and
-- 'Nothing' may compare equal.
dreixel's avatar
dreixel committed
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
data Constr = Constr
                        { conrep    :: ConstrRep
                        , constring :: String
                        , confields :: [String] -- for AlgRep only
                        , confixity :: Fixity   -- for AlgRep only
                        , datatype  :: DataType
                        }

instance Show Constr where
 show = constring


-- | Equality of constructors
instance Eq Constr where
  c == c' = constrRep c == constrRep c'


-- | Public representation of datatypes
data DataRep = AlgRep [Constr]
             | IntRep
             | FloatRep
dreixel's avatar
dreixel committed
521
             | CharRep
dreixel's avatar
dreixel committed
522
523
524
525
526
527
528
529
530
             | NoRep

            deriving (Eq,Show)
-- The list of constructors could be an array, a balanced tree, or others.


-- | Public representation of constructors
data ConstrRep = AlgConstr    ConIndex
               | IntConstr    Integer
531
               | FloatConstr  Rational
dreixel's avatar
dreixel committed
532
               | CharConstr   Char
dreixel's avatar
dreixel committed
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581

               deriving (Eq,Show)


-- | Unique index for datatype constructors,
-- counting from 1 in the order they are given in the program text.
type ConIndex = Int


-- | Fixity of constructors
data Fixity = Prefix
            | Infix     -- Later: add associativity and precedence

            deriving (Eq,Show)


------------------------------------------------------------------------------
--
--      Observers for datatype representations
--
------------------------------------------------------------------------------


-- | Gets the type constructor including the module
dataTypeName :: DataType -> String
dataTypeName = tycon



-- | Gets the public presentation of a datatype
dataTypeRep :: DataType -> DataRep
dataTypeRep = datarep


-- | Gets the datatype of a constructor
constrType :: Constr -> DataType
constrType = datatype


-- | Gets the public presentation of constructors
constrRep :: Constr -> ConstrRep
constrRep = conrep


-- | Look up a constructor by its representation
repConstr :: DataType -> ConstrRep -> Constr
repConstr dt cr =
      case (dataTypeRep dt, cr) of
        (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
582
        (IntRep,    IntConstr i)      -> mkIntegralConstr dt i
583
        (FloatRep,  FloatConstr f)    -> mkRealConstr dt f
dreixel's avatar
dreixel committed
584
        (CharRep,   CharConstr c)     -> mkCharConstr dt c
585
        _ -> error "Data.Data.repConstr"
dreixel's avatar
dreixel committed
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622



------------------------------------------------------------------------------
--
--      Representations of algebraic data types
--
------------------------------------------------------------------------------


-- | Constructs an algebraic datatype
mkDataType :: String -> [Constr] -> DataType
mkDataType str cs = DataType
                        { tycon   = str
                        , datarep = AlgRep cs
                        }


-- | Constructs a constructor
mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
mkConstr dt str fields fix =
        Constr
                { conrep    = AlgConstr idx
                , constring = str
                , confields = fields
                , confixity = fix
                , datatype  = dt
                }
  where
    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
                     showConstr c == str ]


-- | Gets the constructors of an algebraic datatype
dataTypeConstrs :: DataType -> [Constr]
dataTypeConstrs dt = case datarep dt of
                        (AlgRep cons) -> cons
623
                        _ -> error "Data.Data.dataTypeConstrs"
dreixel's avatar
dreixel committed
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656


-- | Gets the field labels of a constructor.  The list of labels
-- is returned in the same order as they were given in the original 
-- constructor declaration.
constrFields :: Constr -> [String]
constrFields = confields


-- | Gets the fixity of a constructor
constrFixity :: Constr -> Fixity
constrFixity = confixity



------------------------------------------------------------------------------
--
--      From strings to constr's and vice versa: all data types
--      
------------------------------------------------------------------------------


-- | Gets the string for a constructor
showConstr :: Constr -> String
showConstr = constring


-- | Lookup a constructor via a string
readConstr :: DataType -> String -> Maybe Constr
readConstr dt str =
      case dataTypeRep dt of
        AlgRep cons -> idx cons
        IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
dreixel's avatar
dreixel committed
657
        FloatRep    -> mkReadCon ffloat
dreixel's avatar
dreixel committed
658
        CharRep     -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
dreixel's avatar
dreixel committed
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
        NoRep       -> Nothing
  where

    -- Read a value and build a constructor
    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
    mkReadCon f = case (reads str) of
                    [(t,"")] -> Just (f t)
                    _ -> Nothing

    -- Traverse list of algebraic datatype constructors
    idx :: [Constr] -> Maybe Constr
    idx cons = let fit = filter ((==) str . showConstr) cons
                in if fit == []
                     then Nothing
                     else Just (head fit)

dreixel's avatar
dreixel committed
675
676
    ffloat :: Double -> Constr
    ffloat =  mkPrimCon dt str . FloatConstr . toRational
dreixel's avatar
dreixel committed
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695

------------------------------------------------------------------------------
--
--      Convenience funtions: algebraic data types
--
------------------------------------------------------------------------------


-- | Test for an algebraic type
isAlgType :: DataType -> Bool
isAlgType dt = case datarep dt of
                 (AlgRep _) -> True
                 _ -> False


-- | Gets the constructor for an index (algebraic datatypes only)
indexConstr :: DataType -> ConIndex -> Constr
indexConstr dt idx = case datarep dt of
                        (AlgRep cs) -> cs !! (idx-1)
696
                        _           -> error "Data.Data.indexConstr"
dreixel's avatar
dreixel committed
697
698
699
700
701
702


-- | Gets the index of a constructor (algebraic datatypes only)
constrIndex :: Constr -> ConIndex
constrIndex con = case constrRep con of
                    (AlgConstr idx) -> idx
703
                    _ -> error "Data.Data.constrIndex"
dreixel's avatar
dreixel committed
704
705
706
707
708
709


-- | Gets the maximum constructor index of an algebraic datatype
maxConstrIndex :: DataType -> ConIndex
maxConstrIndex dt = case dataTypeRep dt of
                        AlgRep cs -> length cs
710
                        _            -> error "Data.Data.maxConstrIndex"
dreixel's avatar
dreixel committed
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730



------------------------------------------------------------------------------
--
--      Representation of primitive types
--
------------------------------------------------------------------------------


-- | Constructs the 'Int' type
mkIntType :: String -> DataType
mkIntType = mkPrimType IntRep


-- | Constructs the 'Float' type
mkFloatType :: String -> DataType
mkFloatType = mkPrimType FloatRep


dreixel's avatar
dreixel committed
731
732
733
734
-- | Constructs the 'Char' type
mkCharType :: String -> DataType
mkCharType = mkPrimType CharRep

dreixel's avatar
dreixel committed
735

736
-- | Helper for 'mkIntType', 'mkFloatType'
dreixel's avatar
dreixel committed
737
738
739
740
741
742
743
744
745
746
747
748
749
mkPrimType :: DataRep -> String -> DataType
mkPrimType dr str = DataType
                        { tycon   = str
                        , datarep = dr
                        }


-- Makes a constructor for primitive types
mkPrimCon :: DataType -> String -> ConstrRep -> Constr
mkPrimCon dt str cr = Constr
                        { datatype  = dt
                        , conrep    = cr
                        , constring = str
750
751
                        , confields = error "Data.Data.confields"
                        , confixity = error "Data.Data.confixity"
dreixel's avatar
dreixel committed
752
753
                        }

Ian Lynagh's avatar
Ian Lynagh committed
754
mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr
755
756
mkIntegralConstr dt i = case datarep dt of
                  IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))
757
                  _ -> error "Data.Data.mkIntegralConstr"
dreixel's avatar
dreixel committed
758

Ian Lynagh's avatar
Ian Lynagh committed
759
mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr
760
761
mkRealConstr dt f = case datarep dt of
                    FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
762
                    _ -> error "Data.Data.mkRealConstr"
dreixel's avatar
dreixel committed
763

dreixel's avatar
dreixel committed
764
765
766
767
-- | Makes a constructor for 'Char'.
mkCharConstr :: DataType -> Char -> Constr
mkCharConstr dt c = case datarep dt of
                   CharRep -> mkPrimCon dt (show c) (CharConstr c)
768
                   _ -> error "Data.Data.mkCharConstr"
dreixel's avatar
dreixel committed
769

dreixel's avatar
dreixel committed
770
771
772
773
774
775
776
777

------------------------------------------------------------------------------
--
--      Non-representations for non-presentable types
--
------------------------------------------------------------------------------


778
779
780
781
782
783
-- | Constructs a non-representation for a non-presentable type
mkNoRepType :: String -> DataType
mkNoRepType str = DataType
                        { tycon   = str
                        , datarep = NoRep
                        }
dreixel's avatar
dreixel committed
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844

-- | Test for a non-representable type
isNorepType :: DataType -> Bool
isNorepType dt = case datarep dt of
                   NoRep -> True
                   _ -> False



------------------------------------------------------------------------------
--
--      Convenience for qualified type constructors
--
------------------------------------------------------------------------------


-- | Gets the unqualified type constructor:
-- drop *.*.*... before name
--
tyconUQname :: String -> String
tyconUQname x = let x' = dropWhile (not . (==) '.') x
                 in if x' == [] then x else tyconUQname (tail x')


-- | Gets the module of a type constructor:
-- take *.*.*... before name
tyconModule :: String -> String
tyconModule x = let (a,b) = break ((==) '.') x
                 in if b == ""
                      then b
                      else a ++ tyconModule' (tail b)
  where
    tyconModule' y = let y' = tyconModule y
                      in if y' == "" then "" else ('.':y')




------------------------------------------------------------------------------
------------------------------------------------------------------------------
--
--      Instances of the Data class for Prelude-like types.
--      We define top-level definitions for representations.
--
------------------------------------------------------------------------------


falseConstr :: Constr
falseConstr  = mkConstr boolDataType "False" [] Prefix
trueConstr :: Constr
trueConstr   = mkConstr boolDataType "True"  [] Prefix

boolDataType :: DataType
boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]

instance Data Bool where
  toConstr False = falseConstr
  toConstr True  = trueConstr
  gunfold _ z c  = case constrIndex c of
                     1 -> z False
                     2 -> z True
845
                     _ -> error "Data.Data.gunfold(Bool)"
dreixel's avatar
dreixel committed
846
847
848
849
850
851
  dataTypeOf _ = boolDataType


------------------------------------------------------------------------------

charType :: DataType
dreixel's avatar
dreixel committed
852
charType = mkCharType "Prelude.Char"
dreixel's avatar
dreixel committed
853
854

instance Data Char where
dreixel's avatar
dreixel committed
855
  toConstr x = mkCharConstr charType x
dreixel's avatar
dreixel committed
856
  gunfold _ z c = case constrRep c of
dreixel's avatar
dreixel committed
857
                    (CharConstr x) -> z x
858
                    _ -> error "Data.Data.gunfold(Char)"
dreixel's avatar
dreixel committed
859
860
861
862
863
864
865
866
867
  dataTypeOf _ = charType


------------------------------------------------------------------------------

floatType :: DataType
floatType = mkFloatType "Prelude.Float"

instance Data Float where
868
  toConstr = mkRealConstr floatType
dreixel's avatar
dreixel committed
869
870
  gunfold _ z c = case constrRep c of
                    (FloatConstr x) -> z (realToFrac x)
871
                    _ -> error "Data.Data.gunfold(Float)"
dreixel's avatar
dreixel committed
872
873
874
875
876
877
878
879
880
  dataTypeOf _ = floatType


------------------------------------------------------------------------------

doubleType :: DataType
doubleType = mkFloatType "Prelude.Double"

instance Data Double where
881
  toConstr = mkRealConstr doubleType
dreixel's avatar
dreixel committed
882
  gunfold _ z c = case constrRep c of
883
                    (FloatConstr x) -> z (realToFrac x)
884
                    _ -> error "Data.Data.gunfold(Double)"
dreixel's avatar
dreixel committed
885
886
887
888
889
890
891
892
893
  dataTypeOf _ = doubleType


------------------------------------------------------------------------------

intType :: DataType
intType = mkIntType "Prelude.Int"

instance Data Int where
894
  toConstr x = mkIntegralConstr intType x
dreixel's avatar
dreixel committed
895
896
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
897
                    _ -> error "Data.Data.gunfold(Int)"
dreixel's avatar
dreixel committed
898
899
900
901
902
903
904
905
906
  dataTypeOf _ = intType


------------------------------------------------------------------------------

integerType :: DataType
integerType = mkIntType "Prelude.Integer"

instance Data Integer where
907
  toConstr = mkIntegralConstr integerType
dreixel's avatar
dreixel committed
908
909
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z x
910
                    _ -> error "Data.Data.gunfold(Integer)"
dreixel's avatar
dreixel committed
911
912
913
914
915
916
917
918
919
  dataTypeOf _ = integerType


------------------------------------------------------------------------------

int8Type :: DataType
int8Type = mkIntType "Data.Int.Int8"

instance Data Int8 where
920
  toConstr x = mkIntegralConstr int8Type x
dreixel's avatar
dreixel committed
921
922
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
923
                    _ -> error "Data.Data.gunfold(Int8)"
dreixel's avatar
dreixel committed
924
925
926
927
928
929
930
931
932
  dataTypeOf _ = int8Type


------------------------------------------------------------------------------

int16Type :: DataType
int16Type = mkIntType "Data.Int.Int16"

instance Data Int16 where
933
  toConstr x = mkIntegralConstr int16Type x
dreixel's avatar
dreixel committed
934
935
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
936
                    _ -> error "Data.Data.gunfold(Int16)"
dreixel's avatar
dreixel committed
937
938
939
940
941
942
943
944
945
  dataTypeOf _ = int16Type


------------------------------------------------------------------------------

int32Type :: DataType
int32Type = mkIntType "Data.Int.Int32"

instance Data Int32 where
946
  toConstr x = mkIntegralConstr int32Type x
dreixel's avatar
dreixel committed
947
948
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
949
                    _ -> error "Data.Data.gunfold(Int32)"
dreixel's avatar
dreixel committed
950
951
952
953
954
955
956
957
958
  dataTypeOf _ = int32Type


------------------------------------------------------------------------------

int64Type :: DataType
int64Type = mkIntType "Data.Int.Int64"

instance Data Int64 where
959
  toConstr x = mkIntegralConstr int64Type x
dreixel's avatar
dreixel committed
960
961
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
962
                    _ -> error "Data.Data.gunfold(Int64)"
dreixel's avatar
dreixel committed
963
964
965
966
967
968
969
970
971
  dataTypeOf _ = int64Type


------------------------------------------------------------------------------

wordType :: DataType
wordType = mkIntType "Data.Word.Word"

instance Data Word where
972
  toConstr x = mkIntegralConstr wordType x
dreixel's avatar
dreixel committed
973
974
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
975
                    _ -> error "Data.Data.gunfold(Word)"
dreixel's avatar
dreixel committed
976
977
978
979
980
981
982
983
984
  dataTypeOf _ = wordType


------------------------------------------------------------------------------

word8Type :: DataType
word8Type = mkIntType "Data.Word.Word8"

instance Data Word8 where
985
  toConstr x = mkIntegralConstr word8Type x
dreixel's avatar
dreixel committed
986
987
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
988
                    _ -> error "Data.Data.gunfold(Word8)"
dreixel's avatar
dreixel committed
989
990
991
992
993
994
995
996
997
  dataTypeOf _ = word8Type


------------------------------------------------------------------------------

word16Type :: DataType
word16Type = mkIntType "Data.Word.Word16"

instance Data Word16 where
998
  toConstr x = mkIntegralConstr word16Type x
dreixel's avatar
dreixel committed
999
1000
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
1001
                    _ -> error "Data.Data.gunfold(Word16)"
dreixel's avatar
dreixel committed
1002
1003
1004
1005
1006
1007
1008
1009
1010
  dataTypeOf _ = word16Type


------------------------------------------------------------------------------

word32Type :: DataType
word32Type = mkIntType "Data.Word.Word32"

instance Data Word32 where
1011
  toConstr x = mkIntegralConstr word32Type x
dreixel's avatar
dreixel committed
1012
1013
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
1014
                    _ -> error "Data.Data.gunfold(Word32)"
dreixel's avatar
dreixel committed
1015
1016
1017
1018
1019
1020
1021
1022
1023
  dataTypeOf _ = word32Type


------------------------------------------------------------------------------

word64Type :: DataType
word64Type = mkIntType "Data.Word.Word64"

instance Data Word64 where
1024
  toConstr x = mkIntegralConstr word64Type x
dreixel's avatar
dreixel committed
1025
1026
  gunfold _ z c = case constrRep c of
                    (IntConstr x) -> z (fromIntegral x)
1027
                    _ -> error "Data.Data.gunfold(Word64)"
dreixel's avatar
dreixel committed
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
  dataTypeOf _ = word64Type


------------------------------------------------------------------------------

ratioConstr :: Constr
ratioConstr = mkConstr ratioDataType ":%" [] Infix

ratioDataType :: DataType
ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]

instance (Data a, Integral a) => Data (Ratio a) where
  gfoldl k z (a :% b) = z (:%) `k` a `k` b
  toConstr _ = ratioConstr
  gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
1043
  gunfold _ _ _ = error "Data.Data.gunfold(Ratio)"
dreixel's avatar
dreixel committed
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
  dataTypeOf _  = ratioDataType


------------------------------------------------------------------------------

nilConstr :: Constr
nilConstr    = mkConstr listDataType "[]" [] Prefix
consConstr :: Constr
consConstr   = mkConstr listDataType "(:)" [] Infix

listDataType :: DataType
listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]

instance Data a => Data [a] where
  gfoldl _ z []     = z []
  gfoldl f z (x:xs) = z (:) `f` x `f` xs
  toConstr []    = nilConstr
  toConstr (_:_) = consConstr
  gunfold k z c = case constrIndex c of
                    1 -> z []
                    2 -> k (k (z (:)))
1065
                    _ -> error "Data.Data.gunfold(List)"
dreixel's avatar
dreixel committed
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
  dataTypeOf _ = listDataType
  dataCast1 f  = gcast1 f

--
-- The gmaps are given as an illustration.
-- This shows that the gmaps for lists are different from list maps.
--
  gmapT  _   []     = []
  gmapT  f   (x:xs) = (f x:f xs)
  gmapQ  _   []     = []
  gmapQ  f   (x:xs) = [f x,f xs]
  gmapM  _   []     = return []
  gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')


------------------------------------------------------------------------------

nothingConstr :: Constr
nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
justConstr :: Constr
justConstr    = mkConstr maybeDataType "Just"    [] Prefix

maybeDataType :: DataType
maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]

instance Data a => Data (Maybe a) where
  gfoldl _ z Nothing  = z Nothing
  gfoldl f z (Just x) = z Just `f` x
  toConstr Nothing  = nothingConstr
  toConstr (Just _) = justConstr
  gunfold k z c = case constrIndex c of
                    1 -> z Nothing
                    2 -> k (z Just)
1099
                    _ -> error "Data.Data.gunfold(Maybe)"
dreixel's avatar
dreixel committed
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
  dataTypeOf _ = maybeDataType
  dataCast1 f  = gcast1 f


------------------------------------------------------------------------------

ltConstr :: Constr
ltConstr         = mkConstr orderingDataType "LT" [] Prefix
eqConstr :: Constr
eqConstr         = mkConstr orderingDataType "EQ" [] Prefix
gtConstr :: Constr
gtConstr         = mkConstr orderingDataType "GT" [] Prefix

orderingDataType :: DataType
orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]

instance Data Ordering where
  gfoldl _ z LT  = z LT
  gfoldl _ z EQ  = z EQ
  gfoldl _ z GT  = z GT
  toConstr LT  = ltConstr
  toConstr EQ  = eqConstr
  toConstr GT  = gtConstr
  gunfold _ z c = case constrIndex c of
                    1 -> z LT
                    2 -> z EQ
                    3 -> z GT
1127
                    _ -> error "Data.Data.gunfold(Ordering)"
dreixel's avatar
dreixel committed
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
  dataTypeOf _ = orderingDataType


------------------------------------------------------------------------------

leftConstr :: Constr
leftConstr     = mkConstr eitherDataType "Left"  [] Prefix

rightConstr :: Constr
rightConstr    = mkConstr eitherDataType "Right" [] Prefix

eitherDataType :: DataType
eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]

instance (Data a, Data b) => Data (Either a b) where
  gfoldl f z (Left a)   = z Left  `f` a
  gfoldl f z (Right a)  = z Right `f` a
  toConstr (Left _)  = leftConstr
  toConstr (Right _) = rightConstr
  gunfold k z c = case constrIndex c of
                    1 -> k (z Left)
                    2 -> k (z Right)
1150
                    _ -> error "Data.Data.gunfold(Either)"
dreixel's avatar
dreixel committed
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
  dataTypeOf _ = eitherDataType
  dataCast2 f  = gcast2 f


------------------------------------------------------------------------------

tuple0Constr :: Constr
tuple0Constr = mkConstr tuple0DataType "()" [] Prefix

tuple0DataType :: DataType
tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]

instance Data () where
  toConstr ()   = tuple0Constr
  gunfold _ z c | constrIndex c == 1 = z ()
1166
  gunfold _ _ _ = error "Data.Data.gunfold(unit)"
dreixel's avatar
dreixel committed
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
  dataTypeOf _  = tuple0DataType


------------------------------------------------------------------------------

tuple2Constr :: Constr
tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix

tuple2DataType :: DataType
tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]

instance (Data a, Data b) => Data (a,b) where
  gfoldl f z (a,b) = z (,) `f` a `f` b
  toConstr (_,_) = tuple2Constr
  gunfold k z c | constrIndex c == 1 = k (k (z (,)))
1182
  gunfold _ _ _ = error "Data.Data.gunfold(tup2)"
dreixel's avatar
dreixel committed
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
  dataTypeOf _  = tuple2DataType
  dataCast2 f   = gcast2 f


------------------------------------------------------------------------------

tuple3Constr :: Constr
tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix

tuple3DataType :: DataType
1193
tuple3DataType = mkDataType "Prelude.(,,)" [tuple3Constr]
dreixel's avatar
dreixel committed
1194
1195
1196
1197
1198

instance (Data a, Data b, Data c) => Data (a,b,c) where
  gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
  toConstr (_,_,_) = tuple3Constr
  gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
1199
  gunfold _ _ _ = error "Data.Data.gunfold(tup3)"
dreixel's avatar
dreixel committed
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
  dataTypeOf _  = tuple3DataType


------------------------------------------------------------------------------

tuple4Constr :: Constr
tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix

tuple4DataType :: DataType
tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]

instance (Data a, Data b, Data c, Data d)
         => Data (a,b,c,d) where
  gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
  toConstr (_,_,_,_) = tuple4Constr
  gunfold k z c = case constrIndex c of
                    1 -> k (k (k (k (z (,,,)))))
1217
                    _ -> error "Data.Data.gunfold(tup4)"
dreixel's avatar
dreixel committed
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
  dataTypeOf _ = tuple4DataType


------------------------------------------------------------------------------

tuple5Constr :: Constr
tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix

tuple5DataType :: DataType
tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]

instance (Data a, Data b, Data c, Data d, Data e)
         => Data (a,b,c,d,e) where
  gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
  toConstr (_,_,_,_,_) = tuple5Constr
  gunfold k z c = case constrIndex c of
                    1 -> k (k (k (k (k (z (,,,,))))))
1235
                    _ -> error "Data.Data.gunfold(tup5)"
dreixel's avatar
dreixel committed
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
  dataTypeOf _ = tuple5DataType


------------------------------------------------------------------------------

tuple6Constr :: Constr
tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix

tuple6DataType :: DataType
tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]

instance (Data a, Data b, Data c, Data d, Data e, Data f)
         => Data (a,b,c,d,e,f) where
  gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
  toConstr (_,_,_,_,_,_) = tuple6Constr
  gunfold k z c = case constrIndex c of
                    1 -> k (k (k (k (k (k (z (,,,,,)))))))
1253
                    _ -> error "Data.Data.gunfold(tup6)"
dreixel's avatar
dreixel committed
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
  dataTypeOf _ = tuple6DataType


------------------------------------------------------------------------------

tuple7Constr :: Constr
tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix

tuple7DataType :: DataType
tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]

instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
         => Data (a,b,c,d,e,f,g) where
  gfoldl f z (a,b,c,d,e,f',g) =
    z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
  toConstr  (_,_,_,_,_,_,_) = tuple7Constr
  gunfold k z c = case constrIndex c of
                    1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
1272
                    _ -> error "Data.Data.gunfold(tup7)"
dreixel's avatar
dreixel committed
1273
1274
1275
1276
1277
1278
  dataTypeOf _ = tuple7DataType


------------------------------------------------------------------------------

instance Typeable a => Data (Ptr a) where
1279
1280
  toConstr _   = error "Data.Data.toConstr(Ptr)"
  gunfold _ _  = error "Data.Data.gunfold(Ptr)"
1281
  dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"
dreixel's avatar
dreixel committed
1282
1283
1284
1285
1286


------------------------------------------------------------------------------

instance Typeable a => Data (ForeignPtr a) where
1287
1288
  toConstr _   = error "Data.Data.toConstr(ForeignPtr)"
  gunfold _ _  = error "Data.Data.gunfold(ForeignPtr)"
1289
  dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"
dreixel's avatar
dreixel committed
1290
1291
1292
1293
1294
1295
1296
1297


------------------------------------------------------------------------------
-- The Data instance for Array preserves data abstraction at the cost of 
-- inefficiency. We omit reflection services for the sake of data abstraction.
instance (Typeable a, Data b, Ix a) => Data (Array a b)
 where
  gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
1298
1299
  toConstr _   = error "Data.Data.toConstr(Array)"
  gunfold _ _  = error "Data.Data.gunfold(Array)"
1300
  dataTypeOf _ = mkNoRepType "Data.Array.Array"
dreixel's avatar
dreixel committed
1301