compiler/types/TyCon.lhs

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