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