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
 554 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 555 isDataTyCon other = False
 556
 557 isNewTyCon :: TyCon -> Bool
 558 isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
 559 isNewTyCon other                               = False
 560
 561 isProductTyCon :: TyCon -> Bool
 562 -- A "product" tycon
 563 --      has *one* constructor,
 564 --      is *not* existential
 565 -- but
 566 --      may be  DataType, NewType
 567 --      may be  unboxed or not,
 568 --      may be  recursive or not
 569 --
 570 isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
 571                                     DataTyCon{ data_cons = [data_con] }
 572                                                 -> isVanillaDataCon data_con
 573                                     NewTyCon {} -> True
 574                                     other       -> False
 575 isProductTyCon (TupleTyCon {})  = True
 576 isProductTyCon other            = False
 577
 578 isSynTyCon :: TyCon -> Bool
 579 isSynTyCon (SynTyCon {}) = True
 580 isSynTyCon _             = False
 581
 582 isGadtSyntaxTyCon :: TyCon -> Bool
 583 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
 584 isGadtSyntaxTyCon other                                = False
 585
 586 isEnumerationTyCon :: TyCon -> Bool
 587 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
 588 isEnumerationTyCon other                                               = False
 589
 590 isOpenTyCon :: TyCon -> Bool
 591 isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _}) = True
 592 isOpenTyCon (AlgTyCon {algTcRhs = OpenDataTyCon }) = True
 593 isOpenTyCon (AlgTyCon {algTcRhs = OpenNewTyCon  }) = True
 594 isOpenTyCon _                                      = False
 595
 596 assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
 597 assocTyConArgPoss_maybe (AlgTyCon { tyConArgPoss = poss }) = poss
 598 assocTyConArgPoss_maybe (SynTyCon { tyConArgPoss = poss }) = poss
 599 assocTyConArgPoss_maybe _                                  = Nothing
 600
 601 isTyConAssoc :: TyCon -> Bool
 602 isTyConAssoc = isJust . assocTyConArgPoss_maybe
 603
 604 setTyConArgPoss :: TyCon -> [Int] -> TyCon
 605 setTyConArgPoss tc@(AlgTyCon {}) poss = tc { tyConArgPoss = Just poss }
 606 setTyConArgPoss tc@(SynTyCon {}) poss = tc { tyConArgPoss = Just poss }
 607 setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
 608
 609 isTupleTyCon :: TyCon -> Bool
 610 -- The unit tycon didn't used to be classed as a tuple tycon
 611 -- but I thought that was silly so I've undone it
 612 -- If it can't be for some reason, it should be a AlgTyCon
 613 --
 614 -- NB: when compiling Data.Tuple, the tycons won't reply True to
 615 -- isTupleTyCon, becuase they are built as AlgTyCons.  However they
 616 -- get spat into the interface file as tuple tycons, so I don't think
 617 -- it matters.
 618 isTupleTyCon (TupleTyCon {}) = True
 619 isTupleTyCon other           = False
 620
 621 isUnboxedTupleTyCon :: TyCon -> Bool
 622 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
 623 isUnboxedTupleTyCon other = False
 624
 625 isBoxedTupleTyCon :: TyCon -> Bool
 626 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 627 isBoxedTupleTyCon other = False
 628
 629 tupleTyConBoxity tc = tyConBoxed tc
 630
 631 isRecursiveTyCon :: TyCon -> Bool
 632 isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
 633 isRecursiveTyCon other                                = False
 634
 635 isHiBootTyCon :: TyCon -> Bool
 636 -- Used for knot-tying in hi-boot files
 637 isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
 638 isHiBootTyCon other                                 = False
 639
 640 isForeignTyCon :: TyCon -> Bool
 641 -- isForeignTyCon identifies foreign-imported type constructors
 642 isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
 643 isForeignTyCon other                               = False
 644
 645 isSuperKindTyCon :: TyCon -> Bool
 646 isSuperKindTyCon (SuperKindTyCon {}) = True
 647 isSuperKindTyCon other               = False
 648
 649 isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> Kind)
 650 isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule})
 651   = Just (ar, rule)
 652 isCoercionTyCon_maybe other = Nothing
 653
 654 isCoercionTyCon (CoercionTyCon {}) = True
 655 isCoercionTyCon other              = False
 656 \end{code}
 657
 658
 659 -----------------------------------------------
 660 --      Expand type-constructor applications
 661 -----------------------------------------------
 662
 663 \begin{code}
 664 tcExpandTyCon_maybe, coreExpandTyCon_maybe
 665         :: TyCon
 666         -> [Type]                       -- Args to tycon
 667         -> Maybe ([(TyVar,Type)],       -- Substitution
 668                   Type,                 -- Body type (not yet substituted)
 669                   [Type])               -- Leftover args
 670
 671 -- For the *typechecker* view, we expand synonyms only
 672 tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs,
 673                                synTcRhs = SynonymTyCon rhs }) tys
 674    = expand tvs rhs tys
 675 tcExpandTyCon_maybe other_tycon tys = Nothing
 676
 677 ---------------
 678 -- For the *Core* view, we expand synonyms only as well
 679
 680 coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,       -- Not recursive
 681          algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
 682    = case etad_rhs of   -- Don't do this in the pattern match, lest we accidentally
 683                         -- match the etad_rhs of a *recursive* newtype
 684         (tvs,rhs) -> expand tvs rhs tys
 685
 686 coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
 687
 688
 689 ----------------
 690 expand  :: [TyVar] -> Type                      -- Template
 691         -> [Type]                               -- Args
 692         -> Maybe ([(TyVar,Type)], Type, [Type]) -- Expansion
 693 expand tvs rhs tys
 694   = case n_tvs `compare` length tys of
 695         LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
 696         EQ -> Just (tvs `zip` tys, rhs, [])
 697         GT -> Nothing
 698    where
 699      n_tvs = length tvs
 700 \end{code}
 701
 702 \begin{code}
 703 tyConHasGenerics :: TyCon -> Bool
 704 tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
 705 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
 706 tyConHasGenerics other                           = False        -- Synonyms
 707
 708 tyConDataCons :: TyCon -> [DataCon]
 709 -- It's convenient for tyConDataCons to return the
 710 -- empty list for type synonyms etc
 711 tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
 712
 713 tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
 714 tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
 715 tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
 716 tyConDataCons_maybe (TupleTyCon {dataCon = con})                           = Just [con]
 717 tyConDataCons_maybe other                                                  = Nothing
 718
 719 tyConFamilySize  :: TyCon -> Int
 720 tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) =
 721   length cons
 722 tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
 723 tyConFamilySize (AlgTyCon   {algTcRhs = OpenDataTyCon})                = 0
 724 tyConFamilySize (TupleTyCon {})                                        = 1
 725 #ifdef DEBUG
 726 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 727 #endif
 728
 729 tyConSelIds :: TyCon -> [Id]
 730 tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
 731 tyConSelIds other_tycon                   = []
 732
 733 algTyConRhs :: TyCon -> AlgTyConRhs
 734 algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
 735 algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
 736 algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
 737 \end{code}
 738
 739 \begin{code}
 740 newTyConRhs :: TyCon -> ([TyVar], Type)
 741 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
 742 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
 743
 744 newTyConRep :: TyCon -> ([TyVar], Type)
 745 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
 746 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
 747
 748 newTyConCo :: TyCon -> Maybe TyCon
 749 newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }}) = co
 750 newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon)
 751
 752 tyConPrimRep :: TyCon -> PrimRep
 753 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
 754 tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
 755 \end{code}
 756
 757 \begin{code}
 758 tyConStupidTheta :: TyCon -> [PredType]
 759 tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
 760 tyConStupidTheta (TupleTyCon {})                        = []
 761 tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 762 \end{code}
 763
 764 \begin{code}
 765 synTyConDefn :: TyCon -> ([TyVar], Type)
 766 synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty})
 767   = (tyvars, ty)
 768 synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
 769
 770 synTyConRhs :: TyCon -> SynTyConRhs
 771 synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
 772 synTyConRhs tc                          = pprPanic "synTyConRhs" (ppr tc)
 773
 774 synTyConType :: TyCon -> Type
 775 synTyConType tc = case synTcRhs tc of
 776                     SynonymTyCon t -> t
 777                     _              -> pprPanic "synTyConType" (ppr tc)
 778
 779 synTyConResKind :: TyCon -> Kind
 780 synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind}) = kind
 781 synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
 782 \end{code}
 783
 784 \begin{code}
 785 maybeTyConSingleCon :: TyCon -> Maybe DataCon
 786 maybeTyConSingleCon (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
 787 maybeTyConSingleCon (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})    = Just c
 788 maybeTyConSingleCon (AlgTyCon {})                = Nothing
 789 maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
 790 maybeTyConSingleCon (PrimTyCon {})               = Nothing
 791 maybeTyConSingleCon (FunTyCon {})                = Nothing  -- case at funty
 792 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc
 793 \end{code}
 794
 795 \begin{code}
 796 isClassTyCon :: TyCon -> Bool
 797 isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
 798 isClassTyCon other_tycon                             = False
 799
 800 tyConClass_maybe :: TyCon -> Maybe Class
 801 tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
 802 tyConClass_maybe ther_tycon                                 = Nothing
 803
 804 isFamInstTyCon :: TyCon -> Bool
 805 isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _}) = True
 806 isFamInstTyCon other_tycon                                  = False
 807
 808 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
 809 tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) =
 810   Just (fam, instTys)
 811 tyConFamInst_maybe ther_tycon                                           =
 812   Nothing
 813
 814 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
 815 tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) =
 816   Just coe
 817 tyConFamilyCoercion_maybe ther_tycon                                     =
 818   Nothing
 819 \end{code}
 820
 821
 822 %************************************************************************
 823 %*                                                                      *
 824 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
 825 %*                                                                      *
 826 %************************************************************************
 827
 828 @TyCon@s are compared by comparing their @Unique@s.
 829
 830 The strictness analyser needs @Ord@. It is a lexicographic order with
 831 the property @(a<=b) || (b<=a)@.
 832
 833 \begin{code}
 834 instance Eq TyCon where
 835     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 836     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 837
 838 instance Ord TyCon where
 839     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 840     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 841     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 842     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 843     compare a b = getUnique a `compare` getUnique b
 844
 845 instance Uniquable TyCon where
 846     getUnique tc = tyConUnique tc
 847
 848 instance Outputable TyCon where
 849     ppr tc  = ppr (getName tc)
 850
 851 instance NamedThing TyCon where
 852     getName = tyConName
 853 \end{code}