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