compiler/types/TyCon.lhs

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