ghc/compiler/types/TyCon.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TyCon]{The @TyCon@ datatype}
   5
   6 \begin{code}
   7 module TyCon(
   8         TyCon, ArgVrcs, FieldLabel,
   9
  10         PrimRep(..),
  11         tyConPrimRep,
  12
  13         AlgTyConRhs(..), visibleDataCons,
  14
  15         isFunTyCon, isUnLiftedTyCon, isProductTyCon,
  16         isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
  17         isEnumerationTyCon,
  18         isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
  19         isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConRhs_maybe, isHiBootTyCon,
  20
  21         makeTyConAbstract, isAbstractTyCon,
  22
  23         mkForeignTyCon, isForeignTyCon,
  24
  25         mkAlgTyCon,
  26         mkClassTyCon,
  27         mkFunTyCon,
  28         mkPrimTyCon,
  29         mkLiftedPrimTyCon,
  30         mkTupleTyCon,
  31         mkSynTyCon,
  32
  33         tyConName,
  34         tyConKind,
  35         tyConUnique,
  36         tyConTyVars,
  37         tyConArgVrcs,
  38         algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
  39         tyConFields, tyConSelIds,
  40         tyConStupidTheta,
  41         tyConArity,
  42         isClassTyCon, tyConClass_maybe,
  43         getSynTyConDefn,
  44         tyConExtName,           -- External name for foreign types
  45
  46         maybeTyConSingleCon,
  47
  48         -- Generics
  49         tyConHasGenerics
  50 ) where
  51
  52 #include "HsVersions.h"
  53
  54 import {-# SOURCE #-} TypeRep ( Type, PredType )
  55  -- Should just be Type(Type), but this fails due to bug present up to
  56  -- and including 4.02 involving slurping of hi-boot files.  Bug is now fixed.
  57
  58 import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
  59
  60
  61 import Var              ( TyVar, Id )
  62 import Class            ( Class )
  63 import Kind             ( Kind )
  64 import BasicTypes       ( Arity, RecFlag(..), Boxity(..), isBoxed )
  65 import Name             ( Name, nameUnique, NamedThing(getName) )
  66 import PrelNames        ( Unique, Uniquable(..) )
  67 import Maybes           ( orElse )
  68 import Util             ( equalLength )
  69 import Outputable
  70 import FastString
  71 \end{code}
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection{The data type}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 \begin{code}
  80 data TyCon
  81   = FunTyCon {
  82         tyConUnique :: Unique,
  83         tyConName   :: Name,
  84         tyConKind   :: Kind,
  85         tyConArity  :: Arity
  86     }
  87
  88
  89   | AlgTyCon {          -- Data type, and newtype decls.
  90                         -- All lifted, all boxed
  91         tyConUnique :: Unique,
  92         tyConName   :: Name,
  93         tyConKind   :: Kind,
  94         tyConArity  :: Arity,
  95
  96         tyConTyVars :: [TyVar],         -- Scopes over (a) the [PredType] in AlgTyConRhs.DataTyCon
  97                                         --             (b) the cached types in AlgTyConRhs.NewTyCon
  98                                         --             (c) the types in algTcFields
  99                                         -- But not over the data constructors
 100         argVrcs     :: ArgVrcs,
 101
 102         algTcFields :: [(FieldLabel, Type, Id)],
 103                                         -- Its fields (empty if none):
 104                                         --  * field name
 105                                         --  * its type (scoped over tby tyConTyVars)
 106                                         --  * record selector (name = field name)
 107
 108         algTcStupidTheta :: [PredType], -- The "stupid theta" for the data type
 109                                         -- (always empty for GADTs)
 110
 111         algTcRhs :: AlgTyConRhs,        -- Data constructors in here
 112
 113         algTcRec :: RecFlag,            -- Tells whether the data type is part of
 114                                         -- a mutually-recursive group or not
 115
 116         hasGenerics :: Bool,            -- True <=> generic to/from functions are available
 117                                         -- (in the exports of the data type's source module)
 118
 119         algTcClass :: Maybe Class
 120                 -- Just cl if this tycon came from a class declaration
 121     }
 122
 123   | PrimTyCon {                 -- Primitive types; cannot be defined in Haskell
 124                                 -- Now includes foreign-imported types
 125         tyConUnique   :: Unique,
 126         tyConName     :: Name,
 127         tyConKind     :: Kind,
 128         tyConArity    :: Arity,
 129         argVrcs       :: ArgVrcs,
 130
 131         primTyConRep  :: PrimRep,
 132                         -- Many primitive tycons are unboxed, but some are
 133                         -- boxed (represented by pointers). The CgRep tells.
 134
 135         isUnLifted   :: Bool,           -- Most primitive tycons are unlifted,
 136                                         -- but foreign-imported ones may not be
 137         tyConExtName :: Maybe FastString        -- Just xx for foreign-imported types
 138     }
 139
 140   | TupleTyCon {
 141         tyConUnique :: Unique,
 142         tyConName   :: Name,
 143         tyConKind   :: Kind,
 144         tyConArity  :: Arity,
 145         tyConBoxed  :: Boxity,
 146         tyConTyVars :: [TyVar],
 147         dataCon     :: DataCon,
 148         hasGenerics :: Bool
 149     }
 150
 151   | SynTyCon {
 152         tyConUnique :: Unique,
 153         tyConName   :: Name,
 154         tyConKind   :: Kind,
 155         tyConArity  :: Arity,
 156
 157         tyConTyVars     :: [TyVar],     -- Bound tyvars
 158         synTyConDefn    :: Type,        -- Right-hand side, mentioning these type vars.
 159                                         -- Acts as a template for the expansion when
 160                                         -- the tycon is applied to some types.
 161         argVrcs :: ArgVrcs
 162     }
 163
 164 type FieldLabel = Name
 165
 166 type ArgVrcs = [(Bool,Bool)]  -- Tyvar variance info: [(occPos,occNeg)]
 167         -- [] means "no information, assume the worst"
 168
 169 data AlgTyConRhs
 170   = AbstractTyCon       -- We know nothing about this data type, except
 171                         -- that it's represented by a pointer
 172                         -- Used when we export a data type abstractly into
 173                         -- an hi file
 174
 175   | DataTyCon
 176         [DataCon]       -- The constructors; can be empty if the user declares
 177                         --   the type to have no constructors
 178                         -- INVARIANT: Kept in order of increasing tag
 179                         --            (see the tag assignment in DataCon.mkDataCon)
 180         Bool            -- Cached: True <=> an enumeration type
 181
 182   | NewTyCon            -- Newtypes always have exactly one constructor
 183         DataCon         -- The unique constructor; it has no existentials
 184         Type            -- Cached: the argument type of the constructor
 185                         --  = the representation type of the tycon
 186
 187         Type            -- Cached: the *ultimate* representation type
 188                         -- By 'ultimate' I mean that the rep type is not itself
 189                         -- a newtype or type synonym.
 190                         -- The rep type isn't entirely simple:
 191                         --  for a recursive newtype we pick () as the rep type
 192                         --      newtype T = MkT T
 193                         --
 194                         -- The rep type has free type variables the tyConTyVars
 195                         -- Thus:
 196                         --      newtype T a = MkT [(a,Int)]
 197                         -- The rep type is [(a,Int)]
 198         -- NB: the rep type isn't necessarily the original RHS of the
 199         --     newtype decl, because the rep type looks through other
 200         --     newtypes.
 201
 202 visibleDataCons :: AlgTyConRhs -> [DataCon]
 203 visibleDataCons AbstractTyCon    = []
 204 visibleDataCons (DataTyCon cs _) = cs
 205 visibleDataCons (NewTyCon c _ _) = [c]
 206 \end{code}
 207
 208 %************************************************************************
 209 %*                                                                      *
 210 \subsection{PrimRep}
 211 %*                                                                      *
 212 %************************************************************************
 213
 214 A PrimRep is an abstraction of a type.  It contains information that
 215 the code generator needs in order to pass arguments, return results,
 216 and store values of this type.
 217
 218 A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
 219 MachRep (see cmm/MachOp), although each of these types has a distinct
 220 and clearly defined purpose:
 221
 222   - A PrimRep is a CgRep + information about signedness + information
 223     about primitive pointers (AddrRep).  Signedness and primitive
 224     pointers are required when passing a primitive type to a foreign
 225     function, but aren't needed for call/return conventions of Haskell
 226     functions.
 227
 228   - A MachRep is a basic machine type (non-void, doesn't contain
 229     information on pointerhood or signedness, but contains some
 230     reps that don't have corresponding Haskell types).
 231
 232 \begin{code}
 233 data PrimRep
 234   = VoidRep
 235   | PtrRep
 236   | IntRep              -- signed, word-sized
 237   | WordRep             -- unsinged, word-sized
 238   | Int64Rep            -- signed, 64 bit (32-bit words only)
 239   | Word64Rep           -- unsigned, 64 bit (32-bit words only)
 240   | AddrRep             -- a pointer, but not to a Haskell value
 241   | FloatRep
 242   | DoubleRep
 243 \end{code}
 244
 245 %************************************************************************
 246 %*                                                                      *
 247 \subsection{TyCon Construction}
 248 %*                                                                      *
 249 %************************************************************************
 250
 251 Note: the TyCon constructors all take a Kind as one argument, even though
 252 they could, in principle, work out their Kind from their other arguments.
 253 But to do so they need functions from Types, and that makes a nasty
 254 module mutual-recursion.  And they aren't called from many places.
 255 So we compromise, and move their Kind calculation to the call site.
 256
 257 \begin{code}
 258 mkFunTyCon :: Name -> Kind -> TyCon
 259 mkFunTyCon name kind
 260   = FunTyCon {
 261         tyConUnique = nameUnique name,
 262         tyConName   = name,
 263         tyConKind   = kind,
 264         tyConArity  = 2
 265     }
 266
 267 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
 268 -- but now you also have to pass in the generic information about the type
 269 -- constructor - you can get hold of it easily (see Generics module)
 270 mkAlgTyCon name kind tyvars argvrcs stupid rhs flds is_rec gen_info
 271   = AlgTyCon {
 272         tyConName        = name,
 273         tyConUnique      = nameUnique name,
 274         tyConKind        = kind,
 275         tyConArity       = length tyvars,
 276         tyConTyVars      = tyvars,
 277         argVrcs          = argvrcs,
 278         algTcStupidTheta = stupid,
 279         algTcRhs         = rhs,
 280         algTcFields      = flds,
 281         algTcClass       = Nothing,
 282         algTcRec         = is_rec,
 283         hasGenerics = gen_info
 284     }
 285
 286 mkClassTyCon name kind tyvars argvrcs rhs clas is_rec
 287   = AlgTyCon {
 288         tyConName        = name,
 289         tyConUnique      = nameUnique name,
 290         tyConKind        = kind,
 291         tyConArity       = length tyvars,
 292         tyConTyVars      = tyvars,
 293         argVrcs          = argvrcs,
 294         algTcStupidTheta = [],
 295         algTcRhs         = rhs,
 296         algTcFields      = [],
 297         algTcClass       = Just clas,
 298         algTcRec         = is_rec,
 299         hasGenerics = False
 300     }
 301
 302
 303 mkTupleTyCon name kind arity tyvars con boxed gen_info
 304   = TupleTyCon {
 305         tyConUnique = nameUnique name,
 306         tyConName = name,
 307         tyConKind = kind,
 308         tyConArity = arity,
 309         tyConBoxed = boxed,
 310         tyConTyVars = tyvars,
 311         dataCon = con,
 312         hasGenerics = gen_info
 313     }
 314
 315 -- Foreign-imported (.NET) type constructors are represented
 316 -- as primitive, but *lifted*, TyCons for now. They are lifted
 317 -- because the Haskell type T representing the (foreign) .NET
 318 -- type T is actually implemented (in ILX) as a thunk<T>
 319 mkForeignTyCon name ext_name kind arity arg_vrcs
 320   = PrimTyCon {
 321         tyConName    = name,
 322         tyConUnique  = nameUnique name,
 323         tyConKind    = kind,
 324         tyConArity   = arity,
 325         argVrcs      = arg_vrcs,
 326         primTyConRep = PtrRep, -- they all do
 327         isUnLifted   = False,
 328         tyConExtName = ext_name
 329     }
 330
 331
 332 -- most Prim tycons are lifted
 333 mkPrimTyCon name kind arity arg_vrcs rep
 334   = mkPrimTyCon' name kind arity arg_vrcs rep True
 335
 336 -- but RealWorld is lifted
 337 mkLiftedPrimTyCon name kind arity arg_vrcs rep
 338   = mkPrimTyCon' name kind arity arg_vrcs rep False
 339
 340 mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted
 341   = PrimTyCon {
 342         tyConName    = name,
 343         tyConUnique  = nameUnique name,
 344         tyConKind    = kind,
 345         tyConArity   = arity,
 346         argVrcs      = arg_vrcs,
 347         primTyConRep = rep,
 348         isUnLifted   = is_unlifted,
 349         tyConExtName = Nothing
 350     }
 351
 352 mkSynTyCon name kind tyvars rhs argvrcs
 353   = SynTyCon {
 354         tyConName = name,
 355         tyConUnique = nameUnique name,
 356         tyConKind = kind,
 357         tyConArity = length tyvars,
 358         tyConTyVars = tyvars,
 359         synTyConDefn = rhs,
 360         argVrcs      = argvrcs
 361     }
 362 \end{code}
 363
 364 \begin{code}
 365 isFunTyCon :: TyCon -> Bool
 366 isFunTyCon (FunTyCon {}) = True
 367 isFunTyCon _             = False
 368
 369 isAbstractTyCon :: TyCon -> Bool
 370 isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True
 371 isAbstractTyCon _ = False
 372
 373 makeTyConAbstract :: TyCon -> TyCon
 374 makeTyConAbstract tc@(AlgTyCon {}) = tc { algTcRhs = AbstractTyCon }
 375 makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)
 376
 377 isPrimTyCon :: TyCon -> Bool
 378 isPrimTyCon (PrimTyCon {}) = True
 379 isPrimTyCon _              = False
 380
 381 isUnLiftedTyCon :: TyCon -> Bool
 382 isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
 383 isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
 384 isUnLiftedTyCon _                                       = False
 385
 386 -- isAlgTyCon returns True for both @data@ and @newtype@
 387 isAlgTyCon :: TyCon -> Bool
 388 isAlgTyCon (AlgTyCon {})   = True
 389 isAlgTyCon (TupleTyCon {}) = True
 390 isAlgTyCon other           = False
 391
 392 isDataTyCon :: TyCon -> Bool
 393 -- isDataTyCon returns True for data types that are represented by
 394 -- heap-allocated constructors.
 395 -- These are srcutinised by Core-level @case@ expressions, and they
 396 -- get info tables allocated for them.
 397 --      True for all @data@ types
 398 --      False for newtypes
 399 --                unboxed tuples
 400 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})
 401   = case rhs of
 402         DataTyCon _ _  -> True
 403         NewTyCon _ _ _ -> False
 404         AbstractTyCon  -> pprPanic "isDataTyCon" (ppr tc)
 405
 406 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 407 isDataTyCon other = False
 408
 409 isNewTyCon :: TyCon -> Bool
 410 isNewTyCon (AlgTyCon {algTcRhs = NewTyCon _ _ _}) = True
 411 isNewTyCon other                                  = False
 412
 413 isProductTyCon :: TyCon -> Bool
 414 -- A "product" tycon
 415 --      has *one* constructor,
 416 --      is *not* existential
 417 -- but
 418 --      may be  DataType or NewType,
 419 --      may be  unboxed or not,
 420 --      may be  recursive or not
 421 isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
 422                                     DataTyCon [data_con] _ -> isVanillaDataCon data_con
 423                                     NewTyCon _ _ _         -> True
 424                                     other                  -> False
 425 isProductTyCon (TupleTyCon {})  = True
 426 isProductTyCon other            = False
 427
 428 isSynTyCon :: TyCon -> Bool
 429 isSynTyCon (SynTyCon {}) = True
 430 isSynTyCon _             = False
 431
 432 isEnumerationTyCon :: TyCon -> Bool
 433 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon _ is_enum}) = is_enum
 434 isEnumerationTyCon other                                       = False
 435
 436 isTupleTyCon :: TyCon -> Bool
 437 -- The unit tycon didn't used to be classed as a tuple tycon
 438 -- but I thought that was silly so I've undone it
 439 -- If it can't be for some reason, it should be a AlgTyCon
 440 isTupleTyCon (TupleTyCon {}) = True
 441 isTupleTyCon other           = False
 442
 443 isUnboxedTupleTyCon :: TyCon -> Bool
 444 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
 445 isUnboxedTupleTyCon other = False
 446
 447 isBoxedTupleTyCon :: TyCon -> Bool
 448 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 449 isBoxedTupleTyCon other = False
 450
 451 tupleTyConBoxity tc = tyConBoxed tc
 452
 453 isRecursiveTyCon :: TyCon -> Bool
 454 isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
 455 isRecursiveTyCon other                                = False
 456
 457 isHiBootTyCon :: TyCon -> Bool
 458 -- Used for knot-tying in hi-boot files
 459 isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
 460 isHiBootTyCon other                                 = False
 461
 462 isForeignTyCon :: TyCon -> Bool
 463 -- isForeignTyCon identifies foreign-imported type constructors
 464 isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
 465 isForeignTyCon other                               = False
 466 \end{code}
 467
 468 \begin{code}
 469 tyConHasGenerics :: TyCon -> Bool
 470 tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
 471 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
 472 tyConHasGenerics other                           = False        -- Synonyms
 473
 474 tyConDataCons :: TyCon -> [DataCon]
 475 -- It's convenient for tyConDataCons to return the
 476 -- empty list for type synonyms etc
 477 tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
 478
 479 tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
 480 tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon cons _}) = Just cons
 481 tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon con _ _}) = Just [con]
 482 tyConDataCons_maybe (TupleTyCon {dataCon = con})             = Just [con]
 483 tyConDataCons_maybe other                                    = Nothing
 484
 485 tyConFamilySize  :: TyCon -> Int
 486 tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon cons _}) = length cons
 487 tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon _ _ _})   = 1
 488 tyConFamilySize (TupleTyCon {})                          = 1
 489 #ifdef DEBUG
 490 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 491 #endif
 492
 493 tyConFields :: TyCon -> [(FieldLabel,Type,Id)]
 494 tyConFields (AlgTyCon {algTcFields = fs}) = fs
 495 tyConFields other_tycon                   = []
 496
 497 tyConSelIds :: TyCon -> [Id]
 498 tyConSelIds tc = [id | (_,_,id) <- tyConFields tc]
 499
 500 algTyConRhs :: TyCon -> AlgTyConRhs
 501 algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
 502 algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon [con] False
 503 algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
 504 \end{code}
 505
 506 \begin{code}
 507 newTyConRhs :: TyCon -> ([TyVar], Type)
 508 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon _ rhs _}) = (tvs, rhs)
 509 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
 510
 511 newTyConRhs_maybe :: TyCon
 512                   -> [Type]                     -- Args to tycon
 513                   -> Maybe ([(TyVar,Type)],     -- Substitution
 514                             Type)               -- Body type (not yet substituted)
 515 -- Non-recursive newtypes are transparent to Core;
 516 -- Given an application to some types, return Just (tenv, ty)
 517 -- if it's a saturated, non-recursive newtype.
 518 newTyConRhs_maybe (AlgTyCon {tyConTyVars = tvs,
 519                              algTcRec = NonRecursive,   -- Not recursive
 520                              algTcRhs = NewTyCon _ rhs _}) tys
 521    | tvs `equalLength` tys      -- Saturated
 522    = Just (tvs `zip` tys, rhs)
 523
 524 newTyConRhs_maybe other_tycon tys = Nothing
 525
 526
 527 newTyConRep :: TyCon -> ([TyVar], Type)
 528 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon _ _ rep}) = (tvs, rep)
 529 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
 530
 531 tyConPrimRep :: TyCon -> PrimRep
 532 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
 533 tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
 534 \end{code}
 535
 536 \begin{code}
 537 tyConStupidTheta :: TyCon -> [PredType]
 538 tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
 539 tyConStupidTheta (TupleTyCon {})                        = []
 540 tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 541 \end{code}
 542
 543 @tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
 544 each tyvar, if available.  See @calcAlgTyConArgVrcs@ for how this is
 545 actually computed (in another file).
 546
 547 \begin{code}
 548 tyConArgVrcs :: TyCon -> ArgVrcs
 549 tyConArgVrcs (FunTyCon   {})                   = [(False,True),(True,False)]
 550 tyConArgVrcs (AlgTyCon   {argVrcs = oi})       = oi
 551 tyConArgVrcs (PrimTyCon  {argVrcs = oi})       = oi
 552 tyConArgVrcs (TupleTyCon {tyConArity = arity}) = (replicate arity (True,False))
 553 tyConArgVrcs (SynTyCon   {argVrcs = oi})       = oi
 554 \end{code}
 555
 556 \begin{code}
 557 getSynTyConDefn :: TyCon -> ([TyVar], Type)
 558 getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,ty)
 559 getSynTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
 560 \end{code}
 561
 562 \begin{code}
 563 maybeTyConSingleCon :: TyCon -> Maybe DataCon
 564 maybeTyConSingleCon (AlgTyCon {algTcRhs = DataTyCon [c] _}) = Just c
 565 maybeTyConSingleCon (AlgTyCon {algTcRhs = NewTyCon c _ _})  = Just c
 566 maybeTyConSingleCon (AlgTyCon {})                           = Nothing
 567 maybeTyConSingleCon (TupleTyCon {dataCon = con})            = Just con
 568 maybeTyConSingleCon (PrimTyCon {})                          = Nothing
 569 maybeTyConSingleCon (FunTyCon {})                           = Nothing  -- case at funty
 570 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc
 571 \end{code}
 572
 573 \begin{code}
 574 isClassTyCon :: TyCon -> Bool
 575 isClassTyCon (AlgTyCon {algTcClass = Just _}) = True
 576 isClassTyCon other_tycon                         = False
 577
 578 tyConClass_maybe :: TyCon -> Maybe Class
 579 tyConClass_maybe (AlgTyCon {algTcClass = maybe_clas}) = maybe_clas
 580 tyConClass_maybe ther_tycon                              = Nothing
 581 \end{code}
 582
 583
 584 %************************************************************************
 585 %*                                                                      *
 586 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
 587 %*                                                                      *
 588 %************************************************************************
 589
 590 @TyCon@s are compared by comparing their @Unique@s.
 591
 592 The strictness analyser needs @Ord@. It is a lexicographic order with
 593 the property @(a<=b) || (b<=a)@.
 594
 595 \begin{code}
 596 instance Eq TyCon where
 597     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 598     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 599
 600 instance Ord TyCon where
 601     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 602     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 603     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 604     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 605     compare a b = getUnique a `compare` getUnique b
 606
 607 instance Uniquable TyCon where
 608     getUnique tc = tyConUnique tc
 609
 610 instance Outputable TyCon where
 611     ppr tc  = ppr (getName tc)
 612
 613 instance NamedThing TyCon where
 614     getName = tyConName
 615 \end{code}