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