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