Data/Generics/Basics.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics.Basics
   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.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Data.Generics.Basics (
  18
  19         -- * Module Data.Typeable re-exported for convenience
  20         module Data.Typeable,
  21
  22         -- * The Data class for processing constructor applications
  23         Data(
  24                 gfoldl,         -- :: ... -> a -> c a
  25                 gunfold,        -- :: ... -> Constr -> c a
  26                 toConstr,       -- :: a -> Constr
  27                 dataTypeOf,     -- :: a -> DataType
  28                 dataCast1,      -- mediate types and unary type constructors
  29                 dataCast2,      -- mediate types and binary type constructors
  30                 -- Generic maps defined in terms of gfoldl
  31                 gmapT,
  32                 gmapQ,
  33                 gmapQl,
  34                 gmapQr,
  35                 gmapQi,
  36                 gmapM,
  37                 gmapMp,
  38                 gmapMo
  39             ),
  40
  41         -- * Datatype representations
  42         DataType,       -- abstract, instance of: Show
  43         -- ** Constructors
  44         mkDataType,     -- :: String   -> [Constr] -> DataType
  45         mkIntType,      -- :: String -> DataType
  46         mkFloatType,    -- :: String -> DataType
  47         mkStringType,   -- :: String -> DataType
  48         mkNorepType,    -- :: String -> DataType
  49         -- ** Observers
  50         dataTypeName,   -- :: DataType -> String
  51         DataRep(..),    -- instance of: Eq, Show
  52         dataTypeRep,    -- :: DataType -> DataRep
  53         -- ** Convenience functions
  54         repConstr,      -- :: DataType -> ConstrRep -> Constr
  55         isAlgType,      -- :: DataType -> Bool
  56         dataTypeConstrs,-- :: DataType -> [Constr]
  57         indexConstr,    -- :: DataType -> ConIndex -> Constr
  58         maxConstrIndex, -- :: DataType -> ConIndex
  59         isNorepType,    -- :: DataType -> Bool
  60
  61         -- * Data constructor representations
  62         Constr,         -- abstract, instance of: Eq, Show
  63         ConIndex,       -- alias for Int, start at 1
  64         Fixity(..),     -- instance of: Eq, Show
  65         -- ** Constructors
  66         mkConstr,       -- :: DataType -> String -> Fixity -> Constr
  67         mkIntConstr,    -- :: DataType -> Integer -> Constr
  68         mkFloatConstr,  -- :: DataType -> Double  -> Constr
  69         mkStringConstr, -- :: DataType -> String  -> Constr
  70         -- ** Observers
  71         constrType,     -- :: Constr   -> DataType
  72         ConstrRep(..),  -- instance of: Eq, Show
  73         constrRep,      -- :: Constr   -> ConstrRep
  74         constrFields,   -- :: Constr   -> [String]
  75         constrFixity,   -- :: Constr   -> Fixity
  76         -- ** Convenience function: algebraic data types
  77         constrIndex,    -- :: Constr   -> ConIndex
  78         -- ** From strings to constructors and vice versa: all data types
  79         showConstr,     -- :: Constr   -> String
  80         readConstr,     -- :: DataType -> String -> Maybe Constr
  81
  82         -- * Convenience functions: take type constructors apart
  83         tyconUQname,    -- :: String -> String
  84         tyconModule,    -- :: String -> String
  85
  86         -- * Generic operations defined in terms of 'gunfold'
  87         fromConstr,     -- :: Constr -> a
  88         fromConstrB,    -- :: ... -> Constr -> a
  89         fromConstrM     -- :: Monad m => ... -> Constr -> m a
  90
  91   ) where
  92
  93
  94 ------------------------------------------------------------------------------
  95
  96 import Prelude -- necessary to get dependencies right
  97
  98 import Data.Typeable
  99 import Data.Maybe
 100 import Control.Monad
 101
 102
 103
 104 ------------------------------------------------------------------------------
 105 --
 106 --      The Data class
 107 --
 108 ------------------------------------------------------------------------------
 109
 110 {- |
 111 The 'Data' class comprehends a fundamental primitive 'gfoldl' for
 112 folding over constructor applications, say terms. This primitive can
 113 be instantiated in several ways to map over the immediate subterms
 114 of a term; see the @gmap@ combinators later in this class.  Indeed, a
 115 generic programmer does not necessarily need to use the ingenious gfoldl
 116 primitive but rather the intuitive @gmap@ combinators.  The 'gfoldl'
 117 primitive is completed by means to query top-level constructors, to
 118 turn constructor representations into proper terms, and to list all
 119 possible datatype constructors.  This completion allows us to serve
 120 generic programming scenarios like read, show, equality, term generation.
 121
 122 The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
 123 default definitions in terms of 'gfoldl', leaving open the opportunity
 124 to provide datatype-specific definitions.
 125 (The inclusion of the @gmap@ combinators as members of class 'Data'
 126 allows the programmer or the compiler to derive specialised, and maybe
 127 more efficient code per datatype.  /Note/: 'gfoldl' is more higher-order
 128 than the @gmap@ combinators.  This is subject to ongoing benchmarking
 129 experiments.  It might turn out that the @gmap@ combinators will be
 130 moved out of the class 'Data'.)
 131
 132 Conceptually, the definition of the @gmap@ combinators in terms of the
 133 primitive 'gfoldl' requires the identification of the 'gfoldl' function
 134 arguments.  Technically, we also need to identify the type constructor
 135 @c@ for the construction of the result type from the folded term type.
 136
 137 In the definition of @gmapQ@/x/ combinators, we use phantom type
 138 constructors for the @c@ in the type of 'gfoldl' because the result type
 139 of a query does not involve the (polymorphic) type of the term argument.
 140 In the definition of 'gmapQl' we simply use the plain constant type
 141 constructor because 'gfoldl' is left-associative anyway and so it is
 142 readily suited to fold a left-associative binary operation over the
 143 immediate subterms.  In the definition of gmapQr, extra effort is
 144 needed. We use a higher-order accumulation trick to mediate between
 145 left-associative constructor application vs. right-associative binary
 146 operation (e.g., @(:)@).  When the query is meant to compute a value
 147 of type @r@, then the result type withing generic folding is @r -> r@.
 148 So the result of folding is a function to which we finally pass the
 149 right unit.
 150
 151 With the @-fglasgow-exts@ option, GHC can generate instances of the
 152 'Data' class automatically.  For example, given the declaration
 153
 154 > data T a b = C1 a b | C2 deriving (Typeable, Data)
 155
 156 GHC will generate an instance that is equivalent to
 157
 158 > instance (Data a, Data b) => Data (T a b) where
 159 >     gfoldl k z (C1 a b) = z C1 `k` a `k` b
 160 >     gfoldl k z C2       = z C2
 161 >
 162 >     gunfold k z c = case constrIndex c of
 163 >                         1 -> k (k (z C1))
 164 >                         2 -> z C2
 165 >
 166 >     toConstr (C1 _ _) = con_C1
 167 >     toConstr C2       = con_C2
 168 >
 169 >     dataTypeOf _ = ty_T
 170 >
 171 > con_C1 = mkConstr ty_T "C1" [] Prefix
 172 > con_C2 = mkConstr ty_T "C2" [] Prefix
 173 > ty_T   = mkDataType "Module.T" [con_C1, con_C2]
 174
 175 This is suitable for datatypes that are exported transparently.
 176
 177 -}
 178
 179 class Typeable a => Data a where
 180
 181   -- | Left-associative fold operation for constructor applications.
 182   --
 183   -- The type of 'gfoldl' is a headache, but operationally it is a simple
 184   -- generalisation of a list fold.
 185   --
 186   -- The default definition for 'gfoldl' is @'const' 'id'@, which is
 187   -- suitable for abstract datatypes with no substructures.
 188   gfoldl  :: (forall a b. Data a => c (a -> b) -> a -> c b)
 189                 -- ^ defines how nonempty constructor applications are
 190                 -- folded.  It takes the folded tail of the constructor
 191                 -- application and its head, i.e., an immediate subterm,
 192                 -- and combines them in some way.
 193           -> (forall g. g -> c g)
 194                 -- ^ defines how the empty constructor application is
 195                 -- folded, like the neutral \/ start element for list
 196                 -- folding.
 197           -> a
 198                 -- ^ structure to be folded.
 199           -> c a
 200                 -- ^ result, with a type defined in terms of @a@, but
 201                 -- variability is achieved by means of type constructor
 202                 -- @c@ for the construction of the actual result type.
 203
 204   -- See the 'Data' instances in this file for an illustration of 'gfoldl'.
 205
 206   gfoldl _ z = z
 207
 208   -- | Unfolding constructor applications
 209   gunfold :: (forall b r. Data b => c (b -> r) -> c r)
 210           -> (forall r. r -> c r)
 211           -> Constr
 212           -> c a
 213
 214   -- | Obtaining the constructor from a given datum.
 215   -- For proper terms, this is meant to be the top-level constructor.
 216   -- Primitive datatypes are here viewed as potentially infinite sets of
 217   -- values (i.e., constructors).
 218   toConstr   :: a -> Constr
 219
 220
 221   -- | The outer type constructor of the type
 222   dataTypeOf  :: a -> DataType
 223
 224
 225
 226 ------------------------------------------------------------------------------
 227 --
 228 -- Mediate types and type constructors
 229 --
 230 ------------------------------------------------------------------------------
 231
 232   -- | Mediate types and unary type constructors.
 233   -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined
 234   -- as 'gcast1'.
 235   --
 236   -- The default definition is @'const' 'Nothing'@, which is appropriate
 237   -- for non-unary type constructors.
 238   dataCast1 :: Typeable1 t
 239             => (forall a. Data a => c (t a))
 240             -> Maybe (c a)
 241   dataCast1 _ = Nothing
 242
 243   -- | Mediate types and binary type constructors.
 244   -- In 'Data' instances of the form @T a b@, 'dataCast2' should be
 245   -- defined as 'gcast2'.
 246   --
 247   -- The default definition is @'const' 'Nothing'@, which is appropriate
 248   -- for non-binary type constructors.
 249   dataCast2 :: Typeable2 t
 250             => (forall a b. (Data a, Data b) => c (t a b))
 251             -> Maybe (c a)
 252   dataCast2 _ = Nothing
 253
 254
 255
 256 ------------------------------------------------------------------------------
 257 --
 258 --      Typical generic maps defined in terms of gfoldl
 259 --
 260 ------------------------------------------------------------------------------
 261
 262
 263   -- | A generic transformation that maps over the immediate subterms
 264   --
 265   -- The default definition instantiates the type constructor @c@ in the
 266   -- type of 'gfoldl' to an identity datatype constructor, using the
 267   -- isomorphism pair as injection and projection.
 268   gmapT :: (forall b. Data b => b -> b) -> a -> a
 269
 270   -- Use an identity datatype constructor ID (see below)
 271   -- to instantiate the type constructor c in the type of gfoldl,
 272   -- and perform injections ID and projections unID accordingly.
 273   --
 274   gmapT f x = unID (gfoldl k ID x)
 275     where
 276       k (ID c) x = ID (c (f x))
 277
 278
 279   -- | A generic query with a left-associative binary operator
 280   gmapQl :: (r -> r' -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
 281   gmapQl o r f = unCONST . gfoldl k z
 282     where
 283       k c x = CONST $ (unCONST c) `o` f x
 284       z _   = CONST r
 285
 286   -- | A generic query with a right-associative binary operator
 287   gmapQr :: (r' -> r -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
 288   gmapQr o r f x = unQr (gfoldl k (const (Qr id)) x) r
 289     where
 290       k (Qr c) x = Qr (\r -> c (f x `o` r))
 291
 292
 293   -- | A generic query that processes the immediate subterms and returns a list
 294   gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
 295   gmapQ f = gmapQr (:) [] f
 296
 297
 298   -- | A generic query that processes one child by index (zero-based)
 299   gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
 300   gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
 301     where
 302       k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
 303       z f           = Qi 0 Nothing
 304
 305
 306   -- | A generic monadic transformation that maps over the immediate subterms
 307   --
 308   -- The default definition instantiates the type constructor @c@ in
 309   -- the type of 'gfoldl' to the monad datatype constructor, defining
 310   -- injection and projection using 'return' and '>>='.
 311   gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
 312
 313   -- Use immediately the monad datatype constructor
 314   -- to instantiate the type constructor c in the type of gfoldl,
 315   -- so injection and projection is done by return and >>=.
 316   --
 317   gmapM f = gfoldl k return
 318     where
 319       k c x = do c' <- c
 320                  x' <- f x
 321                  return (c' x')
 322
 323
 324   -- | Transformation of at least one immediate subterm does not fail
 325   gmapMp :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 326
 327 {-
 328
 329 The type constructor that we use here simply keeps track of the fact
 330 if we already succeeded for an immediate subterm; see Mp below. To
 331 this end, we couple the monadic computation with a Boolean.
 332
 333 -}
 334
 335   gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
 336                 if b then return x' else mzero
 337     where
 338       z g = Mp (return (g,False))
 339       k (Mp c) x
 340         = Mp ( c >>= \(h,b) ->
 341                  (f x >>= \x' -> return (h x',True))
 342                  `mplus` return (h x,b)
 343              )
 344
 345   -- | Transformation of one immediate subterm with success
 346   gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 347
 348 {-
 349
 350 We use the same pairing trick as for gmapMp,
 351 i.e., we use an extra Bool component to keep track of the
 352 fact whether an immediate subterm was processed successfully.
 353 However, we cut of mapping over subterms once a first subterm
 354 was transformed successfully.
 355
 356 -}
 357
 358   gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
 359                 if b then return x' else mzero
 360     where
 361       z g = Mp (return (g,False))
 362       k (Mp c) x
 363         = Mp ( c >>= \(h,b) -> if b
 364                         then return (h x,b)
 365                         else (f x >>= \x' -> return (h x',True))
 366                              `mplus` return (h x,b)
 367              )
 368
 369
 370 -- | The identity type constructor needed for the definition of gmapT
 371 newtype ID x = ID { unID :: x }
 372
 373
 374 -- | The constant type constructor needed for the definition of gmapQl
 375 newtype CONST c a = CONST { unCONST :: c }
 376
 377
 378 -- | Type constructor for adding counters to queries
 379 data Qi q a = Qi Int (Maybe q)
 380
 381
 382 -- | The type constructor used in definition of gmapQr
 383 newtype Qr r a = Qr { unQr  :: r -> r }
 384
 385
 386 -- | The type constructor used in definition of gmapMp
 387 newtype Mp m x = Mp { unMp :: m (x, Bool) }
 388
 389
 390
 391 ------------------------------------------------------------------------------
 392 --
 393 --      Generic unfolding
 394 --
 395 ------------------------------------------------------------------------------
 396
 397
 398 -- | Build a term skeleton
 399 fromConstr :: Data a => Constr -> a
 400 fromConstr = fromConstrB undefined
 401
 402
 403 -- | Build a term and use a generic function for subterms
 404 fromConstrB :: Data a
 405             => (forall a. Data a => a)
 406             -> Constr
 407             -> a
 408 fromConstrB f = unID . gunfold k z
 409  where
 410   k c = ID (unID c f)
 411   z = ID
 412
 413
 414 -- | Monadic variation on 'fromConstrB'
 415 fromConstrM :: (Monad m, Data a)
 416             => (forall a. Data a => m a)
 417             -> Constr
 418             -> m a
 419 fromConstrM f = gunfold k z
 420  where
 421   k c = do { c' <- c; b <- f; return (c' b) }
 422   z = return
 423
 424
 425
 426 ------------------------------------------------------------------------------
 427 --
 428 --      Datatype and constructor representations
 429 --
 430 ------------------------------------------------------------------------------
 431
 432
 433 --
 434 -- | Representation of datatypes.
 435 -- A package of constructor representations with names of type and module.
 436 --
 437 data DataType = DataType
 438                         { tycon   :: String
 439                         , datarep :: DataRep
 440                         }
 441
 442               deriving Show
 443
 444
 445 -- | Representation of constructors
 446 data Constr = Constr
 447                         { conrep    :: ConstrRep
 448                         , constring :: String
 449                         , confields :: [String] -- for AlgRep only
 450                         , confixity :: Fixity   -- for AlgRep only
 451                         , datatype  :: DataType
 452                         }
 453
 454 instance Show Constr where
 455  show = constring
 456
 457
 458 -- | Equality of constructors
 459 instance Eq Constr where
 460   c == c' = constrRep c == constrRep c'
 461
 462
 463 -- | Public representation of datatypes
 464 data DataRep = AlgRep [Constr]
 465              | IntRep
 466              | FloatRep
 467              | StringRep
 468              | NoRep
 469
 470             deriving (Eq,Show)
 471 -- The list of constructors could be an array, a balanced tree, or others.
 472
 473
 474 -- | Public representation of constructors
 475 data ConstrRep = AlgConstr    ConIndex
 476                | IntConstr    Integer
 477                | FloatConstr  Double
 478                | StringConstr String
 479
 480                deriving (Eq,Show)
 481
 482
 483 -- | Unique index for datatype constructors,
 484 -- counting from 1 in the order they are given in the program text.
 485 type ConIndex = Int
 486
 487
 488 -- | Fixity of constructors
 489 data Fixity = Prefix
 490             | Infix     -- Later: add associativity and precedence
 491
 492             deriving (Eq,Show)
 493
 494
 495 ------------------------------------------------------------------------------
 496 --
 497 --      Observers for datatype representations
 498 --
 499 ------------------------------------------------------------------------------
 500
 501
 502 -- | Gets the type constructor including the module
 503 dataTypeName :: DataType -> String
 504 dataTypeName = tycon
 505
 506
 507
 508 -- | Gets the public presentation of a datatype
 509 dataTypeRep :: DataType -> DataRep
 510 dataTypeRep = datarep
 511
 512
 513 -- | Gets the datatype of a constructor
 514 constrType :: Constr -> DataType
 515 constrType = datatype
 516
 517
 518 -- | Gets the public presentation of constructors
 519 constrRep :: Constr -> ConstrRep
 520 constrRep = conrep
 521
 522
 523 -- | Look up a constructor by its representation
 524 repConstr :: DataType -> ConstrRep -> Constr
 525 repConstr dt cr =
 526       case (dataTypeRep dt, cr) of
 527         (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
 528         (IntRep,    IntConstr i)      -> mkIntConstr dt i
 529         (FloatRep,  FloatConstr f)    -> mkFloatConstr dt f
 530         (StringRep, StringConstr str) -> mkStringConstr dt str
 531         _ -> error "repConstr"
 532
 533
 534
 535 ------------------------------------------------------------------------------
 536 --
 537 --      Representations of algebraic data types
 538 --
 539 ------------------------------------------------------------------------------
 540
 541
 542 -- | Constructs an algebraic datatype
 543 mkDataType :: String -> [Constr] -> DataType
 544 mkDataType str cs = DataType
 545                         { tycon   = str
 546                         , datarep = AlgRep cs
 547                         }
 548
 549
 550 -- | Constructs a constructor
 551 mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
 552 mkConstr dt str fields fix =
 553         Constr
 554                 { conrep    = AlgConstr idx
 555                 , constring = str
 556                 , confields = fields
 557                 , confixity = fix
 558                 , datatype  = dt
 559                 }
 560   where
 561     idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
 562                      showConstr c == str ]
 563
 564
 565 -- | Gets the constructors of an algebraic datatype
 566 dataTypeConstrs :: DataType -> [Constr]
 567 dataTypeConstrs dt = case datarep dt of
 568                         (AlgRep cons) -> cons
 569                         _ -> error "dataTypeConstrs"
 570
 571
 572 -- | Gets the field labels of a constructor
 573 constrFields :: Constr -> [String]
 574 constrFields = confields
 575
 576
 577 -- | Gets the fixity of a constructor
 578 constrFixity :: Constr -> Fixity
 579 constrFixity = confixity
 580
 581
 582
 583 ------------------------------------------------------------------------------
 584 --
 585 --      From strings to constr's and vice versa: all data types
 586 --
 587 ------------------------------------------------------------------------------
 588
 589
 590 -- | Gets the string for a constructor
 591 showConstr :: Constr -> String
 592 showConstr = constring
 593
 594
 595 -- | Lookup a constructor via a string
 596 readConstr :: DataType -> String -> Maybe Constr
 597 readConstr dt str =
 598       case dataTypeRep dt of
 599         AlgRep cons -> idx cons
 600         IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
 601         FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
 602         StringRep   -> Just (mkStringConstr dt str)
 603         NoRep       -> Nothing
 604   where
 605
 606     -- Read a value and build a constructor
 607     mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
 608     mkReadCon f = case (reads str) of
 609                     [(t,"")] -> Just (f t)
 610                     _ -> Nothing
 611
 612     -- Traverse list of algebraic datatype constructors
 613     idx :: [Constr] -> Maybe Constr
 614     idx cons = let fit = filter ((==) str . showConstr) cons
 615                 in if fit == []
 616                      then Nothing
 617                      else Just (head fit)
 618
 619
 620 ------------------------------------------------------------------------------
 621 --
 622 --      Convenience funtions: algebraic data types
 623 --
 624 ------------------------------------------------------------------------------
 625
 626
 627 -- | Test for an algebraic type
 628 isAlgType :: DataType -> Bool
 629 isAlgType dt = case datarep dt of
 630                  (AlgRep _) -> True
 631                  _ -> False
 632
 633
 634 -- | Gets the constructor for an index (algebraic datatypes only)
 635 indexConstr :: DataType -> ConIndex -> Constr
 636 indexConstr dt idx = case datarep dt of
 637                         (AlgRep cs) -> cs !! (idx-1)
 638                         _           -> error "indexConstr"
 639
 640
 641 -- | Gets the index of a constructor (algebraic datatypes only)
 642 constrIndex :: Constr -> ConIndex
 643 constrIndex con = case constrRep con of
 644                     (AlgConstr idx) -> idx
 645                     _ -> error "constrIndex"
 646
 647
 648 -- | Gets the maximum constructor index of an algebraic datatype
 649 maxConstrIndex :: DataType -> ConIndex
 650 maxConstrIndex dt = case dataTypeRep dt of
 651                         AlgRep cs -> length cs
 652                         _            -> error "maxConstrIndex"
 653
 654
 655
 656 ------------------------------------------------------------------------------
 657 --
 658 --      Representation of primitive types
 659 --
 660 ------------------------------------------------------------------------------
 661
 662
 663 -- | Constructs the 'Int' type
 664 mkIntType :: String -> DataType
 665 mkIntType = mkPrimType IntRep
 666
 667
 668 -- | Constructs the 'Float' type
 669 mkFloatType :: String -> DataType
 670 mkFloatType = mkPrimType FloatRep
 671
 672
 673 -- | Constructs the 'String' type
 674 mkStringType :: String -> DataType
 675 mkStringType = mkPrimType StringRep
 676
 677
 678 -- | Helper for 'mkIntType', 'mkFloatType', 'mkStringType'
 679 mkPrimType :: DataRep -> String -> DataType
 680 mkPrimType dr str = DataType
 681                         { tycon   = str
 682                         , datarep = dr
 683                         }
 684
 685
 686 -- Makes a constructor for primitive types
 687 mkPrimCon :: DataType -> String -> ConstrRep -> Constr
 688 mkPrimCon dt str cr = Constr
 689                         { datatype  = dt
 690                         , conrep    = cr
 691                         , constring = str
 692                         , confields = error "constrFields"
 693                         , confixity = error "constrFixity"
 694                         }
 695
 696
 697 mkIntConstr :: DataType -> Integer -> Constr
 698 mkIntConstr dt i = case datarep dt of
 699                   IntRep -> mkPrimCon dt (show i) (IntConstr i)
 700                   _ -> error "mkIntConstr"
 701
 702
 703 mkFloatConstr :: DataType -> Double -> Constr
 704 mkFloatConstr dt f = case datarep dt of
 705                     FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
 706                     _ -> error "mkFloatConstr"
 707
 708
 709 mkStringConstr :: DataType -> String -> Constr
 710 mkStringConstr dt str = case datarep dt of
 711                        StringRep -> mkPrimCon dt str (StringConstr str)
 712                        _ -> error "mkStringConstr"
 713
 714
 715 ------------------------------------------------------------------------------
 716 --
 717 --      Non-representations for non-presentable types
 718 --
 719 ------------------------------------------------------------------------------
 720
 721
 722 -- | Constructs a non-representation for a non-presentable type
 723 mkNorepType :: String -> DataType
 724 mkNorepType str = DataType
 725                         { tycon   = str
 726                         , datarep = NoRep
 727                         }
 728
 729
 730 -- | Test for a non-representable type
 731 isNorepType :: DataType -> Bool
 732 isNorepType dt = case datarep dt of
 733                    NoRep -> True
 734                    _ -> False
 735
 736
 737
 738 ------------------------------------------------------------------------------
 739 --
 740 --      Convenience for qualified type constructors
 741 --
 742 ------------------------------------------------------------------------------
 743
 744
 745 -- | Gets the unqualified type constructor:
 746 -- drop *.*.*... before name
 747 --
 748 tyconUQname :: String -> String
 749 tyconUQname x = let x' = dropWhile (not . (==) '.') x
 750                  in if x' == [] then x else tyconUQname (tail x')
 751
 752
 753 -- | Gets the module of a type constructor:
 754 -- take *.*.*... before name
 755 tyconModule :: String -> String
 756 tyconModule x = let (a,b) = break ((==) '.') x
 757                  in if b == ""
 758                       then b
 759                       else a ++ tyconModule' (tail b)
 760   where
 761     tyconModule' x = let x' = tyconModule x
 762                       in if x' == "" then "" else ('.':x')