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