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   -- of results.  The list is given in the same order as originally specified
 295   -- in the declaratoin of the data constructors.
 296   gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
 297   gmapQ f = gmapQr (:) [] f
 298
 299
 300   -- | A generic query that processes one child by index (zero-based)
 301   gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
 302   gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
 303     where
 304       k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
 305       z f           = Qi 0 Nothing
 306
 307
 308   -- | A generic monadic transformation that maps over the immediate subterms
 309   --
 310   -- The default definition instantiates the type constructor @c@ in
 311   -- the type of 'gfoldl' to the monad datatype constructor, defining
 312   -- injection and projection using 'return' and '>>='.
 313   gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
 314
 315   -- Use immediately the monad datatype constructor
 316   -- to instantiate the type constructor c in the type of gfoldl,
 317   -- so injection and projection is done by return and >>=.
 318   --
 319   gmapM f = gfoldl k return
 320     where
 321       k c x = do c' <- c
 322                  x' <- f x
 323                  return (c' x')
 324
 325
 326   -- | Transformation of at least one immediate subterm does not fail
 327   gmapMp :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 328
 329 {-
 330
 331 The type constructor that we use here simply keeps track of the fact
 332 if we already succeeded for an immediate subterm; see Mp below. To
 333 this end, we couple the monadic computation with a Boolean.
 334
 335 -}
 336
 337   gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
 338                 if b then return x' else mzero
 339     where
 340       z g = Mp (return (g,False))
 341       k (Mp c) x
 342         = Mp ( c >>= \(h,b) ->
 343                  (f x >>= \x' -> return (h x',True))
 344                  `mplus` return (h x,b)
 345              )
 346
 347   -- | Transformation of one immediate subterm with success
 348   gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 349
 350 {-
 351
 352 We use the same pairing trick as for gmapMp,
 353 i.e., we use an extra Bool component to keep track of the
 354 fact whether an immediate subterm was processed successfully.
 355 However, we cut of mapping over subterms once a first subterm
 356 was transformed successfully.
 357
 358 -}
 359
 360   gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
 361                 if b then return x' else mzero
 362     where
 363       z g = Mp (return (g,False))
 364       k (Mp c) x
 365         = Mp ( c >>= \(h,b) -> if b
 366                         then return (h x,b)
 367                         else (f x >>= \x' -> return (h x',True))
 368                              `mplus` return (h x,b)
 369              )
 370
 371
 372 -- | The identity type constructor needed for the definition of gmapT
 373 newtype ID x = ID { unID :: x }
 374
 375
 376 -- | The constant type constructor needed for the definition of gmapQl
 377 newtype CONST c a = CONST { unCONST :: c }
 378
 379
 380 -- | Type constructor for adding counters to queries
 381 data Qi q a = Qi Int (Maybe q)
 382
 383
 384 -- | The type constructor used in definition of gmapQr
 385 newtype Qr r a = Qr { unQr  :: r -> r }
 386
 387
 388 -- | The type constructor used in definition of gmapMp
 389 newtype Mp m x = Mp { unMp :: m (x, Bool) }
 390
 391
 392
 393 ------------------------------------------------------------------------------
 394 --
 395 --      Generic unfolding
 396 --
 397 ------------------------------------------------------------------------------
 398
 399
 400 -- | Build a term skeleton
 401 fromConstr :: Data a => Constr -> a
 402 fromConstr = fromConstrB undefined
 403
 404
 405 -- | Build a term and use a generic function for subterms
 406 fromConstrB :: Data a
 407             => (forall a. Data a => a)
 408             -> Constr
 409             -> a
 410 fromConstrB f = unID . gunfold k z
 411  where
 412   k c = ID (unID c f)
 413   z = ID
 414
 415
 416 -- | Monadic variation on 'fromConstrB'
 417 fromConstrM :: (Monad m, Data a)
 418             => (forall a. Data a => m a)
 419             -> Constr
 420             -> m a
 421 fromConstrM f = gunfold k z
 422  where
 423   k c = do { c' <- c; b <- f; return (c' b) }
 424   z = return
 425
 426
 427
 428 ------------------------------------------------------------------------------
 429 --
 430 --      Datatype and constructor representations
 431 --
 432 ------------------------------------------------------------------------------
 433
 434
 435 --
 436 -- | Representation of datatypes.
 437 -- A package of constructor representations with names of type and module.
 438 --
 439 data DataType = DataType
 440                         { tycon   :: String
 441                         , datarep :: DataRep
 442                         }
 443
 444               deriving Show
 445
 446
 447 -- | Representation of constructors
 448 data Constr = Constr
 449                         { conrep    :: ConstrRep
 450                         , constring :: String
 451                         , confields :: [String] -- for AlgRep only
 452                         , confixity :: Fixity   -- for AlgRep only
 453                         , datatype  :: DataType
 454                         }
 455
 456 instance Show Constr where
 457  show = constring
 458
 459
 460 -- | Equality of constructors
 461 instance Eq Constr where
 462   c == c' = constrRep c == constrRep c'
 463
 464
 465 -- | Public representation of datatypes
 466 data DataRep = AlgRep [Constr]
 467              | IntRep
 468              | FloatRep
 469              | StringRep
 470              | NoRep
 471
 472             deriving (Eq,Show)
 473 -- The list of constructors could be an array, a balanced tree, or others.
 474
 475
 476 -- | Public representation of constructors
 477 data ConstrRep = AlgConstr    ConIndex
 478                | IntConstr    Integer
 479                | FloatConstr  Double
 480                | StringConstr String
 481
 482                deriving (Eq,Show)
 483
 484
 485 -- | Unique index for datatype constructors,
 486 -- counting from 1 in the order they are given in the program text.
 487 type ConIndex = Int
 488
 489
 490 -- | Fixity of constructors
 491 data Fixity = Prefix
 492             | Infix     -- Later: add associativity and precedence
 493
 494             deriving (Eq,Show)
 495
 496
 497 ------------------------------------------------------------------------------
 498 --
 499 --      Observers for datatype representations
 500 --
 501 ------------------------------------------------------------------------------
 502
 503
 504 -- | Gets the type constructor including the module
 505 dataTypeName :: DataType -> String
 506 dataTypeName = tycon
 507
 508
 509
 510 -- | Gets the public presentation of a datatype
 511 dataTypeRep :: DataType -> DataRep
 512 dataTypeRep = datarep
 513
 514
 515 -- | Gets the datatype of a constructor
 516 constrType :: Constr -> DataType
 517 constrType = datatype
 518
 519
 520 -- | Gets the public presentation of constructors
 521 constrRep :: Constr -> ConstrRep
 522 constrRep = conrep
 523
 524
 525 -- | Look up a constructor by its representation
 526 repConstr :: DataType -> ConstrRep -> Constr
 527 repConstr dt cr =
 528       case (dataTypeRep dt, cr) of
 529         (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
 530         (IntRep,    IntConstr i)      -> mkIntConstr dt i
 531         (FloatRep,  FloatConstr f)    -> mkFloatConstr dt f
 532         (StringRep, StringConstr str) -> mkStringConstr dt str
 533         _ -> error "repConstr"
 534
 535
 536
 537 ------------------------------------------------------------------------------
 538 --
 539 --      Representations of algebraic data types
 540 --
 541 ------------------------------------------------------------------------------
 542
 543
 544 -- | Constructs an algebraic datatype
 545 mkDataType :: String -> [Constr] -> DataType
 546 mkDataType str cs = DataType
 547                         { tycon   = str
 548                         , datarep = AlgRep cs
 549                         }
 550
 551
 552 -- | Constructs a constructor
 553 mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
 554 mkConstr dt str fields fix =
 555         Constr
 556                 { conrep    = AlgConstr idx
 557                 , constring = str
 558                 , confields = fields
 559                 , confixity = fix
 560                 , datatype  = dt
 561                 }
 562   where
 563     idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
 564                      showConstr c == str ]
 565
 566
 567 -- | Gets the constructors of an algebraic datatype
 568 dataTypeConstrs :: DataType -> [Constr]
 569 dataTypeConstrs dt = case datarep dt of
 570                         (AlgRep cons) -> cons
 571                         _ -> error "dataTypeConstrs"
 572
 573
 574 -- | Gets the field labels of a constructor.  The list of labels
 575 -- is returned in the same order as they were given in the original
 576 -- constructor declaration.
 577 constrFields :: Constr -> [String]
 578 constrFields = confields
 579
 580
 581 -- | Gets the fixity of a constructor
 582 constrFixity :: Constr -> Fixity
 583 constrFixity = confixity
 584
 585
 586
 587 ------------------------------------------------------------------------------
 588 --
 589 --      From strings to constr's and vice versa: all data types
 590 --
 591 ------------------------------------------------------------------------------
 592
 593
 594 -- | Gets the string for a constructor
 595 showConstr :: Constr -> String
 596 showConstr = constring
 597
 598
 599 -- | Lookup a constructor via a string
 600 readConstr :: DataType -> String -> Maybe Constr
 601 readConstr dt str =
 602       case dataTypeRep dt of
 603         AlgRep cons -> idx cons
 604         IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
 605         FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
 606         StringRep   -> Just (mkStringConstr dt str)
 607         NoRep       -> Nothing
 608   where
 609
 610     -- Read a value and build a constructor
 611     mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
 612     mkReadCon f = case (reads str) of
 613                     [(t,"")] -> Just (f t)
 614                     _ -> Nothing
 615
 616     -- Traverse list of algebraic datatype constructors
 617     idx :: [Constr] -> Maybe Constr
 618     idx cons = let fit = filter ((==) str . showConstr) cons
 619                 in if fit == []
 620                      then Nothing
 621                      else Just (head fit)
 622
 623
 624 ------------------------------------------------------------------------------
 625 --
 626 --      Convenience funtions: algebraic data types
 627 --
 628 ------------------------------------------------------------------------------
 629
 630
 631 -- | Test for an algebraic type
 632 isAlgType :: DataType -> Bool
 633 isAlgType dt = case datarep dt of
 634                  (AlgRep _) -> True
 635                  _ -> False
 636
 637
 638 -- | Gets the constructor for an index (algebraic datatypes only)
 639 indexConstr :: DataType -> ConIndex -> Constr
 640 indexConstr dt idx = case datarep dt of
 641                         (AlgRep cs) -> cs !! (idx-1)
 642                         _           -> error "indexConstr"
 643
 644
 645 -- | Gets the index of a constructor (algebraic datatypes only)
 646 constrIndex :: Constr -> ConIndex
 647 constrIndex con = case constrRep con of
 648                     (AlgConstr idx) -> idx
 649                     _ -> error "constrIndex"
 650
 651
 652 -- | Gets the maximum constructor index of an algebraic datatype
 653 maxConstrIndex :: DataType -> ConIndex
 654 maxConstrIndex dt = case dataTypeRep dt of
 655                         AlgRep cs -> length cs
 656                         _            -> error "maxConstrIndex"
 657
 658
 659
 660 ------------------------------------------------------------------------------
 661 --
 662 --      Representation of primitive types
 663 --
 664 ------------------------------------------------------------------------------
 665
 666
 667 -- | Constructs the 'Int' type
 668 mkIntType :: String -> DataType
 669 mkIntType = mkPrimType IntRep
 670
 671
 672 -- | Constructs the 'Float' type
 673 mkFloatType :: String -> DataType
 674 mkFloatType = mkPrimType FloatRep
 675
 676
 677 -- | Constructs the 'String' type
 678 mkStringType :: String -> DataType
 679 mkStringType = mkPrimType StringRep
 680
 681
 682 -- | Helper for 'mkIntType', 'mkFloatType', 'mkStringType'
 683 mkPrimType :: DataRep -> String -> DataType
 684 mkPrimType dr str = DataType
 685                         { tycon   = str
 686                         , datarep = dr
 687                         }
 688
 689
 690 -- Makes a constructor for primitive types
 691 mkPrimCon :: DataType -> String -> ConstrRep -> Constr
 692 mkPrimCon dt str cr = Constr
 693                         { datatype  = dt
 694                         , conrep    = cr
 695                         , constring = str
 696                         , confields = error "constrFields"
 697                         , confixity = error "constrFixity"
 698                         }
 699
 700
 701 mkIntConstr :: DataType -> Integer -> Constr
 702 mkIntConstr dt i = case datarep dt of
 703                   IntRep -> mkPrimCon dt (show i) (IntConstr i)
 704                   _ -> error "mkIntConstr"
 705
 706
 707 mkFloatConstr :: DataType -> Double -> Constr
 708 mkFloatConstr dt f = case datarep dt of
 709                     FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
 710                     _ -> error "mkFloatConstr"
 711
 712
 713 mkStringConstr :: DataType -> String -> Constr
 714 mkStringConstr dt str = case datarep dt of
 715                        StringRep -> mkPrimCon dt str (StringConstr str)
 716                        _ -> error "mkStringConstr"
 717
 718
 719 ------------------------------------------------------------------------------
 720 --
 721 --      Non-representations for non-presentable types
 722 --
 723 ------------------------------------------------------------------------------
 724
 725
 726 -- | Constructs a non-representation for a non-presentable type
 727 mkNorepType :: String -> DataType
 728 mkNorepType str = DataType
 729                         { tycon   = str
 730                         , datarep = NoRep
 731                         }
 732
 733
 734 -- | Test for a non-representable type
 735 isNorepType :: DataType -> Bool
 736 isNorepType dt = case datarep dt of
 737                    NoRep -> True
 738                    _ -> False
 739
 740
 741
 742 ------------------------------------------------------------------------------
 743 --
 744 --      Convenience for qualified type constructors
 745 --
 746 ------------------------------------------------------------------------------
 747
 748
 749 -- | Gets the unqualified type constructor:
 750 -- drop *.*.*... before name
 751 --
 752 tyconUQname :: String -> String
 753 tyconUQname x = let x' = dropWhile (not . (==) '.') x
 754                  in if x' == [] then x else tyconUQname (tail x')
 755
 756
 757 -- | Gets the module of a type constructor:
 758 -- take *.*.*... before name
 759 tyconModule :: String -> String
 760 tyconModule x = let (a,b) = break ((==) '.') x
 761                  in if b == ""
 762                       then b
 763                       else a ++ tyconModule' (tail b)
 764   where
 765     tyconModule' x = let x' = tyconModule x
 766                       in if x' == "" then "" else ('.':x')