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