compiler/types/TyCon.lhs

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