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