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