TcTyClsDecls.hs 154 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The AQUA Project, Glasgow University, 1996-1998

5 6

TcTyClsDecls: Typecheck type and class declarations
Austin Seipp's avatar
Austin Seipp committed
7
-}
8

9
{-# LANGUAGE CPP, TupleSections, MultiWayIf #-}
10
{-# LANGUAGE TypeFamilies #-}
Ian Lynagh's avatar
Ian Lynagh committed
11

12
module TcTyClsDecls (
13
        tcTyAndClassDecls,
14

15 16
        -- Functions used by TcInstDcls to check
        -- data/type family instance declarations
17
        kcDataDefn, tcConDecls, dataDeclChecks, checkValidTyCon,
18
        tcFamTyPats, tcTyFamInstEqn,
19
        tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt,
20
        wrongKindOfFamily, dataConCtxt
21 22
    ) where

23
#include "HsVersions.h"
24

25 26
import GhcPrelude

27 28 29
import HsSyn
import HscTypes
import BuildTyCl
30
import TcRnMonad
31
import TcEnv
32
import TcValidity
33
import TcHsSyn
34 35
import TcTyDecls
import TcClassDcl
36
import {-# SOURCE #-} TcInstDcls( tcInstDecls1 )
37
import TcDeriv (DerivInfo)
38 39
import TcEvidence  ( tcCoercionKind, isEmptyTcEvBinds )
import TcUnify     ( checkConstraints )
40 41
import TcHsType
import TcMType
42
import TysWiredIn ( unitTy )
43
import TcType
44
import RnEnv( lookupConstructorFields )
45
import FamInst
Jan Stolarek's avatar
Jan Stolarek committed
46
import FamInstEnv
47
import Coercion
48
import Type
49
import TyCoRep   -- for checkValidRoles
dreixel's avatar
dreixel committed
50
import Kind
51
import Class
52
import CoAxiom
53 54
import TyCon
import DataCon
55
import Id
56
import Var
57
import VarEnv
58
import VarSet
59
import Module
60
import Name
61
import NameSet
62
import NameEnv
sof's avatar
sof committed
63
import Outputable
64 65 66
import Maybes
import Unify
import Util
67
import Pair
68 69 70
import SrcLoc
import ListSetOps
import DynFlags
71
import Unique
72
import ConLike( ConLike(..) )
73
import BasicTypes
74
import qualified GHC.LanguageExtensions as LangExt
75

Ian Lynagh's avatar
Ian Lynagh committed
76
import Control.Monad
77
import Data.List
78
import Data.List.NonEmpty ( NonEmpty(..) )
79

Austin Seipp's avatar
Austin Seipp committed
80 81 82
{-
************************************************************************
*                                                                      *
83
\subsection{Type checking for type and class declarations}
Austin Seipp's avatar
Austin Seipp committed
84 85
*                                                                      *
************************************************************************
86

dreixel's avatar
dreixel committed
87 88 89 90 91 92 93 94 95 96 97 98 99
Note [Grouping of type and class declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tcTyAndClassDecls is called on a list of `TyClGroup`s. Each group is a strongly
connected component of mutually dependent types and classes. We kind check and
type check each group separately to enhance kind polymorphism. Take the
following example:

  type Id a = a
  data X = X (Id Int)

If we were to kind check the two declarations together, we would give Id the
kind * -> *, since we apply it to an Int in the definition of X. But we can do
better than that, since Id really is kind polymorphic, and should get kind
100
forall (k::*). k -> k. Since it does not depend on anything else, it can be
dreixel's avatar
dreixel committed
101 102 103 104
kind-checked by itself, hence getting the most general kind. We then kind check
X, which works fine because we then know the polymorphic kind of Id, and simply
instantiate k to *.

105 106 107 108 109 110 111 112 113
Note [Check role annotations in a second pass]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Role inference potentially depends on the types of all of the datacons declared
in a mutually recursive group. The validity of a role annotation, in turn,
depends on the result of role inference. Because the types of datacons might
be ill-formed (see #7175 and Note [Checking GADT return types]) we must check
*all* the tycons in a group for validity before checking *any* of the roles.
Thus, we take two passes over the resulting tycons, first checking for general
validity and then checking for valid role annotations.
Austin Seipp's avatar
Austin Seipp committed
114
-}
115

116
tcTyAndClassDecls :: [TyClGroup GhcRn]      -- Mutually-recursive groups in
117 118 119 120
                                            -- dependency order
                  -> TcM ( TcGblEnv         -- Input env extended by types and
                                            -- classes
                                            -- and their implicit Ids,DataCons
121
                         , [InstInfo GhcRn] -- Source-code instance decls info
122 123
                         , [DerivInfo]      -- data family deriving info
                         )
124
-- Fails if there are any errors
Simon Peyton Jones's avatar
Simon Peyton Jones committed
125
tcTyAndClassDecls tyclds_s
126 127 128 129
  -- The code recovers internally, but if anything gave rise to
  -- an error we'd better stop now, to avoid a cascade
  -- Type check each group in dependency order folding the global env
  = checkNoErrs $ fold_env [] [] tyclds_s
dreixel's avatar
dreixel committed
130
  where
131
    fold_env :: [InstInfo GhcRn]
132
             -> [DerivInfo]
133 134
             -> [TyClGroup GhcRn]
             -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo])
135 136 137 138 139 140 141 142 143 144 145
    fold_env inst_info deriv_info []
      = do { gbl_env <- getGblEnv
           ; return (gbl_env, inst_info, deriv_info) }
    fold_env inst_info deriv_info (tyclds:tyclds_s)
      = do { (tcg_env, inst_info', deriv_info') <- tcTyClGroup tyclds
           ; setGblEnv tcg_env $
               -- remaining groups are typechecked in the extended global env.
             fold_env (inst_info' ++ inst_info)
                      (deriv_info' ++ deriv_info)
                      tyclds_s }

146 147
tcTyClGroup :: TyClGroup GhcRn
            -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo])
148
-- Typecheck one strongly-connected component of type, class, and instance decls
Simon Peyton Jones's avatar
Simon Peyton Jones committed
149
-- See Note [TyClGroups and dependency analysis] in HsDecls
150 151 152 153 154 155
tcTyClGroup (TyClGroup { group_tyclds = tyclds
                       , group_roles  = roles
                       , group_instds = instds })
  = do { let role_annots = mkRoleAnnotEnv roles

           -- Step 1: Typecheck the type/class declarations
Simon Peyton Jones's avatar
Simon Peyton Jones committed
156
       ; traceTc "---- tcTyClGroup ---- {" empty
157
       ; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds))
158 159
       ; tyclss <- tcTyClDecls tyclds role_annots

160 161 162 163 164 165
           -- Step 1.5: Make sure we don't have any type synonym cycles
       ; traceTc "Starting synonym cycle check" (ppr tyclss)
       ; this_uid <- fmap thisPackage getDynFlags
       ; checkSynCycles this_uid tyclss tyclds
       ; traceTc "Done synonym cycle check" (ppr tyclss)

166 167 168 169 170
           -- Step 2: Perform the validity check on those types/classes
           -- We can do this now because we are done with the recursive knot
           -- Do it before Step 3 (adding implicit things) because the latter
           -- expects well-formed TyCons
       ; traceTc "Starting validity check" (ppr tyclss)
171
       ; tyclss <- concatMapM checkValidTyCl tyclss
172 173 174 175
       ; traceTc "Done validity check" (ppr tyclss)
       ; mapM_ (recoverM (return ()) . checkValidRoleAnnots role_annots) tyclss
           -- See Note [Check role annotations in a second pass]

Simon Peyton Jones's avatar
Simon Peyton Jones committed
176 177
       ; traceTc "---- end tcTyClGroup ---- }" empty

178 179 180
           -- Step 3: Add the implicit things;
           -- we want them in the environment because
           -- they may be mentioned in interface files
181 182 183
       ; gbl_env <- addTyConsToGblEnv tyclss

           -- Step 4: check instance declarations
184
       ; setGblEnv gbl_env $
185
         tcInstDecls1 instds }
186

187
tcTyClGroup (XTyClGroup _) = panic "tcTyClGroup"
188

189
tcTyClDecls :: [LTyClDecl GhcRn] -> RoleAnnotEnv -> TcM [TyCon]
190
tcTyClDecls tyclds role_annots
191 192
  = tcExtendKindEnv promotion_err_env $   --- See Note [Type environment evolution]
    do {    -- Step 1: kind-check this group and returns the final
dreixel's avatar
dreixel committed
193 194
            -- (possibly-polymorphic) kind of each TyCon and Class
            -- See Note [Kind checking for type and class decls]
195 196
         tc_tycons <- kcTyClGroup tyclds
       ; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons))
