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