compiler/types/TyCon.lhs

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