dreixel's avatar
dreixel committed
197

198 199
            -- Step 2: type-check all groups together, returning
            -- the final TyCons and Classes
200 201 202 203
            --
            -- NB: We have to be careful here to NOT eagerly unfold
            -- type synonyms, as we have not tested for type synonym
            -- loops yet and could fall into a black hole.
204
       ; fixM $ \ ~rec_tyclss -> do
205 206
           { tcg_env <- getGblEnv
           ; let roles = inferRoles (tcg_src tcg_env) role_annots rec_tyclss
dreixel's avatar
dreixel committed
207 208 209

                 -- Populate environment with knot-tied ATyCon for TyCons
                 -- NB: if the decls mention any ill-staged data cons
210
                 -- (see Note [Recursion and promoting data constructors])
211
                 -- we will have failed already in kcTyClGroup, so no worries here
212
           ; tcExtendRecEnv (zipRecTyClss tc_tycons rec_tyclss) $
dreixel's avatar
dreixel committed
213 214 215

                 -- Also extend the local type envt with bindings giving
                 -- the (polymorphic) kind of each knot-tied TyCon or Class
216
                 -- See Note [Type checking recursive type and class declarations]
217 218
                 -- and Note [Type environment evolution]
             tcExtendKindEnvWithTyCons tc_tycons $
dreixel's avatar
dreixel committed
219 220

                 -- Kind and type check declarations for this group
Edward Z. Yang's avatar
Edward Z. Yang committed
221
               mapM (tcTyClDecl roles) tyclds
222
           } }
223
  where
224
    promotion_err_env = mkPromotionErrorEnv tyclds
225 226 227
    ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma
                                  , ppr (tyConBinders tc) <> comma
                                  , ppr (tyConResKind tc) ])
dreixel's avatar
dreixel committed
228

229
zipRecTyClss :: [TcTyCon]
230
             -> [TyCon]           -- Knot-tied
231
             -> [(Name,TyThing)]
232 233
-- Build a name-TyThing mapping for the TyCons bound by decls
-- being careful not to look at the knot-tied [TyThing]
batterseapower's avatar
batterseapower committed
234
-- The TyThings in the result list must have a visible ATyCon,
235 236
-- because typechecking types (in, say, tcTyClDecl) looks at
-- this outer constructor
237 238
zipRecTyClss tc_tycons rec_tycons
  = [ (name, ATyCon (get name)) | tc_tycon <- tc_tycons, let name = getName tc_tycon ]
239
  where
240 241
    rec_tc_env :: NameEnv TyCon
    rec_tc_env = foldr add_tc emptyNameEnv rec_tycons
242

243 244 245 246 247 248 249 250 251
    add_tc :: TyCon -> NameEnv TyCon -> NameEnv TyCon
    add_tc tc env = foldr add_one_tc env (tc : tyConATs tc)

    add_one_tc :: TyCon -> NameEnv TyCon -> NameEnv TyCon
    add_one_tc tc env = extendNameEnv env (tyConName tc) tc

    get name = case lookupNameEnv rec_tc_env name of
                 Just tc -> tc
                 other   -> pprPanic "zipRecTyClss" (ppr name <+> ppr other)
252

