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