compiler/types/TyCon.lhs

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