Austin Seipp's avatar
Austin Seipp committed
253 254 255
{-
************************************************************************
*                                                                      *
256
                Kind checking
Austin Seipp's avatar
Austin Seipp committed
257 258
*                                                                      *
************************************************************************
259

260 261 262 263
Note [Kind checking for type and class decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Kind checking is done thus:

264 265
   1. Make up a kind variable for each parameter of the declarations,
      and extend the kind environment (which is in the TcLclEnv)
266

267
   2. Kind check the declarations
268

269 270
We need to kind check all types in the mutually recursive group
before we know the kind of the type variables.  For example:
271

272 273
  class C a where
     op :: D b => a -> b -> b
274

275 276
  class D c where
     bop :: (Monad c) => ...
277 278 279 280 281

Here, the kind of the locally-polymorphic type variable "b"
depends on *all the uses of class D*.  For example, the use of
Monad c in bop's type signature means that D must have kind Type->Type.

282 283 284 285 286 287
Note: we don't treat type synonyms specially (we used to, in the past);
in particular, even if we have a type synonym cycle, we still kind check
it normally, and test for cycles later (checkSynCycles).  The reason
we can get away with this is because we have more systematic TYPE r
inference, which means that we can do unification between kinds that
aren't lifted (this historically was not true.)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
288

289 290 291 292 293
The downside of not directly reading off the kinds off the RHS of
type synonyms in topological order is that we don't transparently
support making synonyms of types with higher-rank kinds.  But
you can always specify a CUSK directly to make this work out.
See tc269 for an example.
294

295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
Note [Skip decls with CUSKs in kcLTyClDecl]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider

    data T (a :: *) = MkT (S a)   -- Has CUSK
    data S a = MkS (T Int) (S a)  -- No CUSK

Via getInitialKinds we get
  T :: * -> *
  S :: kappa -> *

Then we call kcTyClDecl on each decl in the group, to constrain the
kind unification variables.  BUT we /skip/ the RHS of any decl with
a CUSK.  Here we skip the RHS of T, so we eventually get
  S :: forall k. k -> *

This gets us more polymorphism than we would otherwise get, similar
(but implemented strangely differently from) the treatment of type
signatures in value declarations.

315 316
Open type families
~~~~~~~~~~~~~~~~~~
317 318 319
This treatment of type synonyms only applies to Haskell 98-style synonyms.
General type functions can be recursive, and hence, appear in `alg_decls'.

320
The kind of an open type family is solely determinded by its kind signature;
321
hence, only kind signatures participate in the construction of the initial
322 323 324 325
kind environment (as constructed by `getInitialKind'). In fact, we ignore
instances of families altogether in the following. However, we need to include
the kinds of *associated* families into the construction of the initial kind
environment. (This is handled by `allDecls').
326 327 328

See also Note [Kind checking recursive type and class declarations]

329
Note [How TcTyCons work]
330
~~~~~~~~~~~~~~~~~~~~~~~~
331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374
TcTyCons are used for two distinct purposes

1.  When recovering from a type error in a type declaration,
    we want to put the erroneous TyCon in the environment in a
    way that won't lead to more errors.  We use a TcTyCon for this;
    see makeRecoveryTyCon.

2.  When checking a type/class declaration (in module TcTyClsDecls), we come
    upon knowledge of the eventual tycon in bits and pieces.

      S1) First, we use getInitialKinds to look over the user-provided
          kind signature of a tycon (including, for example, the number
          of parameters written to the tycon) to get an initial shape of
          the tycon's kind.  We record that shape in a TcTyCon.

      S2) Then, using these initial kinds, we kind-check the body of the
          tycon (class methods, data constructors, etc.), filling in the
          metavariables in the tycon's initial kind.

      S3) We then generalize to get the tycon's final, fixed
          kind. Finally, once this has happened for all tycons in a
          mutually recursive group, we can desugar the lot.

    For convenience, we store partially-known tycons in TcTyCons, which
    might store meta-variables. These TcTyCons are stored in the local
    environment in TcTyClsDecls, until the real full TyCons can be created
    during desugaring. A desugared program should never have a TcTyCon.

    A challenging piece in all of this is that we end up taking three separate
    passes over every declaration:
      - one in getInitialKind (this pass look only at the head, not the body)
      - one in kcTyClDecls (to kind-check the body)
      - a final one in tcTyClDecls (to desugar)
    In the latter two passes, we need to connect the user-written type
    variables in an LHsQTyVars with the variables in the tycon's
    inferred kind. Because the tycon might not have a CUSK, this
    matching up is, in general, quite hard to do.  (Look through the
    git history between Dec 2015 and Apr 2016 for
    TcHsType.splitTelescopeTvs!) Instead of trying, we just store the
    list of type variables to bring into scope, in the
    tyConScopedTyVars field of the TcTyCon.  These tyvars are brought
    into scope in kcTyClTyVars and tcTyClTyVars, both in TcHsType.

    In a TcTyCon, everything is zonked after the kind-checking pass (S2).
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405

Note [Check telescope again during generalisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The telescope check before kind generalisation is useful to catch something
like this:

  data T a k = MkT (Proxy (a :: k))

Clearly, the k has to come first. Checking for this problem must come before
kind generalisation, as described in Note [Bad telescopes] in
TcValidity.

However, we have to check again *after* kind generalisation, to catch something
like this:

  data SameKind :: k -> k -> Type  -- to force unification
  data S a (b :: a) (d :: SameKind c b)

Note that c has no explicit binding site. As such, it's quantified by kind
generalisation. (Note that kcHsTyVarBndrs does not return such variables
as binders in its returned TcTyCon.) The user-written part of this telescope
is well-ordered; no earlier variables depend on later ones. However, after
kind generalisation, we put c up front, like so:

  data S {c :: a} a (b :: a) (d :: SameKind c b)

We now have a problem. We could detect this problem just by looking at the
free vars of the kinds of the generalised variables (the kvs), but we get
such a nice error message out of checkValidTelescope that it seems like the
right thing to do.

406 407 408 409 410
Note [Type environment evolution]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As we typecheck a group of declarations the type environment evolves.
Consider for example:
  data B (a :: Type) = MkB (Proxy 'MkB)
411

412 413 414 415 416 417 418 419 420 421 422 423
We do the following steps:

  1. Start of tcTyClDecls: use mkPromotionErrorEnv to initialise the
     type env with promotion errors
            B   :-> TyConPE
            MkB :-> DataConPE

  2. kcTyCLGruup
      - Do getInitialKinds, which will signal a promotion
        error if B is used in any of the kinds needed to initialse
        B's kind (e.g. (a :: Type)) here

424
      - Extend the type env with these initial kinds (monomorphic for
425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462
        decls that lack a CUSK)
            B :-> TcTyCon <initial kind>
        (thereby overriding the B :-> TyConPE binding)
        and do kcLTyClDecl on each decl to get equality constraints on
        all those inital kinds

      - Generalise the inital kind, making a poly-kinded TcTyCon

  3. Back in tcTyDecls, extend the envt with bindings of the poly-kinded
     TcTyCons, again overriding the promotion-error bindings.

     But note that the data constructor promotion errors are still in place
     so that (in our example) a use of MkB will sitll be signalled as
     an error.

  4. Typecheck the decls.

  5. In tcTyClGroup, extend the envt with bindings for TyCon and DataCons


Note [Missed opportunity to retain higher-rank kinds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In 'kcTyClGroup', there is a missed opportunity to make kind
inference work in a few more cases.  The idea is analogous
to Note [Single function non-recursive binding special-case]:

     * If we have an SCC with a single decl, which is non-recursive,
       instead of creating a unification variable representing the
       kind of the decl and unifying it with the rhs, we can just
       read the type directly of the rhs.

     * Furthermore, we can update our SCC analysis to ignore
       dependencies on declarations which have CUSKs: we don't
       have to kind-check these all at once, since we can use
       the CUSK to initialize the kind environment.

Unfortunately this requires reworking a bit of the code in
'kcLTyClDecl' so I've decided to punt unless someone shouts about it.
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485

Note [Don't process associated types in kcLHsQTyVars]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Previously, we processed associated types in the thing_inside in kcLHsQTyVars,
but this was wrong -- we want to do ATs sepearately.
The consequence for not doing it this way is #15142:

  class ListTuple (tuple :: Type) (as :: [(k, Type)]) where
    type ListToTuple as :: Type

We assign k a kind kappa[1]. When checking the tuple (k, Type), we try to unify
kappa ~ Type, but this gets deferred because we bumped the TcLevel as we bring
`tuple` into scope. Thus, when we check ListToTuple, kappa[1] still hasn't
unified with Type. And then, when we generalize the kind of ListToTuple (which
indeed has a CUSK, according to the rules), we skolemize the free metavariable
kappa. Note that we wouldn't skolemize kappa when generalizing the kind of ListTuple,
because the solveEqualities in kcLHsQTyVars is at TcLevel 1 and so kappa[1]
will unify with Type.

Bottom line: as associated types should have no effect on a CUSK enclosing class,
we move processing them to a separate action, run after the outer kind has
been generalized.

486
-}
487

488
kcTyClGroup :: [LTyClDecl GhcRn] -> TcM [TcTyCon]
489

dreixel's avatar
dreixel committed
490
-- Kind check this group, kind generalize, and return the resulting local env
491
-- This binds the TyCons and Classes of the group, but not the DataCons
dreixel's avatar
dreixel committed
492
-- See Note [Kind checking for type and class decls]
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
493 494
-- Third return value is Nothing if the tycon be unsaturated; otherwise,
-- the arity
495
kcTyClGroup decls
496
  = do  { mod <- getModule
Simon Peyton Jones's avatar
Simon Peyton Jones committed
497
        ; traceTc "---- kcTyClGroup ---- {" (text "module" <+> ppr mod $$ vcat (map ppr decls))
dreixel's avatar
dreixel committed
498

499
          -- Kind checking;
500 501 502
          --    1. Bind kind variables for decls
          --    2. Kind-check decls
          --    3. Generalise the inferred kinds
dreixel's avatar
dreixel committed
503 504
          -- See Note [Kind checking for type and class decls]

505 506 507 508 509 510 511 512 513
          -- Step 1: Bind kind variables for all decls
        ; initial_tcs <- getInitialKinds decls
        ; traceTc "kcTyClGroup: initial kinds" $
          ppr_tc_kinds initial_tcs

         -- Step 2: Set extended envt, kind-check the decls
         -- NB: the environment extension overrides the tycon
         --     promotion-errors bindings
         --     See Note [Type environment evolution]
514

515 516 517
        ; solveEqualities $
          tcExtendKindEnvWithTyCons initial_tcs $
          mapM_ kcLTyClDecl decls
518 519 520 521

        -- Step 3: generalisation
        -- Kind checking done for this group
        -- Now we have to kind generalize the flexis
522
        ; poly_tcs <- mapAndReportM generalise initial_tcs
523

524 525
        ; traceTc "---- kcTyClGroup end ---- }" (ppr_tc_kinds poly_tcs)
        ; return poly_tcs }
526

527
  where
528 529 530 531
    ppr_tc_kinds tcs = vcat (map pp_tc tcs)
    pp_tc tc = ppr (tyConName tc) <+> dcolon <+> ppr (tyConKind tc)

    generalise :: TcTyCon -> TcM TcTyCon
532
    -- For polymorphic things this is a no-op
533
    generalise tc
534 535
      = setSrcSpan (getSrcSpan tc) $
        addTyConCtxt tc $
536 537
        do { let name = tyConName tc
           ; tc_binders  <- mapM zonkTcTyVarBinder (tyConBinders tc)
538 539 540 541 542 543 544 545 546
           ; tc_res_kind <- zonkTcType (tyConResKind tc)
           ; let scoped_tvs  = tcTyConScopedTyVars tc
                 user_tyvars = tcTyConUserTyVars tc

              -- See Note [checkValidDependency]
           ; checkValidDependency tc_binders tc_res_kind

               -- See Note [Bad telescopes] in TcValidity
           ; checkValidTelescope tc_binders user_tyvars empty
547 548 549
           ; kvs <- kindGeneralize (mkTyConKind tc_binders tc_res_kind)

           ; let all_binders = mkNamedTyConBinders Inferred kvs ++ tc_binders
550

Simon Peyton Jones's avatar
Simon Peyton Jones committed
551
           ; (env, all_binders') <- zonkTyVarBindersX emptyZonkEnv all_binders
552 553
           ; tc_res_kind'        <- zonkTcTypeToType env tc_res_kind
           ; scoped_tvs'         <- zonkSigTyVarPairs scoped_tvs
554

555 556 557 558
             -- See Note [Check telescope again during generalisation]
           ; let extra = text "NB: Implicitly declared variables come before others."
           ; checkValidTelescope all_binders user_tyvars extra

559
                      -- Make sure tc_kind' has the final, zonked kind variables
560
           ; traceTc "Generalise kind" $
561 562 563
             vcat [ ppr name, ppr tc_binders, ppr (mkTyConKind tc_binders tc_res_kind)
                  , ppr kvs, ppr all_binders, ppr tc_res_kind
                  , ppr all_binders', ppr tc_res_kind'
564
                  , ppr scoped_tvs ]
565

566
           ; return (mkTcTyCon name user_tyvars all_binders' tc_res_kind'
567
                               scoped_tvs'
568
                               (tyConFlavour tc)) }
dreixel's avatar
dreixel committed
569

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
570

571
--------------
572 573 574
tcExtendKindEnvWithTyCons :: [TcTyCon] -> TcM a -> TcM a
tcExtendKindEnvWithTyCons tcs
  = tcExtendKindEnvList [ (tyConName tc, ATcTyCon tc) | tc <- tcs ]
575 576

--------------
577
mkPromotionErrorEnv :: [LTyClDecl GhcRn] -> TcTypeEnv
578 579 580
-- Maps each tycon/datacon to a suitable promotion error
--    tc :-> APromotionErr TyConPE
--    dc :-> APromotionErr RecDataConPE
581
--    See Note [Recursion and promoting data constructors]
582 583 584 585 586

mkPromotionErrorEnv decls
  = foldr (plusNameEnv . mk_prom_err_env . unLoc)
          emptyNameEnv decls

587
mk_prom_err_env :: TyClDecl GhcRn -> TcTypeEnv
588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605
mk_prom_err_env (ClassDecl { tcdLName = L _ nm, tcdATs = ats })
  = unitNameEnv nm (APromotionErr ClassPE)
    `plusNameEnv`
    mkNameEnv [ (name, APromotionErr TyConPE)
              | L _ (FamilyDecl { fdLName = L _ name }) <- ats ]

mk_prom_err_env (DataDecl { tcdLName = L _ name
                          , tcdDataDefn = HsDataDefn { dd_cons = cons } })
  = unitNameEnv name (APromotionErr TyConPE)
    `plusNameEnv`
    mkNameEnv [ (con, APromotionErr RecDataConPE)
              | L _ con' <- cons, L _ con <- getConNames con' ]

mk_prom_err_env decl
  = unitNameEnv (tcdName decl) (APromotionErr TyConPE)
    -- Works for family declarations too

--------------
606 607 608
getInitialKinds :: [LTyClDecl GhcRn] -> TcM [TcTyCon]
-- Returns a TcTyCon for each TyCon bound by the decls,
-- each with its initial kind
609

610
getInitialKinds decls = concatMapM (addLocM getInitialKind) decls
611

612
getInitialKind :: TyClDecl GhcRn -> TcM [TcTyCon]
dreixel's avatar
dreixel committed
613
-- Allocate a fresh kind variable for each TyCon and Class
614
-- For each tycon, return a TcTyCon with kind k
615
-- where k is the kind of tc, derived from the LHS
616 617
--         of the definition (and probably including
--         kind unification variables)
dreixel's avatar
dreixel committed
618
--      Example: data T a b = ...
619
--      return (T, kv1 -> kv2 -> kv3)
dreixel's avatar
dreixel committed
620
--
621 622 623 624
-- This pass deals with (ie incorporates into the kind it produces)
--   * The kind signatures on type-variable binders
--   * The result kinds signature on a TyClDecl
--
625
-- No family instances are passed to getInitialKinds
dreixel's avatar
dreixel committed
626

627
getInitialKind decl@(ClassDecl { tcdLName = L _ name, tcdTyVars = ktvs, tcdATs = ats })
628
  = do { let cusk = hsDeclHasCusk decl
629 630 631 632 633
       ; tycon <- kcLHsQTyVars name ClassFlavour cusk ktvs $
                  return constraintKind
            -- See Note [Don't process associated types in kcLHsQTyVars]
       ; inner_tcs <- tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $
                      getFamDeclInitialKinds (Just cusk) ats
634
       ; return (tycon : inner_tcs) }
635

636
getInitialKind decl@(DataDecl { tcdLName = L _ name
637
                              , tcdTyVars = ktvs
638 639
                              , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig
                                                         , dd_ND = new_or_data } })
640
  = do  { tycon <-
641
           kcLHsQTyVars name (newOrDataToFlavour new_or_data) (hsDeclHasCusk decl) ktvs $
642 643 644
           case m_sig of
             Just ksig -> tcLHsKindSig (DataKindCtxt name) ksig
             Nothing   -> return liftedTypeKind
645
        ; return [tycon] }
646

Jan Stolarek's avatar
Jan Stolarek committed
647
getInitialKind (FamDecl { tcdFam = decl })
648 649
  = do { tc <- getFamDeclInitialKind Nothing decl
       ; return [tc] }
650

651 652 653
getInitialKind decl@(SynDecl { tcdLName = L _ name
                             , tcdTyVars = ktvs
                             , tcdRhs = rhs })
654 655 656 657
  = do  { tycon <- kcLHsQTyVars name TypeSynonymFlavour (hsDeclHasCusk decl) ktvs $
            case kind_annotation rhs of
              Nothing -> newMetaKindVar
              Just ksig -> tcLHsKindSig (TySynKindCtxt name) ksig
658
        ; return [tycon] }
659 660 661
  where
    -- Keep this synchronized with 'hsDeclHasCusk'.
    kind_annotation (L _ ty) = case ty of
662 663 664
        HsParTy _ lty     -> kind_annotation lty
        HsKindSig _ _ k   -> Just k
        _                 -> Nothing
665

666 667 668
getInitialKind (DataDecl _ (L _ _) _ _ (XHsDataDefn _)) = panic "getInitialKind"
getInitialKind (XTyClDecl _) = panic "getInitialKind"

669
---------------------------------
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
670
getFamDeclInitialKinds :: Maybe Bool  -- if assoc., CUSKness of assoc. class
671
                       -> [LFamilyDecl GhcRn]
672
                       -> TcM [TcTyCon]
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
673
getFamDeclInitialKinds mb_cusk decls
674
  = mapM (addLocM (getFamDeclInitialKind mb_cusk)) decls
675

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
676
getFamDeclInitialKind :: Maybe Bool  -- if assoc., CUSKness of assoc. class
677
                      -> FamilyDecl GhcRn
678
                      -> TcM TcTyCon
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
679 680 681 682
getFamDeclInitialKind mb_cusk decl@(FamilyDecl { fdLName     = L _ name
                                               , fdTyVars    = ktvs
                                               , fdResultSig = L _ resultSig
                                               , fdInfo      = info })
683 684 685 686 687 688 689 690 691
  = do { tycon <- kcLHsQTyVars name flav cusk ktvs $
           case resultSig of
             KindSig _ ki                          -> tcLHsKindSig ctxt ki
             TyVarSig _ (L _ (KindedTyVar _ _ ki)) -> tcLHsKindSig ctxt ki
             _ -- open type families have * return kind by default
               | tcFlavourIsOpen flav     -> return liftedTypeKind
               -- closed type families have their return kind inferred
               -- by default
               | otherwise                -> newMetaKindVar
692
       ; return tycon }
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
693
  where
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
694
    cusk  = famDeclHasCusk mb_cusk decl
695
    flav  = case info of
696 697
      DataFamily         -> DataFamilyFlavour (isJust mb_cusk)
      OpenTypeFamily     -> OpenTypeFamilyFlavour (isJust mb_cusk)
698
      ClosedTypeFamily _ -> ClosedTypeFamilyFlavour
699
    ctxt  = TyFamResKindCtxt name
700
getFamDeclInitialKind _ (XFamilyDecl _) = panic "getFamDeclInitialKind"
701

702
------------------------------------------------------------------------
703
kcLTyClDecl :: LTyClDecl GhcRn -> TcM ()
704
  -- See Note [Kind checking for type and class decls]
705
kcLTyClDecl (L loc decl)
706
  | hsDeclHasCusk decl  -- See Note [Skip decls with CUSKs in kcLTyClDecl]
707
  = traceTc "kcTyClDecl skipped due to cusk" (ppr tc_name)
708

709
  | otherwise
Simon Peyton Jones's avatar
Simon Peyton Jones committed
710 711
  = setSrcSpan loc $
    tcAddDeclCtxt decl $
712
    do { traceTc "kcTyClDecl {" (ppr tc_name)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
713
       ; kcTyClDecl decl
714 715 716
       ; traceTc "kcTyClDecl done }" (ppr tc_name) }
  where
    tc_name = tyClDeclLName decl
717

718
kcTyClDecl :: TyClDecl GhcRn -> TcM ()
dreixel's avatar
dreixel committed
719
-- This function is used solely for its side effect on kind variables
720
-- NB kind signatures on the type variables and
Gabor Greif's avatar
Gabor Greif committed
721
--    result kind signature have already been dealt with
722
--    by getInitialKind, so we can ignore them here.
dreixel's avatar
dreixel committed
723

724
kcTyClDecl (DataDecl { tcdLName = L _ name, tcdDataDefn = defn })
725
  | HsDataDefn { dd_cons = cons@(L _ (ConDeclGADT {}) : _), dd_ctxt = L _ [] } <- defn
726
  = mapM_ (wrapLocM kcConDecl) cons
727
    -- hs_tvs and dd_kindSig already dealt with in getInitialKind
728
    -- This must be a GADT-style decl,
729 730 731 732
    --        (see invariants of DataDefn declaration)
    -- so (a) we don't need to bring the hs_tvs into scope, because the
    --        ConDecls bind all their own variables
    --    (b) dd_ctxt is not allowed for GADT-style decls, so we can ignore it
733

734
  | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } <- defn
735
  = kcTyClTyVars name $
736
    do  { _ <- tcHsContext ctxt
737
        ; mapM_ (wrapLocM kcConDecl) cons }
738

739 740 741 742 743 744
kcTyClDecl (SynDecl { tcdLName = L _ name, tcdRhs = lrhs })
  = kcTyClTyVars name $
    do  { syn_tc <- kcLookupTcTyCon name
        -- NB: check against the result kind that we allocated
        -- in getInitialKinds.
        ; discardResult $ tcCheckLHsType lrhs (tyConResKind syn_tc) }
745

746 747 748
kcTyClDecl (ClassDecl { tcdLName = L _ name
                      , tcdCtxt = ctxt, tcdSigs = sigs })
  = kcTyClTyVars name $
749
    do  { _ <- tcHsContext ctxt
750
        ; mapM_ (wrapLocM kc_sig)     sigs }
dreixel's avatar
dreixel committed
751
  where
752 753 754
    kc_sig (ClassOpSig _ _ nms op_ty)
             = kcHsSigType (TyConSkol ClassFlavour name) nms op_ty
    kc_sig _ = return ()
755

756 757
kcTyClDecl (FamDecl _ (FamilyDecl { fdLName  = L _ fam_tc_name
                                  , fdInfo   = fd_info }))
758 759 760 761
-- closed type families look at their equations, but other families don't
-- do anything here
  = case fd_info of
      ClosedTypeFamily (Just eqns) ->
762
        do { fam_tc <- kcLookupTcTyCon fam_tc_name
763
           ; mapM_ (kcTyFamInstEqn fam_tc) eqns }
764
      _ -> return ()
765 766 767
kcTyClDecl (FamDecl _ (XFamilyDecl _))              = panic "kcTyClDecl"
kcTyClDecl (DataDecl _ (L _ _) _ _ (XHsDataDefn _)) = panic "kcTyClDecl"
kcTyClDecl (XTyClDecl _)                            = panic "kcTyClDecl"
dreixel's avatar
dreixel committed
768 769

-------------------
770
kcConDecl :: ConDecl GhcRn -> TcM ()
771 772
kcConDecl (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
                      , con_mb_cxt = ex_ctxt, con_args = args })
Alan Zimmerman's avatar
Alan Zimmerman committed
773
  = addErrCtxt (dataConCtxtName [name]) $
774 775 776 777 778 779
      -- See Note [Use SigTvs in kind-checking pass]
    kcExplicitTKBndrs ex_tvs $
    do { _ <- tcHsMbContext ex_ctxt
       ; mapM_ (tcHsOpenType . getBangType) (hsConDeclArgTys args) }
              -- We don't need to check the telescope here, because that's
              -- done in tcConDecl
780

Alan Zimmerman's avatar
Alan Zimmerman committed
781
kcConDecl (ConDeclGADT { con_names = names
782 783
                       , con_qvars = qtvs, con_mb_cxt = cxt
                       , con_args = args, con_res_ty = res_ty })
784
  | HsQTvs { hsq_ext = HsQTvsRn { hsq_implicit = implicit_tkv_nms }
785 786 787 788 789 790 791 792 793
           , hsq_explicit = explicit_tkv_nms } <- qtvs
  = -- Even though the data constructor's type is closed, we
    -- must still kind-check the type, because that may influence
    -- the inferred kind of the /type/ constructor.  Example:
    --    data T f a where
    --      MkT :: f a -> T f a
    -- If we don't look at MkT we won't get the correct kind
    -- for the type constructor T
    addErrCtxt (dataConCtxtName names) $
794
    discardResult $
795
    kcImplicitTKBndrs implicit_tkv_nms $
796 797 798 799 800
    kcExplicitTKBndrs explicit_tkv_nms $
    do { _ <- tcHsMbContext cxt
       ; mapM_ (tcHsOpenType . getBangType) (hsConDeclArgTys args)
       ; _ <- tcHsOpenType res_ty
       ; return () }
801 802
kcConDecl (XConDecl _) = panic "kcConDecl"
kcConDecl (ConDeclGADT _ _ _ (XLHsQTyVars _) _ _ _ _) = panic "kcConDecl"
Alan Zimmerman's avatar
Alan Zimmerman committed
803

Austin Seipp's avatar
Austin Seipp committed
804
{-
805 806
Note [Recursion and promoting data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
807 808 809 810 811 812 813 814
We don't want to allow promotion in a strongly connected component
when kind checking.

Consider:
  data T f = K (f (K Any))

When kind checking the `data T' declaration the local env contains the
mappings:
815 816
  T -> ATcTyCon <some initial kind>
  K -> APromotionErr
817

818
APromotionErr is only used for DataCons, and only used during type checking
819 820
in tcTyClGroup.

821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868
Note [Use SigTvs in kind-checking pass]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider

  data Proxy a where
    MkProxy1 :: forall k (b :: k). Proxy b
    MkProxy2 :: forall j (c :: j). Proxy c

It seems reasonable that this should be accepted. But something very strange
is going on here: when we're kind-checking this declaration, we need to unify
the kind of `a` with k and j -- even though k and j's scopes are local to the type of
MkProxy{1,2}. The best approach we've come up with is to use SigTvs during
the kind-checking pass. First off, note that it's OK if the kind-checking pass
is too permissive: we'll snag the problems in the type-checking pass later.
(This extra permissiveness might happen with something like

  data SameKind :: k -> k -> Type
  data Bad a where
    MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b)

which would be accepted if k1 and k2 were SigTvs. This is correctly rejected
in the second pass, though. Test case: polykinds/SigTvKinds3)
Recall that the kind-checking pass exists solely to collect constraints
on the kinds and to power unification.

To achieve the use of SigTvs, we must be careful to use specialized functions
that produce SigTvs, not ordinary skolems. This is why we need
kcExplicitTKBndrs and kcImplicitTKBndrs in TcHsType, separate from their
tc... variants.

The drawback of this approach is sometimes it will accept a definition that
a (hypothetical) declarative specification would likely reject. As a general
rule, we don't want to allow polymorphic recursion without a CUSK. Indeed,
the whole point of CUSKs is to allow polymorphic recursion. Yet, the SigTvs
approach allows a limited form of polymorphic recursion *without* a CUSK.

To wit:
  data T a = forall k (b :: k). MkT (T b) Int
  (test case: dependent/should_compile/T14066a)

Note that this is polymorphically recursive, with the recursive occurrence
of T used at a kind other than a's kind. The approach outlined here accepts
this definition, because this kind is still a kind variable (and so the
SigTvs unify). Stepping back, I (Richard) have a hard time envisioning a
way to describe exactly what declarations will be accepted and which will
be rejected (without a CUSK). However, the accepted definitions are indeed
well-kinded and any rejected definitions would be accepted with a CUSK,
and so this wrinkle need not cause anyone to lose sleep.
869

Austin Seipp's avatar
Austin Seipp committed
870 871
************************************************************************
*                                                                      *
872
\subsection{Type checking}
Austin Seipp's avatar
Austin Seipp committed
873 874
*                                                                      *
************************************************************************
875

dreixel's avatar
dreixel committed
876 877 878 879
Note [Type checking recursive type and class declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
At this point we have completed *kind-checking* of a mutually
recursive group of type/class decls (done in kcTyClGroup). However,
880
we discarded the kind-checked types (eg RHSs of data type decls);
dreixel's avatar
dreixel committed
881 882 883 884 885 886 887
note that kcTyClDecl returns ().  There are two reasons:

  * It's convenient, because we don't have to rebuild a
    kinded HsDecl (a fairly elaborate type)

  * It's necessary, because after kind-generalisation, the
    TyCons/Classes may now be kind-polymorphic, and hence need
888
    to be given kind arguments.
dreixel's avatar
dreixel committed
889 890 891 892 893 894 895

Example:
       data T f a = MkT (f a) (T f a)
During kind-checking, we give T the kind T :: k1 -> k2 -> *
and figure out constraints on k1, k2 etc. Then we generalise
to get   T :: forall k. (k->*) -> k -> *
So now the (T f a) in the RHS must be elaborated to (T k f a).
896

dreixel's avatar
dreixel committed
897 898 899 900 901 902 903
However, during tcTyClDecl of T (above) we will be in a recursive
"knot". So we aren't allowed to look at the TyCon T itself; we are only
allowed to put it (lazily) in the returned structures.  But when
kind-checking the RHS of T's decl, we *do* need to know T's kind (so
that we can correctly elaboarate (T k f a).  How can we get T's kind
without looking at T?  Delicate answer: during tcTyClDecl, we extend

904 905
  *Global* env with T -> ATyCon (the (not yet built) final TyCon for T)
  *Local*  env with T -> ATcTyCon (TcTyCon with the polymorphic kind of T)
dreixel's avatar
dreixel committed
906 907 908 909 910 911 912 913 914 915

Then:

  * During TcHsType.kcTyVar we look in the *local* env, to get the
    known kind for T.

  * But in TcHsType.ds_type (and ds_var_app in particular) we look in
    the *global* env to get the TyCon. But we must be careful not to
    force the TyCon or we'll get a loop.

Gabor Greif's avatar
Gabor Greif committed
916
This fancy footwork (with two bindings for T) is only necessary for the
dreixel's avatar
dreixel committed
917 918
TyCons or Classes of this recursive group.  Earlier, finished groups,
live in the global env only.
919

920 921 922 923 924 925 926 927 928 929 930
See also Note [Kind checking recursive type and class declarations]

Note [Kind checking recursive type and class declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before we can type-check the decls, we must kind check them. This
is done by establishing an "initial kind", which is a rather uninformed
guess at a tycon's kind (by counting arguments, mainly) and then
using this initial kind for recursive occurrences.

The initial kind is stored in exactly the same way during kind-checking
as it is during type-checking (Note [Type checking recursive type and class
931
declarations]): in the *local* environment, with ATcTyCon. But we still
932 933 934 935 936 937 938 939 940 941 942
must store *something* in the *global* environment. Even though we
discard the result of kind-checking, we sometimes need to produce error
messages. These error messages will want to refer to the tycons being
checked, except that they don't exist yet, and it would be Terribly
Annoying to get the error messages to refer back to HsSyn. So we
create a TcTyCon and put it in the global env. This tycon can
print out its name and knows its kind,
but any other action taken on it will panic. Note
that TcTyCons are *not* knot-tied, unlike the rather valid but
knot-tied ones that occur during type-checking.

943 944 945 946 947 948
Note [Declarations for wired-in things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For wired-in things we simply ignore the declaration
and take the wired-in information.  That avoids complications.
e.g. the need to make the data constructor worker name for
     a constraint tuple match the wired-in one
Austin Seipp's avatar
Austin Seipp committed
949
-}
dreixel's avatar
dreixel committed
950

951
tcTyClDecl :: RolesInfo -> LTyClDecl GhcRn -> TcM TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
952
tcTyClDecl roles_info (L loc decl)
953
  | Just thing <- wiredInNameTyThing_maybe (tcdName decl)
954 955 956
  = case thing of -- See Note [Declarations for wired-in things]
      ATyCon tc -> return tc
      _ -> pprPanic "tcTyClDecl" (ppr thing)
957 958

  | otherwise
959
  = setSrcSpan loc $ tcAddDeclCtxt decl $
Simon Peyton Jones's avatar
Simon Peyton Jones committed
960 961 962 963
    do { traceTc "---- tcTyClDecl ---- {" (ppr decl)
       ; tc <- tcTyClDecl1 Nothing roles_info decl
       ; traceTc "---- tcTyClDecl end ---- }" (ppr tc)
       ; return tc }
964

965
  -- "type family" declarations
966
tcTyClDecl1 :: Maybe Class -> RolesInfo -> TyClDecl GhcRn -> TcM TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
967
tcTyClDecl1 parent _roles_info (FamDecl { tcdFam = fd })
968
  = tcFamDecl1 parent fd
969

970
  -- "type" synonym declaration
Edward Z. Yang's avatar
Edward Z. Yang committed
971
tcTyClDecl1 _parent roles_info
972
            (SynDecl { tcdLName = L _ tc_name, tcdRhs = rhs })
973
  = ASSERT( isNothing _parent )
974
    tcTyClTyVars tc_name $ \ binders res_kind ->
Edward Z. Yang's avatar
Edward Z. Yang committed
975
    tcTySynRhs roles_info tc_name binders res_kind rhs
976

977
  -- "data/newtype" declaration
Edward Z. Yang's avatar
Edward Z. Yang committed
978
tcTyClDecl1 _parent roles_info
979 980
            (DataDecl { tcdLName = L _ tc_name
                      , tcdDataDefn = defn })
981
  = ASSERT( isNothing _parent )
982
    tcTyClTyVars tc_name $ \ tycon_binders res_kind ->
Edward Z. Yang's avatar
Edward Z. Yang committed
983
    tcDataDefn roles_info tc_name tycon_binders res_kind defn
984

Edward Z. Yang's avatar
Edward Z. Yang committed
985
tcTyClDecl1 _parent roles_info
986
            (ClassDecl { tcdLName = L _ class_name
987
            , tcdCtxt = ctxt, tcdMeths = meths
988
            , tcdFDs = fundeps, tcdSigs = sigs
989
            , tcdATs = ats, tcdATDefs = at_defs })
990
  = ASSERT( isNothing _parent )
991
    do { clas <- fixM $ \ clas ->
Gabor Greif's avatar
Gabor Greif committed
<