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