compiler/types/TyCon.lhs

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