Data/Generics.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics
   4 -- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org, ralf@cwi.nl
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- Generic programming in Haskell;
  12 -- see <http://www.cs.vu.nl/boilerplate>.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Data.Generics (
  17
  18         -- The Typeable class and the type-safe cast operation;
  19         -- re-exported for convenience
  20         Typeable(..), cast,
  21
  22         -- * Prime types of generic functions
  23         GenericT, GenericQ, GenericM, GenericG,
  24
  25         -- * Combinators to \"make\" generic functions
  26         mkT, mkQ, mkM, mkF, mkG,
  27         extT, extQ, extM, extF, extG,
  28
  29         -- * The Data class for folding and unfolding constructor applications
  30         Data(
  31               gfoldl,
  32               gunfold,
  33               conOf,
  34               consOf
  35             ),
  36
  37         -- * Typical generic maps defined in terms of gfoldl
  38
  39         gmapT,
  40         gmapQ,
  41         gmapM,
  42         gmapF,
  43
  44         -- * The Constr datatype for describing datatype constructors
  45         Constr(..),
  46
  47         -- * Frequently used generic traversal schemes
  48         everywhere,
  49         everywhere',
  50         everywhereBut,
  51         everywhereM,
  52         somewhere,
  53         everything,
  54         something,
  55         synthesize,
  56
  57         -- * Generic operations such as show, equality, read
  58         glength,
  59         gcount,
  60         gnodecount,
  61         gtypecount,
  62         gshow,
  63         geq,
  64         gzip,
  65         gread,
  66
  67         -- * Miscellaneous
  68         sameType, orElse
  69
  70 #ifndef __HADDOCK__
  71         ,
  72         -- Data types for the sum-of-products type encoding;
  73         -- included for backwards compatibility; maybe obsolete
  74         (:*:)(..), (:+:)(..), Unit(..)
  75 #endif
  76
  77  ) where
  78
  79 ------------------------------------------------------------------------------
  80
  81 import Prelude  -- So that 'make depend' works
  82
  83 #ifdef __GLASGOW_HASKELL__
  84 #ifndef __HADDOCK__
  85 import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) )
  86 #endif
  87 #endif
  88
  89 import Data.Maybe
  90 import Data.Dynamic
  91 import Control.Monad
  92
  93
  94
  95 ------------------------------------------------------------------------------
  96 --
  97 --      Prime types of generic functions
  98 --
  99 ------------------------------------------------------------------------------
 100
 101 -- | Generic transformations,
 102 --   i.e., take an \"a\" and return an \"a\"
 103 --
 104 type GenericT = forall a. Data a => a -> a
 105
 106
 107 -- | Generic queries of type "r",
 108 --   i.e., take any \"a\" and return an \"r\"
 109 --
 110 type GenericQ r = forall a. Data a => a -> r
 111
 112
 113 -- | Generic monadic transformations,
 114 --   i.e., take an \"a\" and compute an \"a\"
 115 --
 116 type GenericM m = forall a. Data a => a -> m a
 117
 118
 119 -- | Generic generators with input i,
 120 --   i.e., take an \"i\" and compute a tuple of type (a,i)
 121 --
 122 type GenericG m i = forall a. Data a => i -> m (a,i)
 123
 124
 125
 126 ------------------------------------------------------------------------------
 127 --
 128 --      Combinators to "make" generic functions
 129 --      We use type-safe cast in a number of ways to make generic functions.
 130 --
 131 ------------------------------------------------------------------------------
 132
 133 -- | Make a generic transformation;
 134 --   start from a type-specific case;
 135 --   preserve the term otherwise
 136 --
 137 mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
 138 mkT f = case cast f of
 139                Just g -> g
 140                Nothing -> id
 141
 142
 143 -- | Make a generic query;
 144 --   start from a type-specific case;
 145 --   return a constant otherwise
 146 --
 147 mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
 148 (r `mkQ` br) a = case cast a of
 149                     Just b  -> br b
 150                     Nothing -> r
 151
 152
 153 -- | Make a generic monadic transformation;
 154 --   start from a type-specific case;
 155 --   resort to return otherwise
 156 --
 157 mkM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
 158     => (b -> m b) -> a -> m a
 159 mkM f = case cast f of
 160           Just g  -> g
 161           Nothing -> return
 162
 163
 164 {-
 165
 166 For the remaining definitions, we stick to a more concise style, i.e.,
 167 we fold maybies with "maybe" instead of case ... of ..., and we also
 168 use a point-free style whenever possible.
 169
 170 -}
 171
 172
 173 -- | Make a generic monadic transformation for MonadPlus;
 174 --   use "const mzero" (i.e., failure) instead of return as default.
 175 --
 176 mkF :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), MonadPlus m)
 177     => (b -> m b) -> a -> m a
 178 mkF = maybe (const mzero) id . cast
 179
 180
 181 -- | Make a generic generator;
 182 --   start from a type-specific ase;
 183 --   resort to empty generation otherwise
 184 --
 185 mkG :: (Typeable a, Typeable b,
 186         Typeable i,
 187         Typeable (m (a,i)), Typeable (m (b,i)),
 188         MonadPlus m)
 189     => (i -> m (b,i)) -> i -> m (a,i)
 190 mkG = maybe (const mzero) id . cast
 191
 192
 193 -- | Extend a generic transformation by a type-specific case
 194 extT :: (Typeable a, Typeable b) => (a -> a) -> (b -> b) -> a -> a
 195 extT f = maybe f id . cast
 196
 197
 198 -- | Extend a generic query by a type-specific case
 199 extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
 200 extQ f g a = maybe (f a) g (cast a)
 201
 202
 203 -- | Extend a generic monadic transformation by a type-specific case
 204 extM :: (Typeable a, Typeable b,
 205          Typeable (m a), Typeable (m b),
 206          Monad m)
 207      => (a -> m a) -> (b -> m b) -> a -> m a
 208 extM f = maybe f id . cast
 209
 210
 211 -- | Extend a generic MonadPlus transformation by a type-specific case
 212 extF :: (Typeable a, Typeable b,
 213          Typeable (m a), Typeable (m b),
 214          MonadPlus m)
 215      => (a -> m a) -> (b -> m b) -> a -> m a
 216 extF = extM
 217
 218
 219 -- | Extend a generic generator by a type-specific case
 220 extG :: (Typeable a, Typeable b,
 221          Typeable i,
 222          Typeable (m (a,i)), Typeable (m (b,i)),
 223          MonadPlus m)
 224      => (i -> m (a,i)) -> (i -> m (b,i)) -> i -> m (a,i)
 225 extG f = maybe f id . cast
 226
 227
 228
 229 ------------------------------------------------------------------------------
 230 --
 231 --      The Data class
 232 --
 233 ------------------------------------------------------------------------------
 234
 235 class Typeable a => Data a where
 236
 237   -- | Left-associative fold operation for constructor applications
 238   gfoldl  :: (forall a b. Data a => c (a -> b) -> a -> c b)
 239           -> (forall g. g -> c g)
 240           -> a -> c a
 241
 242   -- | Unfold operation to build terms from constructors and others
 243   gunfold :: (forall a b. Data a => c (a -> b) -> c b)
 244           -> (forall g. g -> c g)
 245           -> Constr
 246           -> c a
 247
 248   -- Default definition for gfoldl
 249   -- which copes immediately with basic datatypes
 250   --
 251   gfoldl _ z = z
 252
 253   -- | Obtain the constructor from a given term
 254   conOf   :: a -> Constr
 255
 256   -- | List all constructors for a given type
 257   consOf  :: a -> [Constr]
 258
 259 {-
 260
 261 The combinators gmapT, gmapQ, gmapM, gmapF can all be defined in terms
 262 of gfoldl. We provide corresponding default definitions leaving open
 263 the opportunity to provide datatype-specific definitions if needed.
 264
 265 (Also, the inclusion of the gmap combinators as members of class Data
 266 allows the programmer or the compiler to derive specialised, and maybe
 267 more efficient code per datatype. Note: gfoldl is more higher-order
 268 than the gmap combinators. This is subject to ongoing benchmarking
 269 experiments.)
 270
 271 Conceptually, the definition of the gmap combinators in terms of the
 272 primitive gfoldl requires the identification of the gfoldl function
 273 arguments. Technically, we also need to identify the type constructor
 274 c used all over the type of gfoldl.
 275
 276 -}
 277
 278   -- | A generic transformation that maps over the immediate subterms
 279   gmapT   :: (forall b. Data b => b -> b) -> a -> a
 280
 281   -- Use an identity datatype constructor ID (see below)
 282   -- to instantiate the type constructor c in the type of gfoldl,
 283   -- and perform injections ID and projections unID accordingly.
 284   --
 285   gmapT f x = unID (gfoldl k ID x)
 286     where
 287       k (ID c) x = ID (c (f x))
 288
 289
 290   -- | A generic query that processes the immediate subterms and returns a list
 291   gmapQ   :: (forall a. Data a => a -> u) -> a -> [u]
 292
 293   -- Use a phantom + function datatype constructor Q (see below),
 294   -- to instantiate the type constructor c in the type of gfoldl,
 295   -- and perform injections Q and projections unQ accordingly.
 296   --
 297   gmapQ f x = unQ (gfoldl k (const (Q id)) x) []
 298     where
 299       k (Q c) x = Q (\rs -> c (f x : rs))
 300
 301
 302   -- | A generic monadic transformation that maps over the immediate subterms
 303   gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
 304
 305   -- Use immediately the monad datatype constructor
 306   -- to instantiate the type constructor c in the type of gfoldl,
 307   -- so injection and projection is done by return and >>=.
 308   --
 309   gmapM f = gfoldl k return
 310     where
 311       k c x = do c' <- c
 312                  x' <- f x
 313                  return (c' x')
 314
 315
 316   -- | Transformation of at least one immediate subterm does not fail
 317   gmapF :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 318
 319   -- Use a datatype constructor F (see below)
 320   -- to instantiate the type constructor c in the type of gfoldl.
 321   --
 322   gmapF f x = unF (gfoldl k z x) >>= \(x',b) ->
 323               if b then return x' else mzero
 324     where
 325       z g = F (return (g,False))
 326       k (F c) x
 327         = F ( c >>= \(h,b) ->
 328               (f x >>= \x' -> return (h x',True))
 329               `mplus` return (h x, b)
 330             )
 331
 332
 333 -- | The identity type constructor needed for the definition of gmapT
 334 newtype ID x = ID { unID :: x }
 335
 336
 337 -- | A phantom datatype constructor used in definition of gmapQ;
 338 --   the function-typed component is needed to mediate between
 339 --   left-associative constructor application vs. right-associative lists.
 340 --
 341 newtype Q r a = Q { unQ  :: [r] -> [r] }
 342
 343
 344 -- | A pairing type constructor needed for the definition of gmapF;
 345 -- we keep track of the fact if a subterm was ever transformed successfully.
 346 newtype F m x = F { unF :: m (x, Bool) }
 347
 348
 349
 350 ------------------------------------------------------------------------------
 351 --
 352 --      The Constr datatype for describing datatype constructors
 353 --      To be extended by fixity, associativity, and maybe others.
 354 --
 355 ------------------------------------------------------------------------------
 356
 357 -- | Description of datatype constructors
 358 data Constr = Constr { conString :: String }
 359
 360
 361 {-
 362
 363 It is interesting to observe that we can determine the arity of a
 364 constructor without further meta-information. To this end, we use
 365 gunfold to construct a term from a given constructor while leaving the
 366 subterms undefined. Here we instantiate the type constructor c of the
 367 gunfold type by the identity type constructor ID. In a subsequent step
 368 we determine the number of subterms by folding as captured in the
 369 generic operation glength elsewhere in this module. Note that we need
 370 an extra argument to specify the intended type of the constructor.
 371
 372 -}
 373
 374 garity :: Data a => (a -> ()) -> Constr -> Int
 375 garity (_::a->()) = glength
 376                   . (unID :: ID a -> a)
 377                   . gunfold bottom ID
 378   where
 379     bottom = (\f -> ID (f undefined)) . unID
 380
 381
 382
 383 ------------------------------------------------------------------------------
 384 --
 385 --      Frequently used generic traversal schemes
 386 --
 387 ------------------------------------------------------------------------------
 388
 389 -- | Apply a transformation everywhere in bottom-up manner
 390 everywhere :: (forall a. Data a => a -> a)
 391            -> (forall a. Data a => a -> a)
 392
 393 -- use gmapT to recurse into immediate subterms;
 394 -- recall: gmapT preserves the outermost constructor;
 395 -- post-process recursively transformed result via f
 396 --
 397 everywhere f = f . gmapT (everywhere f)
 398
 399
 400 -- | Apply a transformation everywhere in top-down manner
 401 everywhere' :: (forall a. Data a => a -> a)
 402             -> (forall a. Data a => a -> a)
 403
 404 -- Arguments of (.) are flipped compared to everywhere
 405 everywhere' f = gmapT (everywhere' f) . f
 406
 407
 408 -- | Variation on everywhere with an extra stop condition
 409 everywhereBut :: GenericQ Bool -> GenericT -> GenericT
 410
 411 -- Guarded to let traversal cease if predicate q holds for x
 412 everywhereBut q f x
 413     | q x       = x
 414     | otherwise = f (gmapT (everywhereBut q f) x)
 415
 416
 417 -- | Monadic variation on everywhere
 418 everywhereM :: Monad m => GenericM m -> GenericM m
 419
 420 -- Bottom-up order is also reflected in order of do-actions
 421 everywhereM f x = do x' <- gmapM (everywhereM f) x
 422                      f x'
 423
 424
 425 -- | Apply a monadic transformation at least somewhere
 426 somewhere :: MonadPlus m => GenericM m -> GenericM m
 427
 428 -- We try "f" in top-down manner, but descent into "x" when we fail
 429 -- at the root of the term. The transformation fails if "f" fails
 430 -- everywhere, say succeeds nowhere.
 431 --
 432 somewhere f x = f x `mplus` gmapF (somewhere f) x
 433
 434
 435 -- | Summarise all nodes in top-down, left-to-right order
 436 everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
 437
 438 -- Apply f to x to summarise top-level node;
 439 -- use gmapQ to recurse into immediate subterms;
 440 -- use ordinary foldl to reduce list of intermediate results
 441 --
 442 everything k f x
 443      = foldl k (f x) (gmapQ (everything k f) x)
 444
 445
 446 -- | Look up a subterm by means of a maybe-typed filter
 447 something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
 448
 449 -- "something" can be defined in terms of "everything"
 450 -- when a suitable "choice" operator is used for reduction
 451 --
 452 something = everything orElse
 453
 454
 455 -- Left-biased choice on maybes (non-strict in right argument)
 456 orElse :: Maybe a -> Maybe a -> Maybe a
 457 x `orElse` y = maybe y Just x
 458
 459
 460 -- Another definition of orElse
 461 -- where the folding over maybies as defined by maybe is inlined
 462 -- to ease readability
 463 --
 464 x `orElse'` y = case x of
 465                   Just _  -> x
 466                   Nothing -> y
 467
 468
 469
 470
 471 -- | Bottom-up synthesis of a data structure;
 472 --   1st argument z is the initial element for the synthesis;
 473 --   2nd argument o is for reduction of results from subterms;
 474 --   3rd argument f updates the sythesised data according to the given term
 475 --
 476 synthesize :: s  -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
 477 synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
 478
 479
 480
 481 -----------------------------------------------------------------------------
 482 --
 483 --      "Twin" variations on gmapT, gmapQ. gmapM,
 484 --      i.e., these combinators take two terms at the same time.
 485 --      They are needed for multi-parameter traversal as generic equality.
 486 --      They are not exported.
 487 --
 488 -----------------------------------------------------------------------------
 489
 490 {-
 491
 492 We need type constructors for twin traversal as we needed type
 493 constructor for the ordinary gmap combinators. These type constructors
 494 again serve for the instantiation of the type constructor c used in
 495 the definition of gfoldl. The type constructors for twin traversal are
 496 elaborations of the type constructors ID, Q and monads that were used
 497 for the ordinary gmap combinators. More precisely, we use a pairing
 498 technique to always attach an additional component to the results of
 499 folding. This additional component carries the list of generic
 500 functions to be used for the intermediate subterms encountered during
 501 folding.
 502
 503 -}
 504
 505 newtype TT r a = TT { unTT :: (a,[GenericT']) }
 506 newtype TQ r a = TQ { unTQ :: ([r]->[r],[GenericQ' r]) }
 507 newtype TM m a = TM { unTM :: (m a,[GenericM' m]) }
 508
 509
 510 -- First-class polymorphic versions of GenericT/GenericQ/GenericM;
 511 -- they are referenced in TQ amd TM above
 512 --
 513 data GenericT' = T' { unT' :: forall a. Data a => a -> a }
 514 data GenericQ' u = Q' { unQ' :: forall a. Data a => a -> u }
 515 data Monad m => GenericM' m = M' { unM' :: forall a. Data a => a -> m a }
 516
 517
 518 {-
 519
 520 A twin variation on gmapT, where the pattern "GenericQ GenericT"
 521 expresses that the argument terms x and y are processed rather
 522 independently. So firstly, x is "queried" with a generic
 523 transformation as intermediate result, and secondly, this generic
 524 transformation is applied to y.
 525
 526 -}
 527
 528 tmapT :: GenericQ GenericT -> GenericQ GenericT
 529 tmapT g x y = fst (unTT (gfoldl k z y))
 530   where
 531     k (TT (f,l)) x = TT (f (unT' (head l) x),tail l)
 532     z f            = TT (f,gmapQ (\x -> T' (g x)) x)
 533
 534
 535
 536 -- A twin variation on gmapQ
 537
 538 tmapQ :: forall r.
 539          (forall a b. (Data a, Data b) => a -> b -> r)
 540       -> (forall a b. (Data a, Data b) => a -> b -> [r])
 541
 542 tmapQ g x y = fst (unTQ (gfoldl k z y)) []
 543     where
 544       k (TQ (c,l)) x = TQ (\rs -> c (unQ' (head l) x:rs), tail l)
 545       z _            = TQ (id,gmapQ (\x -> Q' (g x)) x)
 546
 547
 548 -- A twin variation on gmapM
 549
 550 tmapM :: forall m. Monad m
 551       => (forall a b. (Data a, Data b) => a -> b -> m b)
 552       -> (forall a b. (Data a, Data b) => a -> b -> m b)
 553 tmapM g x y = fst (unTM (gfoldl k z y))
 554   where
 555     k (TM (f,l)) x = TM (f >>= \f' -> unM' (head l) x >>= return . f',tail l)
 556     z f            = TM (return f,gmapQ (\x -> M' (g x)) x)
 557
 558
 559
 560 ------------------------------------------------------------------------------
 561 --
 562 --      Generic operations such as show, equality, read
 563 --
 564 ------------------------------------------------------------------------------
 565
 566 -- | Count the number of immediate subterms of the given term
 567 glength :: GenericQ Int
 568 glength = length . gmapQ (const ())
 569
 570
 571 -- | Determine the number of all suitable nodes in a given term
 572 gcount :: GenericQ Bool -> GenericQ Int
 573 gcount p =  everything (+) (\x -> if p x then 1 else 0)
 574
 575
 576 -- | Determine the number of all nodes in a given term
 577 gnodecount :: GenericQ Int
 578 gnodecount = gcount (const True)
 579
 580
 581 -- | Determine the number of nodes of a given type in a given term
 582 gtypecount :: Typeable a => (a -> ()) -> GenericQ Int
 583 gtypecount f = gcount (False `mkQ` (const True . f))
 584
 585
 586 -- | Generic show: an alternative to "deriving Show"
 587 gshow :: Data a => a -> String
 588
 589 -- This is a prefix-show using surrounding "(" and ")",
 590 -- where we recurse into subterms with gmapQ.
 591 --
 592 gshow = ( \t ->
 593                 "("
 594              ++ conString (conOf t)
 595              ++ concat (gmapQ ((++) " " . gshow) t)
 596              ++ ")"
 597         ) `extQ` (show :: String -> String)
 598
 599
 600 -- | Generic equality: an alternative to "deriving Eq"
 601 geq :: forall a. Data a => a -> a -> Bool
 602
 603 {-
 604
 605 We establish the equality of the two top-level datatype constructors.
 606 We use a twin gmap combinator, namely tgmapQ, to compare the two lists
 607 of immediate subterms.
 608
 609 (Note for the experts: the type of the worker geq' is rather general
 610 but precision is recovered via the restrictive type of the top-level
 611 operation geq. The imprecision of geq' is caused by the type system's
 612 unability to express the type equivalence for the corresponding
 613 couples of immediate subterms from the two given input terms.)
 614
 615 -}
 616
 617 geq x y = geq' x y
 618  where
 619   geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
 620   geq' x y = and ( (conString (conOf x) == conString (conOf y))
 621                  : tmapQ geq' x y
 622                  )
 623
 624
 625 -- | Generic zip controlled by a function with type-specific branches
 626 gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
 627      -> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
 628
 629 -- See testsuite/.../Generics/gzip.hs for an illustration
 630 gzip f x y =
 631   f x y
 632   `orElse`
 633   if conString (conOf x) == conString (conOf y)
 634    then tmapM (gzip f) x y
 635    else Nothing
 636
 637
 638 -- | The type constructor for gunfold a la ReadS from the Haskell 98 Prelude;
 639 --   we don't use lists here for simplicity but only maybes.
 640 newtype GRead i a = GRead (i -> Maybe (a, i))
 641 unGRead (GRead x) = x
 642
 643
 644 -- | Generic read: an alternative to "deriving Read"
 645 gread :: GenericG Maybe String
 646
 647 {-
 648
 649 This is a read operation which insists on prefix notation.  (The
 650 Haskell 98 read deals with infix operators as well.)  We use gunfold
 651 to "parse" the input. To be precise, gunfold is used for all result
 652 type except String. A type-specific case is incorporated for
 653 String. Another source of customisation would be to properly deal with
 654 infix operators subject to the capture of that information in the
 655 definition of Constr.
 656
 657 -}
 658
 659 gread = gdefault `extG` scase
 660
 661  where
 662
 663   -- a specific case for strings
 664   scase s = case reads s of
 665               [x::(String,String)] -> Just x
 666               _ -> Nothing
 667
 668   -- the generic default of gread
 669   gdefault s =
 670     do s' <- return $ dropWhile ((==) ' ') s
 671        guard (not (s' == ""))
 672        guard (head s' == '(')
 673        (c,s'')  <- prefixConstr (dropWhile ((==) ' ') (tail s'))
 674        (a,s''') <- unGRead (gunfold f z c) s''
 675        guard (not (s''' == ""))
 676        guard (head s''' == ')')
 677        return (a,tail s''')
 678
 679   -- Argument f for unfolding
 680   f :: Data a => GRead String (a -> b) -> GRead String b
 681   f x = GRead (\s -> do (r,s') <- unGRead x s
 682                         (t,s'')  <- gread s'
 683                         return (r t,s''))
 684
 685   -- Argument z for unfolding
 686   z ::  forall g. g -> GRead String g
 687   z g = GRead (\s -> return (g,s))
 688
 689   -- Get Constr at front of string
 690   prefixConstr :: String -> Maybe (Constr, String)
 691
 692   -- Assume an infix operators in parantheses
 693   prefixConstr ('(':s)
 694     = case break ((==) ')') s of
 695         (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
 696         _ -> Nothing
 697
 698   -- Special treatment of multiple token constructors
 699   prefixConstr ('[':']':s) = Just (Constr "[]",s)
 700
 701   -- Try lex for ordinary constructor and basic datatypes
 702   prefixConstr s
 703     = case lex s of
 704         [(s'@(_:_),s'')] -> Just (Constr s',s'')
 705         _ -> Nothing
 706
 707
 708
 709 ------------------------------------------------------------------------------
 710 --
 711 --      Instances of the Data class
 712 --
 713 ------------------------------------------------------------------------------
 714
 715 -- Basic datatype Int; folding and unfolding is trivial
 716 instance Data Int where
 717  conOf x = Constr (show x)
 718  consOf _ = []
 719  gunfold f z c = z (read (conString c))
 720
 721 -- Another basic datatype instance
 722 instance Data Integer where
 723  conOf x = Constr (show x)
 724  consOf _ = []
 725  gunfold f z c = z (read (conString c))
 726
 727 -- Another basic datatype instance
 728 instance Data Float where
 729  conOf x = Constr (show x)
 730  consOf _ = []
 731  gunfold f z c = z (read (conString c))
 732
 733 -- Another basic datatype instance
 734 instance Data Char where
 735  conOf x = Constr (show x)
 736  consOf _ = []
 737  gunfold f z c = z (read (conString c))
 738
 739 {-
 740
 741 Commented out;
 742 subject to inclusion of a missing Typeable instance
 743
 744 -- Another basic datatype instance
 745 instance Data Rational where
 746  conOf x = Constr (show x)
 747  consOf _ = []
 748  gunfold f z c = z (read (conString c))
 749
 750 -}
 751
 752 -- Bool as a kind of enumeration type
 753 instance Data Bool where
 754  conOf False = Constr "False"
 755  conOf True  = Constr "True"
 756  consOf _    = [Constr "False",Constr "True"]
 757  gunfold f z (Constr "False") = z False
 758  gunfold f z (Constr "True")  = z True
 759
 760 {-
 761
 762 We should better not fold over characters in a string for efficiency.
 763 However, the following instance would clearly overlap with the
 764 instance for polymorphic lists. Given the current scheme of allowing
 765 overlapping instances, this would imply that ANY module that imports
 766 Data.Generics would need to explicitly and generally allow overlapping
 767 instances. This is prohibitive and calls for a more constrained model
 768 of allowing overlapping instances. The present instance would also be
 769 more sensible for UNFOLDING. In the definition of gread, we still
 770 obtained the favoured behaviour by using a type-specific case for
 771 String.
 772
 773 -- instance Data String where
 774  conOf x = Constr (show x)
 775  consOf _ = []
 776  gunfold f z c = z (read (conString c))
 777
 778 -}
 779
 780 -- Cons-lists are terms with two immediate subterms. Hence, the gmap
 781 -- combinators do NOT coincide with the list fold/map combinators.
 782 --
 783 instance Data a => Data [a] where
 784   gmapT  f   []     = []
 785   gmapT  f   (x:xs) = (f x:f xs)
 786   gmapQ  f   []     = []
 787   gmapQ  f   (x:xs) = [f x,f xs]
 788   gmapM  f   []     = return []
 789   gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
 790   gfoldl f z []     = z []
 791   gfoldl f z (x:xs) = z (:) `f` x `f` xs
 792   conOf [] = Constr "[]"
 793   conOf (_:_) = Constr "(:)"
 794   consOf _ = [Constr "[]",Constr "(:)"]
 795   gunfold f z (Constr "[]")  = z []
 796   gunfold f z (Constr "(:)") = f (f (z (:)))
 797
 798 -- Yet enother polymorphic datatype constructor
 799 instance Data a => Data (Maybe a) where
 800  gfoldl f z Nothing  = z Nothing
 801  gfoldl f z (Just x) = z Just `f` x
 802  conOf Nothing  = Constr "Nothing"
 803  conOf (Just _) = Constr "Just"
 804  consOf _ = [Constr "Nothing", Constr "Just"]
 805  gunfold f z c | conString c == "Nothing" = z Nothing
 806  gunfold f z c | conString c == "Just"    = f (z Just)
 807
 808 -- Yet enother polymorphic datatype constructor
 809 instance (Data a, Data b) => Data (a,b) where
 810  gfoldl f z (a,b) = z (,) `f` a `f` b
 811  conOf _ = Constr "(,)"
 812  consOf _ = [Constr "(,)"]
 813  gunfold f z c | conString c == "(,)" = f (f (z (,)))
 814
 815 -- Functions are treated as "non-compound" data regarding folding while
 816 -- unfolding is out of reach, maybe not anymore with Template Haskell.
 817 --
 818 instance (Typeable a, Typeable b) => Data (a -> b) where
 819  conOf _ = Constr "->"
 820  consOf _ = [Constr "->"]
 821  gunfold _ _ _ = undefined
 822
 823
 824
 825 ------------------------------------------------------------------------------
 826 --
 827 --      Miscellaneous
 828 --
 829 ------------------------------------------------------------------------------
 830
 831 -- | Test for two objects to agree on the type
 832 sameType :: (Typeable a, Typeable b) => a -> b -> Bool
 833 sameType (_::a) = maybe False (\(_::a) -> True) . cast