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