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, isNewTyCon, isClosedNewTyCon, isSynTyCon,
  21         isClosedSynTyCon, 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
 271   = NoParentTyCon       -- An ordinary type constructor has no parent.
 272
 273   | ClassTyCon          -- Type constructors representing a class dictionary.
 274         Class
 275
 276   | FamilyTyCon         -- Type constructors representing an instance of a type
 277         TyCon           --   The type family
 278         [Type]          --   Instance types
 279         TyCon           --   A CoercionTyCon identifying the representation
 280                         --     type with the type instance family.
 281                         --      c.f. Note [Newtype coercions]
 282         -- E.g.  data intance T [a] = ...
 283         -- gives a representation tycon:
 284         --      data T77 a = ...
 285         --      axiom co a :: T [a] ~ T77 a
 286         -- with T77's algTcParent = FamilyTyCon T [a] co
 287
 288 data SynTyConRhs
 289   = OpenSynTyCon Kind   -- Type family: *result* kind given
 290   | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
 291                         --  the expansion when the tycon is applied to some
 292                         --  types.
 293 \end{code}
 294
 295 Note [Newtype coercions]
 296 ~~~~~~~~~~~~~~~~~~~~~~~~
 297
 298 The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
 299 which is used for coercing from the representation type of the
 300 newtype, to the newtype itself. For example,
 301
 302    newtype T a = MkT (a -> a)
 303
 304 the NewTyCon for T will contain nt_co = CoT where CoT t : T t :=: t ->
 305 t.  This TyCon is a CoercionTyCon, so it does not have a kind on its
 306 own; it basically has its own typing rule for the fully-applied
 307 version.  If the newtype T has k type variables then CoT has arity at
 308 most k.  In the case that the right hand side is a type application
 309 ending with the same type variables as the left hand side, we
 310 "eta-contract" the coercion.  So if we had
 311
 312    newtype S a = MkT [a]
 313
 314 then we would generate the arity 0 coercion CoS : S :=: [].  The
 315 primary reason we do this is to make newtype deriving cleaner.
 316
 317 In the paper we'd write
 318         axiom CoT : (forall t. T t) :=: (forall t. [t])
 319 and then when we used CoT at a particular type, s, we'd say
 320         CoT @ s
 321 which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 322
 323 But in GHC we instead make CoT into a new piece of type syntax, CoercionTyCon,
 324 (like instCoercionTyCon, symCoercionTyCon etc), which must always
 325 be saturated, but which encodes as
 326         TyConApp CoT [s]
 327 In the vocabulary of the paper it's as if we had axiom declarations
 328 like
 329         axiom CoT t :  T t :=: [t]
 330
 331 Note [Newtype eta]
 332 ~~~~~~~~~~~~~~~~~~
 333 Consider
 334         newtype Parser m a = MkParser (Foogle m a)
 335 Are these two types equal (to Core)?
 336         Monad (Parser m)
 337         Monad (Foogle m)
 338 Well, yes.  But to see that easily we eta-reduce the RHS type of
 339 Parser, in this case to ([], Froogle), so that even unsaturated applications
 340 of Parser will work right.  This eta reduction is done when the type
 341 constructor is built, and cached in NewTyCon.  The cached field is
 342 only used in coreExpandTyCon_maybe.
 343
 344 Here's an example that I think showed up in practice
 345 Source code:
 346         newtype T a = MkT [a]
 347         newtype Foo m = MkFoo (forall a. m a -> Int)
 348
 349         w1 :: Foo []
 350         w1 = ...
 351
 352         w2 :: Foo T
 353         w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
 354
 355 After desugaring, and discading the data constructors for the newtypes,
 356 we get:
 357         w2 :: Foo T
 358         w2 = w1
 359 And now Lint complains unless Foo T == Foo [], and that requires T==[]
 360
 361
 362 %************************************************************************
 363 %*                                                                      *
 364 \subsection{PrimRep}
 365 %*                                                                      *
 366 %************************************************************************
 367
 368 A PrimRep is an abstraction of a type.  It contains information that
 369 the code generator needs in order to pass arguments, return results,
 370 and store values of this type.
 371
 372 A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
 373 MachRep (see cmm/MachOp), although each of these types has a distinct
 374 and clearly defined purpose:
 375
 376   - A PrimRep is a CgRep + information about signedness + information
 377     about primitive pointers (AddrRep).  Signedness and primitive
 378     pointers are required when passing a primitive type to a foreign
 379     function, but aren't needed for call/return conventions of Haskell
 380     functions.
 381
 382   - A MachRep is a basic machine type (non-void, doesn't contain
 383     information on pointerhood or signedness, but contains some
 384     reps that don't have corresponding Haskell types).
 385
 386 \begin{code}
 387 data PrimRep
 388   = VoidRep
 389   | PtrRep
 390   | IntRep              -- signed, word-sized
 391   | WordRep             -- unsinged, word-sized
 392   | Int64Rep            -- signed, 64 bit (32-bit words only)
 393   | Word64Rep           -- unsigned, 64 bit (32-bit words only)
 394   | AddrRep             -- a pointer, but not to a Haskell value
 395   | FloatRep
 396   | DoubleRep
 397 \end{code}
 398
 399 %************************************************************************
 400 %*                                                                      *
 401 \subsection{TyCon Construction}
 402 %*                                                                      *
 403 %************************************************************************
 404
 405 Note: the TyCon constructors all take a Kind as one argument, even though
 406 they could, in principle, work out their Kind from their other arguments.
 407 But to do so they need functions from Types, and that makes a nasty
 408 module mutual-recursion.  And they aren't called from many places.
 409 So we compromise, and move their Kind calculation to the call site.
 410
 411 \begin{code}
 412 mkFunTyCon :: Name -> Kind -> TyCon
 413 mkFunTyCon name kind
 414   = FunTyCon {
 415         tyConUnique = nameUnique name,
 416         tyConName   = name,
 417         tyConKind   = kind,
 418         tyConArity  = 2
 419     }
 420
 421 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
 422 -- but now you also have to pass in the generic information about the type
 423 -- constructor - you can get hold of it easily (see Generics module)
 424 mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
 425   = AlgTyCon {
 426         tyConName        = name,
 427         tyConUnique      = nameUnique name,
 428         tyConKind        = kind,
 429         tyConArity       = length tyvars,
 430         tyConTyVars      = tyvars,
 431         tyConArgPoss     = Nothing,
 432         algTcStupidTheta = stupid,
 433         algTcRhs         = rhs,
 434         algTcSelIds      = sel_ids,
 435         algTcParent      = parent,
 436         algTcRec         = is_rec,
 437         algTcGadtSyntax  = gadt_syn,
 438         hasGenerics = gen_info
 439     }
 440
 441 mkClassTyCon name kind tyvars rhs clas is_rec =
 442   mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False
 443
 444 mkTupleTyCon name kind arity tyvars con boxed gen_info
 445   = TupleTyCon {
 446         tyConUnique = nameUnique name,
 447         tyConName = name,
 448         tyConKind = kind,
 449         tyConArity = arity,
 450         tyConBoxed = boxed,
 451         tyConTyVars = tyvars,
 452         dataCon = con,
 453         hasGenerics = gen_info
 454     }
 455
 456 -- Foreign-imported (.NET) type constructors are represented
 457 -- as primitive, but *lifted*, TyCons for now. They are lifted
 458 -- because the Haskell type T representing the (foreign) .NET
 459 -- type T is actually implemented (in ILX) as a thunk<T>
 460 mkForeignTyCon name ext_name kind arity
 461   = PrimTyCon {
 462         tyConName    = name,
 463         tyConUnique  = nameUnique name,
 464         tyConKind    = kind,
 465         tyConArity   = arity,
 466         primTyConRep = PtrRep, -- they all do
 467         isUnLifted   = False,
 468         tyConExtName = ext_name
 469     }
 470
 471
 472 -- most Prim tycons are lifted
 473 mkPrimTyCon name kind arity rep
 474   = mkPrimTyCon' name kind arity rep True
 475
 476 mkVoidPrimTyCon name kind arity
 477   = mkPrimTyCon' name kind arity VoidRep True
 478
 479 -- but RealWorld is lifted
 480 mkLiftedPrimTyCon name kind arity rep
 481   = mkPrimTyCon' name kind arity rep False
 482
 483 mkPrimTyCon' name kind arity rep is_unlifted
 484   = PrimTyCon {
 485         tyConName    = name,
 486         tyConUnique  = nameUnique name,
 487         tyConKind    = kind,
 488         tyConArity   = arity,
 489         primTyConRep = rep,
 490         isUnLifted   = is_unlifted,
 491         tyConExtName = Nothing
 492     }
 493
 494 mkSynTyCon name kind tyvars rhs
 495   = SynTyCon {
 496         tyConName = name,
 497         tyConUnique = nameUnique name,
 498         tyConKind = kind,
 499         tyConArity = length tyvars,
 500         tyConTyVars = tyvars,
 501         tyConArgPoss = Nothing,
 502         synTcRhs = rhs
 503     }
 504
 505 mkCoercionTyCon name arity kindRule
 506   = CoercionTyCon {
 507         tyConName = name,
 508         tyConUnique = nameUnique name,
 509         tyConArity = arity,
 510         coKindFun = kindRule
 511     }
 512
 513 -- Super kinds always have arity zero
 514 mkSuperKindTyCon name
 515   = SuperKindTyCon {
 516         tyConName = name,
 517         tyConUnique = nameUnique name
 518   }
 519 \end{code}
 520
 521 \begin{code}
 522 isFunTyCon :: TyCon -> Bool
 523 isFunTyCon (FunTyCon {}) = True
 524 isFunTyCon _             = False
 525
 526 isAbstractTyCon :: TyCon -> Bool
 527 isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True
 528 isAbstractTyCon _ = False
 529
 530 makeTyConAbstract :: TyCon -> TyCon
 531 makeTyConAbstract tc@(AlgTyCon {}) = tc { algTcRhs = AbstractTyCon }
 532 makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)
 533
 534 isPrimTyCon :: TyCon -> Bool
 535 isPrimTyCon (PrimTyCon {}) = True
 536 isPrimTyCon _              = False
 537
 538 isUnLiftedTyCon :: TyCon -> Bool
 539 isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
 540 isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
 541 isUnLiftedTyCon _                                       = False
 542
 543 -- isAlgTyCon returns True for both @data@ and @newtype@
 544 isAlgTyCon :: TyCon -> Bool
 545 isAlgTyCon (AlgTyCon {})   = True
 546 isAlgTyCon (TupleTyCon {}) = True
 547 isAlgTyCon other           = False
 548
 549 isDataTyCon :: TyCon -> Bool
 550 -- isDataTyCon returns True for data types that are definitely
 551 -- represented by heap-allocated constructors.
 552 -- These are srcutinised by Core-level @case@ expressions, and they
 553 -- get info tables allocated for them.
 554 --      True for all @data@ types
 555 --      False for newtypes
 556 --                unboxed tuples
 557 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})
 558   = case rhs of
 559         OpenDataTyCon -> True
 560         DataTyCon {}  -> True
 561         OpenNewTyCon  -> False
 562         NewTyCon {}   -> False
 563         AbstractTyCon -> False  -- We don't know, so return False
 564 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 565 isDataTyCon other = False
 566
 567 isNewTyCon :: TyCon -> Bool
 568 isNewTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of
 569                                            OpenNewTyCon -> True
 570                                            NewTyCon {}  -> True
 571                                            _            -> False
 572 isNewTyCon other                        = False
 573
 574 -- This is an important refinement as typical newtype optimisations do *not*
 575 -- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
 576 -- family, there is no unique right hand side by which `T a' can be replaced
 577 -- by a cast.
 578 --
 579 isClosedNewTyCon :: TyCon -> Bool
 580 isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)
 581
 582 isProductTyCon :: TyCon -> Bool
 583 -- A "product" tycon
 584 --      has *one* constructor,
 585 --      is *not* existential
 586 -- but
 587 --      may be  DataType, NewType
 588 --      may be  unboxed or not,
 589 --      may be  recursive or not
 590 --
 591 isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
 592                                     DataTyCon{ data_cons = [data_con] }
 593                                                 -> isVanillaDataCon data_con
 594                                     NewTyCon {} -> True
 595                                     other       -> False
 596 isProductTyCon (TupleTyCon {})  = True
 597 isProductTyCon other            = False
 598
 599 isSynTyCon :: TyCon -> Bool
 600 isSynTyCon (SynTyCon {}) = True
 601 isSynTyCon _             = False
 602
 603 -- As for newtypes, it is in some contexts important to distinguish between
 604 -- closed synonyms and synonym families, as synonym families have no unique
 605 -- right hand side to which a synonym family application can expand.
 606 --
 607 isClosedSynTyCon :: TyCon -> Bool
 608 isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
 609
 610 isGadtSyntaxTyCon :: TyCon -> Bool
 611 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
 612 isGadtSyntaxTyCon other                                = False
 613
 614 isEnumerationTyCon :: TyCon -> Bool
 615 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
 616 isEnumerationTyCon other                                               = False
 617
 618 isOpenTyCon :: TyCon -> Bool
 619 isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _}) = True
 620 isOpenTyCon (AlgTyCon {algTcRhs = OpenDataTyCon }) = True
 621 isOpenTyCon (AlgTyCon {algTcRhs = OpenNewTyCon  }) = True
 622 isOpenTyCon _                                      = False
 623
 624 assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
 625 assocTyConArgPoss_maybe (AlgTyCon { tyConArgPoss = poss }) = poss
 626 assocTyConArgPoss_maybe (SynTyCon { tyConArgPoss = poss }) = poss
 627 assocTyConArgPoss_maybe _                                  = Nothing
 628
 629 isTyConAssoc :: TyCon -> Bool
 630 isTyConAssoc = isJust . assocTyConArgPoss_maybe
 631
 632 setTyConArgPoss :: TyCon -> [Int] -> TyCon
 633 setTyConArgPoss tc@(AlgTyCon {}) poss = tc { tyConArgPoss = Just poss }
 634 setTyConArgPoss tc@(SynTyCon {}) poss = tc { tyConArgPoss = Just poss }
 635 setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
 636
 637 isTupleTyCon :: TyCon -> Bool
 638 -- The unit tycon didn't used to be classed as a tuple tycon
 639 -- but I thought that was silly so I've undone it
 640 -- If it can't be for some reason, it should be a AlgTyCon
 641 --
 642 -- NB: when compiling Data.Tuple, the tycons won't reply True to
 643 -- isTupleTyCon, becuase they are built as AlgTyCons.  However they
 644 -- get spat into the interface file as tuple tycons, so I don't think
 645 -- it matters.
 646 isTupleTyCon (TupleTyCon {}) = True
 647 isTupleTyCon other           = False
 648
 649 isUnboxedTupleTyCon :: TyCon -> Bool
 650 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
 651 isUnboxedTupleTyCon other = False
 652
 653 isBoxedTupleTyCon :: TyCon -> Bool
 654 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 655 isBoxedTupleTyCon other = False
 656
 657 tupleTyConBoxity tc = tyConBoxed tc
 658
 659 isRecursiveTyCon :: TyCon -> Bool
 660 isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
 661 isRecursiveTyCon other                                = False
 662
 663 isHiBootTyCon :: TyCon -> Bool
 664 -- Used for knot-tying in hi-boot files
 665 isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
 666 isHiBootTyCon other                                 = False
 667
 668 isForeignTyCon :: TyCon -> Bool
 669 -- isForeignTyCon identifies foreign-imported type constructors
 670 isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
 671 isForeignTyCon other                               = False
 672
 673 isSuperKindTyCon :: TyCon -> Bool
 674 isSuperKindTyCon (SuperKindTyCon {}) = True
 675 isSuperKindTyCon other               = False
 676
 677 isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
 678 isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule})
 679   = Just (ar, rule)
 680 isCoercionTyCon_maybe other = Nothing
 681
 682 isCoercionTyCon :: TyCon -> Bool
 683 isCoercionTyCon (CoercionTyCon {}) = True
 684 isCoercionTyCon other              = False
 685
 686 -- Identifies implicit tycons that, in particular, do not go into interface
 687 -- files (because they are implicitly reconstructed when the interface is
 688 -- read).
 689 --
 690 -- Note that
 691 --
 692 -- * associated families are implicit, as they are re-constructed from
 693 --   the class declaration in which they reside, and
 694 -- * family instances are *not* implicit as they represent the instance body
 695 --   (similar to a dfun does that for a class instance).
 696 --
 697 isImplicitTyCon :: TyCon -> Bool
 698 isImplicitTyCon tycon | isTyConAssoc tycon           = True
 699                       | isSynTyCon tycon             = False
 700                       | isAlgTyCon tycon             = isClassTyCon tycon ||
 701                                                        isTupleTyCon tycon
 702 isImplicitTyCon _other                               = True
 703         -- catches: FunTyCon, PrimTyCon,
 704         -- CoercionTyCon, SuperKindTyCon
 705 \end{code}
 706
 707
 708 -----------------------------------------------
 709 --      Expand type-constructor applications
 710 -----------------------------------------------
 711
 712 \begin{code}
 713 tcExpandTyCon_maybe, coreExpandTyCon_maybe
 714         :: TyCon
 715         -> [Type]                       -- Args to tycon
 716         -> Maybe ([(TyVar,Type)],       -- Substitution
 717                   Type,                 -- Body type (not yet substituted)
 718                   [Type])               -- Leftover args
 719
 720 -- For the *typechecker* view, we expand synonyms only
 721 tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs,
 722                                synTcRhs = SynonymTyCon rhs }) tys
 723    = expand tvs rhs tys
 724 tcExpandTyCon_maybe other_tycon tys = Nothing
 725
 726 ---------------
 727 -- For the *Core* view, we expand synonyms only as well
 728
 729 coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,       -- Not recursive
 730          algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
 731    = case etad_rhs of   -- Don't do this in the pattern match, lest we accidentally
 732                         -- match the etad_rhs of a *recursive* newtype
 733         (tvs,rhs) -> expand tvs rhs tys
 734
 735 coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
 736
 737
 738 ----------------
 739 expand  :: [TyVar] -> Type                      -- Template
 740         -> [Type]                               -- Args
 741         -> Maybe ([(TyVar,Type)], Type, [Type]) -- Expansion
 742 expand tvs rhs tys
 743   = case n_tvs `compare` length tys of
 744         LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
 745         EQ -> Just (tvs `zip` tys, rhs, [])
 746         GT -> Nothing
 747    where
 748      n_tvs = length tvs
 749 \end{code}
 750
 751 \begin{code}
 752 tyConHasGenerics :: TyCon -> Bool
 753 tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
 754 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
 755 tyConHasGenerics other                           = False        -- Synonyms
 756
 757 tyConDataCons :: TyCon -> [DataCon]
 758 -- It's convenient for tyConDataCons to return the
 759 -- empty list for type synonyms etc
 760 tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
 761
 762 tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
 763 tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
 764 tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
 765 tyConDataCons_maybe (TupleTyCon {dataCon = con})                           = Just [con]
 766 tyConDataCons_maybe other                                                  = Nothing
 767
 768 tyConFamilySize  :: TyCon -> Int
 769 tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) =
 770   length cons
 771 tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
 772 tyConFamilySize (AlgTyCon   {algTcRhs = OpenDataTyCon})                = 0
 773 tyConFamilySize (TupleTyCon {})                                        = 1
 774 #ifdef DEBUG
 775 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 776 #endif
 777
 778 tyConSelIds :: TyCon -> [Id]
 779 tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
 780 tyConSelIds other_tycon                   = []
 781
 782 algTyConRhs :: TyCon -> AlgTyConRhs
 783 algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
 784 algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
 785 algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
 786 \end{code}
 787
 788 \begin{code}
 789 newTyConRhs :: TyCon -> ([TyVar], Type)
 790 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
 791 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
 792
 793 newTyConRep :: TyCon -> ([TyVar], Type)
 794 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
 795 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
 796
 797 newTyConCo_maybe :: TyCon -> Maybe TyCon
 798 newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
 799 newTyConCo_maybe _                                               = Nothing
 800
 801 tyConPrimRep :: TyCon -> PrimRep
 802 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
 803 tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
 804 \end{code}
 805
 806 \begin{code}
 807 tyConStupidTheta :: TyCon -> [PredType]
 808 tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
 809 tyConStupidTheta (TupleTyCon {})                        = []
 810 tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 811 \end{code}
 812
 813 \begin{code}
 814 synTyConDefn :: TyCon -> ([TyVar], Type)
 815 synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty})
 816   = (tyvars, ty)
 817 synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
 818
 819 synTyConRhs :: TyCon -> SynTyConRhs
 820 synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
 821 synTyConRhs tc                          = pprPanic "synTyConRhs" (ppr tc)
 822
 823 synTyConType :: TyCon -> Type
 824 synTyConType tc = case synTcRhs tc of
 825                     SynonymTyCon t -> t
 826                     _              -> pprPanic "synTyConType" (ppr tc)
 827
 828 synTyConResKind :: TyCon -> Kind
 829 synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind}) = kind
 830 synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
 831 \end{code}
 832
 833 \begin{code}
 834 maybeTyConSingleCon :: TyCon -> Maybe DataCon
 835 maybeTyConSingleCon (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
 836 maybeTyConSingleCon (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})    = Just c
 837 maybeTyConSingleCon (AlgTyCon {})                = Nothing
 838 maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
 839 maybeTyConSingleCon (PrimTyCon {})               = Nothing
 840 maybeTyConSingleCon (FunTyCon {})                = Nothing  -- case at funty
 841 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc
 842 \end{code}
 843
 844 \begin{code}
 845 isClassTyCon :: TyCon -> Bool
 846 isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
 847 isClassTyCon other_tycon                             = False
 848
 849 tyConClass_maybe :: TyCon -> Maybe Class
 850 tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
 851 tyConClass_maybe other_tycon                                = Nothing
 852
 853 isFamInstTyCon :: TyCon -> Bool
 854 isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
 855 isFamInstTyCon other_tycon                                   = False
 856
 857 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
 858 tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) =
 859   Just (fam, instTys)
 860 tyConFamInst_maybe other_tycon                                          =
 861   Nothing
 862
 863 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
 864 tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) =
 865   Just coe
 866 tyConFamilyCoercion_maybe other_tycon                                    =
 867   Nothing
 868 \end{code}
 869
 870
 871 %************************************************************************
 872 %*                                                                      *
 873 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
 874 %*                                                                      *
 875 %************************************************************************
 876
 877 @TyCon@s are compared by comparing their @Unique@s.
 878
 879 The strictness analyser needs @Ord@. It is a lexicographic order with
 880 the property @(a<=b) || (b<=a)@.
 881
 882 \begin{code}
 883 instance Eq TyCon where
 884     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 885     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 886
 887 instance Ord TyCon where
 888     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 889     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 890     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 891     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 892     compare a b = getUnique a `compare` getUnique b
 893
 894 instance Uniquable TyCon where
 895     getUnique tc = tyConUnique tc
 896
 897 instance Outputable TyCon where
 898     ppr tc  = ppr (getName tc)
 899
 900 instance NamedThing TyCon where
 901     getName = tyConName
 902 \end{code}