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