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