TcTyClsDecls.hs 120 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 #-}
Ian Lynagh's avatar
Ian Lynagh committed
10

11
module TcTyClsDecls (
12
        tcTyAndClassDecls, tcAddImplicits,
13

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

22
#include "HsVersions.h"
23

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

Ian Lynagh's avatar
Ian Lynagh committed
72
import Control.Monad
73
import Data.List
74

Austin Seipp's avatar
Austin Seipp committed
75
76
77
{-
************************************************************************
*                                                                      *
78
\subsection{Type checking for type and class declarations}
Austin Seipp's avatar
Austin Seipp committed
79
80
*                                                                      *
************************************************************************
81

dreixel's avatar
dreixel committed
82
83
84
85
86
87
88
89
90
91
92
93
94
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
95
forall (k::*). k -> k. Since it does not depend on anything else, it can be
dreixel's avatar
dreixel committed
96
97
98
99
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 *.

100
101
102
103
104
105
106
107
108
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
109
-}
110

111
112
113
114
115
116
117
118
tcTyAndClassDecls :: [TyClGroup Name]       -- Mutually-recursive groups in
                                            -- dependency order
                  -> TcM ( TcGblEnv         -- Input env extended by types and
                                            -- classes
                                            -- and their implicit Ids,DataCons
                         , [InstInfo Name]  -- Source-code instance decls info
                         , [DerivInfo]      -- data family deriving info
                         )
119
-- Fails if there are any errors
Simon Peyton Jones's avatar
Simon Peyton Jones committed
120
tcTyAndClassDecls tyclds_s
121
122
123
124
  -- 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
125
  where
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
    fold_env :: [InstInfo Name]
             -> [DerivInfo]
             -> [TyClGroup Name]
             -> TcM (TcGblEnv, [InstInfo Name], [DerivInfo])
    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 }

tcTyClGroup :: TyClGroup Name
            -> TcM (TcGblEnv, [InstInfo Name], [DerivInfo])
-- Typecheck one strongly-connected component of type, class, and instance decls
Simon Peyton Jones's avatar
Simon Peyton Jones committed
144
-- See Note [TyClGroups and dependency analysis] in HsDecls
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
tcTyClGroup (TyClGroup { group_tyclds = tyclds
                       , group_roles  = roles
                       , group_instds = instds })
  = do { let role_annots = mkRoleAnnotEnv roles

           -- Step 1: Typecheck the type/class declarations
       ; tyclss <- tcTyClDecls tyclds role_annots

           -- 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)
       ; tyclss <- mapM checkValidTyCl tyclss
       ; traceTc "Done validity check" (ppr tyclss)
       ; mapM_ (recoverM (return ()) . checkValidRoleAnnots role_annots) tyclss
           -- See Note [Check role annotations in a second pass]

           -- Step 3: Add the implicit things;
           -- we want them in the environment because
           -- they may be mentioned in interface files
       ; tcExtendTyConEnv tyclss $
    do { gbl_env <- tcAddImplicits tyclss
       ; setGblEnv gbl_env $
    do {
            -- Step 4: check instance declarations
       ; (gbl_env, inst_info, datafam_deriv_info) <- tcInstDecls1 instds

       ; return (gbl_env, inst_info, datafam_deriv_info) } } }


tcTyClDecls :: [LTyClDecl Name] -> RoleAnnotEnv -> TcM [TyCon]
tcTyClDecls tyclds role_annots
dreixel's avatar
dreixel committed
178
179
180
  = do {    -- Step 1: kind-check this group and returns the final
            -- (possibly-polymorphic) kind of each TyCon and Class
            -- See Note [Kind checking for type and class decls]
181
182
         tc_tycons <- kcTyClGroup tyclds
       ; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons))
dreixel's avatar
dreixel committed
183

184
185
            -- Step 2: type-check all groups together, returning
            -- the final TyCons and Classes
186
       ; fixM $ \ ~rec_tyclss -> do
Simon Peyton Jones's avatar
Simon Peyton Jones committed
187
           { is_boot   <- tcIsHsBootOrSig
Edward Z. Yang's avatar
Edward Z. Yang committed
188
           ; let roles = inferRoles is_boot role_annots rec_tyclss
dreixel's avatar
dreixel committed
189
190
191

                 -- Populate environment with knot-tied ATyCon for TyCons
                 -- NB: if the decls mention any ill-staged data cons
Jan Stolarek's avatar
Jan Stolarek committed
192
                 -- (see Note [Recusion and promoting data constructors])
193
                 -- we will have failed already in kcTyClGroup, so no worries here
194
           ; tcExtendRecEnv (zipRecTyClss tc_tycons rec_tyclss) $
dreixel's avatar
dreixel committed
195
196
197

                 -- Also extend the local type envt with bindings giving
                 -- the (polymorphic) kind of each knot-tied TyCon or Class
198
                 -- See Note [Type checking recursive type and class declarations]
199
             tcExtendKindEnv2 (map mkTcTyConPair tc_tycons)              $
dreixel's avatar
dreixel committed
200
201

                 -- Kind and type check declarations for this group
Edward Z. Yang's avatar
Edward Z. Yang committed
202
               mapM (tcTyClDecl roles) tyclds
203
           } }
204
205
206
207
  where
    ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma
                                  , ppr (tyConBinders tc) <> comma
                                  , ppr (tyConResKind tc) ])
dreixel's avatar
dreixel committed
208

209
zipRecTyClss :: [TcTyCon]
210
             -> [TyCon]           -- Knot-tied
211
             -> [(Name,TyThing)]
212
213
-- 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
214
-- The TyThings in the result list must have a visible ATyCon,
215
216
-- because typechecking types (in, say, tcTyClDecl) looks at
-- this outer constructor
217
218
zipRecTyClss tc_tycons rec_tycons
  = [ (name, ATyCon (get name)) | tc_tycon <- tc_tycons, let name = getName tc_tycon ]
219
  where
220
221
    rec_tc_env :: NameEnv TyCon
    rec_tc_env = foldr add_tc emptyNameEnv rec_tycons
222

223
224
225
226
227
228
229
230
231
    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)
232

Austin Seipp's avatar
Austin Seipp committed
233
234
235
{-
************************************************************************
*                                                                      *
236
                Kind checking
Austin Seipp's avatar
Austin Seipp committed
237
238
*                                                                      *
************************************************************************
239

240
241
242
243
Note [Kind checking for type and class decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Kind checking is done thus:

244
245
246
   1. Make up a kind variable for each parameter of the *data* type, class,
      and closed type family decls, and extend the kind environment (which is
      in the TcLclEnv)
247
248
249
250
251
252

   2. Dependency-analyse the type *synonyms* (which must be non-recursive),
      and kind-check them in dependency order.  Extend the kind envt.

   3. Kind check the data type and class decls

253
254
We need to kind check all types in the mutually recursive group
before we know the kind of the type variables.  For example:
255

256
257
  class C a where
     op :: D b => a -> b -> b
258

259
260
  class D c where
     bop :: (Monad c) => ...
261
262
263
264
265

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.

266
267
However type synonyms work differently.  They can have kinds which don't
just involve (->) and *:
268
269
270
        type R = Int#           -- Kind #
        type S a = Array# a     -- Kind * -> #
        type T a b = (# a,b #)  -- Kind * -> * -> (# a,b #)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
271
272
273
274
275
276
277
278
279
280
and a kind variable can't unify with UnboxedTypeKind.

So we must infer the kinds of type synonyms from their right-hand
sides *first* and then use them, whereas for the mutually recursive
data types D we bring into scope kind bindings D -> k, where k is a
kind variable, and do inference.

NB: synonyms can be mutually recursive with data type declarations though!
   type T = D -> D
   data D = MkD Int T
281

282
283
Open type families
~~~~~~~~~~~~~~~~~~
284
285
286
This treatment of type synonyms only applies to Haskell 98-style synonyms.
General type functions can be recursive, and hence, appear in `alg_decls'.

287
The kind of an open type family is solely determinded by its kind signature;
288
hence, only kind signatures participate in the construction of the initial
289
290
291
292
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').
293
294
295
296


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

Austin Seipp's avatar
Austin Seipp committed
297
-}
298

299
kcTyClGroup :: [LTyClDecl Name] -> TcM [TcTyCon]
dreixel's avatar
dreixel committed
300
-- Kind check this group, kind generalize, and return the resulting local env
301
-- This bindds the TyCons and Classes of the group, but not the DataCons
dreixel's avatar
dreixel committed
302
-- See Note [Kind checking for type and class decls]
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
303
304
-- Third return value is Nothing if the tycon be unsaturated; otherwise,
-- the arity
305
kcTyClGroup decls
306
  = do  { mod <- getModule
307
        ; traceTc "kcTyClGroup" (text "module" <+> ppr mod $$ vcat (map ppr decls))
dreixel's avatar
dreixel committed
308

309
310
          -- Kind checking;
          --    1. Bind kind variables for non-synonyms
dreixel's avatar
dreixel committed
311
312
          --    2. Kind-check synonyms, and bind kinds of those synonyms
          --    3. Kind-check non-synonyms
313
          --    4. Generalise the inferred kinds
dreixel's avatar
dreixel committed
314
315
          -- See Note [Kind checking for type and class decls]

316
        ; lcl_env <- solveEqualities $
317
318
319
320
          do {
               -- Step 1: Bind kind variables for non-synonyms
               let (syn_decls, non_syn_decls) = partition (isSynDecl . unLoc) decls
             ; initial_kinds <- getInitialKinds non_syn_decls
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
321
322
             ; traceTc "kcTyClGroup: initial kinds" $
               vcat (map pp_initial_kind initial_kinds)
323

324
325
326
             -- Step 2: Set initial envt, kind-check the synonyms
             ; lcl_env <- tcExtendKindEnv2 initial_kinds $
                          kcSynDecls (calcSynCycles syn_decls)
327

328
329
330
331
332
             -- Step 3: Set extended envt, kind-check the non-synonyms
             ; setLclEnv lcl_env $
               mapM_ kcLTyClDecl non_syn_decls

             ; return lcl_env }
dreixel's avatar
dreixel committed
333

334
335
             -- Step 4: generalisation
             -- Kind checking done for this group
dreixel's avatar
dreixel committed
336
             -- Now we have to kind generalize the flexis
337
        ; res <- concatMapM (generaliseTCD (tcl_env lcl_env)) decls
338

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
339
        ; traceTc "kcTyClGroup result" (vcat (map pp_res res))
340
        ; return res }
341

342
  where
343
    generalise :: TcTypeEnv -> Name -> TcM TcTyCon
344
    -- For polymorphic things this is a no-op
345
    generalise kind_env name
346
347
348
349
350
      = do { let tc = case lookupNameEnv kind_env name of
                        Just (ATcTyCon tc) -> tc
                        _ -> pprPanic "kcTyClGroup" (ppr name $$ ppr kind_env)
                 kc_binders  = tyConBinders tc
                 kc_res_kind = tyConResKind tc
351
                 kc_tyvars   = tyConTyVars tc
352
353
354
355
           ; kvs <- kindGeneralize (mkTyConKind kc_binders kc_res_kind)

           ; (env, kc_binders') <- zonkTyConBinders emptyZonkEnv kc_binders
           ; kc_res_kind' <- zonkTcTypeToType env kc_res_kind
356
357

                      -- Make sure kc_kind' has the final, zonked kind variables
358
359
           ; traceTc "Generalise kind" $
             vcat [ ppr name, ppr kc_binders, ppr kc_res_kind
360
361
                  , ppr kvs, ppr kc_binders', ppr kc_res_kind'
                  , ppr kc_tyvars, ppr (tcTyConScopedTyVars tc)]
362

363
           ; return (mkTcTyCon name
364
                               (mkNamedTyConBinders Inferred kvs ++ kc_binders')
365
                               kc_res_kind'
366
367
                               (mightBeUnsaturatedTyCon tc)
                               (tcTyConScopedTyVars tc)) }
dreixel's avatar
dreixel committed
368

369
    generaliseTCD :: TcTypeEnv
370
                  -> LTyClDecl Name -> TcM [TcTyCon]
371
    generaliseTCD kind_env (L _ decl)
372
373
      | ClassDecl { tcdLName = (L _ name), tcdATs = ats } <- decl
      = do { first <- generalise kind_env name
374
375
376
377
378
379
380
381
           ; rest <- mapM ((generaliseFamDecl kind_env) . unLoc) ats
           ; return (first : rest) }

      | FamDecl { tcdFam = fam } <- decl
      = do { res <- generaliseFamDecl kind_env fam
           ; return [res] }

      | otherwise
382
      = do { res <- generalise kind_env (tcdName decl)
383
384
           ; return [res] }

385
    generaliseFamDecl :: TcTypeEnv
386
                      -> FamilyDecl Name -> TcM TcTyCon
387
388
    generaliseFamDecl kind_env (FamilyDecl { fdLName = L _ name })
      = generalise kind_env name
389

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
390
391
392
393
394
395
396
    pp_initial_kind (name, ATcTyCon tc)
      = ppr name <+> dcolon <+> ppr (tyConKind tc)
    pp_initial_kind pair
      = ppr pair

    pp_res tc = ppr (tyConName tc) <+> dcolon <+> ppr (tyConKind tc)

397
mkTcTyConPair :: TcTyCon -> (Name, TcTyThing)
398
-- Makes a binding to put in the local envt, binding
399
400
401
-- a name to a TcTyCon
mkTcTyConPair tc
  = (getName tc, ATcTyCon tc)
402

403
404
405
406
407
408
409
410
411
412
413
414
mk_thing_env :: [LTyClDecl Name] -> [(Name, TcTyThing)]
mk_thing_env [] = []
mk_thing_env (decl : decls)
  | L _ (ClassDecl { tcdLName = L _ nm, tcdATs = ats }) <- decl
  = (nm, APromotionErr ClassPE) :
    (map (, APromotionErr TyConPE) $ map (unLoc . fdLName . unLoc) ats) ++
    (mk_thing_env decls)

  | otherwise
  = (tcdName (unLoc decl), APromotionErr TyConPE) :
    (mk_thing_env decls)

415
getInitialKinds :: [LTyClDecl Name] -> TcM [(Name, TcTyThing)]
416
getInitialKinds decls
417
  = tcExtendKindEnv2 (mk_thing_env decls) $
418
419
    do { pairss <- mapM (addLocM getInitialKind) decls
       ; return (concat pairss) }
420

421
422
getInitialKind :: TyClDecl Name
               -> TcM [(Name, TcTyThing)]    -- Mixture of ATcTyCon and APromotionErr
dreixel's avatar
dreixel committed
423
-- Allocate a fresh kind variable for each TyCon and Class
424
-- For each tycon, return   (name, ATcTyCon (TcCyCon with kind k))
dreixel's avatar
dreixel committed
425
426
427
428
--                 where k is the kind of tc, derived from the LHS
--                       of the definition (and probably including
--                       kind unification variables)
--      Example: data T a b = ...
429
--      return (T, kv1 -> kv2 -> kv3)
dreixel's avatar
dreixel committed
430
--
431
432
433
434
435
-- 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
--
-- ALSO for each datacon, return (dc, APromotionErr RecDataConPE)
436
--    See Note [ARecDataCon: Recursion and promoting data constructors]
437
--
438
-- No family instances are passed to getInitialKinds
dreixel's avatar
dreixel committed
439

440
getInitialKind decl@(ClassDecl { tcdLName = L _ name, tcdTyVars = ktvs, tcdATs = ats })
441
442
  = do { (mk_tctc, inner_prs) <-
           kcHsTyVarBndrs name cusk False True ktvs $
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
443
           do { inner_prs <- getFamDeclInitialKinds (Just cusk) ats
444
              ; return (constraintKind, inner_prs) }
445
       ; let main_pr = mkTcTyConPair (mk_tctc True)
446
       ; return (main_pr : inner_prs) }
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
447
448
  where
    cusk = hsDeclHasCusk decl
449

450
getInitialKind decl@(DataDecl { tcdLName = L _ name
451
452
                              , tcdTyVars = ktvs
                              , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig
453
                                                         , dd_cons = cons } })
454
455
  = do  { (mk_tctc, _) <-
           kcHsTyVarBndrs name (hsDeclHasCusk decl) False True ktvs $
456
457
458
           do { res_k <- case m_sig of
                           Just ksig -> tcLHsKind ksig
                           Nothing   -> return liftedTypeKind
459
              ; return (res_k, ()) }
460
        ; let main_pr = mkTcTyConPair (mk_tctc True)
461
462
463
              inner_prs = [ (unLoc con, APromotionErr RecDataConPE)
                          | L _ con' <- cons, con <- getConNames con' ]
        ; return (main_pr : inner_prs) }
464

Jan Stolarek's avatar
Jan Stolarek committed
465
getInitialKind (FamDecl { tcdFam = decl })
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
466
  = getFamDeclInitialKind Nothing decl
467

Jan Stolarek's avatar
Jan Stolarek committed
468
getInitialKind decl@(SynDecl {})
469
470
471
  = pprPanic "getInitialKind" (ppr decl)

---------------------------------
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
472
473
474
getFamDeclInitialKinds :: Maybe Bool  -- if assoc., CUSKness of assoc. class
                       -> [LFamilyDecl Name] -> TcM [(Name, TcTyThing)]
getFamDeclInitialKinds mb_cusk decls
475
476
  = tcExtendKindEnv2 [ (n, APromotionErr TyConPE)
                     | L _ (FamilyDecl { fdLName = L _ n }) <- decls] $
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
477
    concatMapM (addLocM (getFamDeclInitialKind mb_cusk)) decls
478

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
479
480
getFamDeclInitialKind :: Maybe Bool  -- if assoc., CUSKness of assoc. class
                      -> FamilyDecl Name
481
                      -> TcM [(Name, TcTyThing)]
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
482
483
484
485
getFamDeclInitialKind mb_cusk decl@(FamilyDecl { fdLName     = L _ name
                                               , fdTyVars    = ktvs
                                               , fdResultSig = L _ resultSig
                                               , fdInfo      = info })
486
487
  = do { (mk_tctc, _) <-
           kcHsTyVarBndrs name cusk open True ktvs $
Jan Stolarek's avatar
Jan Stolarek committed
488
489
490
491
           do { res_k <- case resultSig of
                      KindSig ki                        -> tcLHsKind ki
                      TyVarSig (L _ (KindedTyVar _ ki)) -> tcLHsKind ki
                      _ -- open type families have * return kind by default
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
492
                        | open                     -> return liftedTypeKind
Jan Stolarek's avatar
Jan Stolarek committed
493
494
495
                        -- closed type families have their return kind inferred
                        -- by default
                        | otherwise                -> newMetaKindVar
496
              ; return (res_k, ()) }
497
       ; return [ mkTcTyConPair (mk_tctc unsat) ] }
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
498
  where
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
499
500
501
502
503
    cusk  = famDeclHasCusk mb_cusk decl
    (open, unsat) = case info of
      DataFamily         -> (True,  True)
      OpenTypeFamily     -> (True,  False)
      ClosedTypeFamily _ -> (False, False)
504

505
----------------
506
kcSynDecls :: [SCC (LTyClDecl Name)]
507
508
           -> TcM TcLclEnv -- Kind bindings
kcSynDecls [] = getLclEnv
509
kcSynDecls (group : groups)
510
  = do  { tc <- kcSynDecl1 group
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
511
        ; traceTc "kcSynDecl" (ppr tc <+> dcolon <+> ppr (tyConKind tc))
512
        ; tcExtendKindEnv2 [ mkTcTyConPair tc ] $
513
          kcSynDecls groups }
dreixel's avatar
dreixel committed
514
515

kcSynDecl1 :: SCC (LTyClDecl Name)
516
           -> TcM TcTyCon -- Kind bindings
dreixel's avatar
dreixel committed
517
518
kcSynDecl1 (AcyclicSCC (L _ decl)) = kcSynDecl decl
kcSynDecl1 (CyclicSCC decls)       = do { recSynErr decls; failM }
519
520
                                     -- Fail here to avoid error cascade
                                     -- of out-of-scope tycons
dreixel's avatar
dreixel committed
521

522
kcSynDecl :: TyClDecl Name -> TcM TcTyCon
523
kcSynDecl decl@(SynDecl { tcdTyVars = hs_tvs, tcdLName = L _ name
524
                        , tcdRhs = rhs })
525
  -- Returns a possibly-unzonked kind
dreixel's avatar
dreixel committed
526
  = tcAddDeclCtxt decl $
527
528
    do { (mk_tctc, _) <-
           kcHsTyVarBndrs name (hsDeclHasCusk decl) False True hs_tvs $
529
530
531
532
           do { traceTc "kcd1" (ppr name <+> brackets (ppr hs_tvs))
              ; (_, rhs_kind) <- tcLHsType rhs
              ; traceTc "kcd2" (ppr name)
              ; return (rhs_kind, ()) }
533
       ; return (mk_tctc False) }
534
kcSynDecl decl = pprPanic "kcSynDecl" (ppr decl)
535

536
------------------------------------------------------------------------
537
kcLTyClDecl :: LTyClDecl Name -> TcM ()
538
  -- See Note [Kind checking for type and class decls]
539
540
541
kcLTyClDecl (L loc decl)
  = setSrcSpan loc $ tcAddDeclCtxt decl $ kcTyClDecl decl

dreixel's avatar
dreixel committed
542
543
kcTyClDecl :: TyClDecl Name -> TcM ()
-- This function is used solely for its side effect on kind variables
544
-- NB kind signatures on the type variables and
Gabor Greif's avatar
Gabor Greif committed
545
--    result kind signature have already been dealt with
546
--    by getInitialKind, so we can ignore them here.
dreixel's avatar
dreixel committed
547

548
kcTyClDecl (DataDecl { tcdLName = L _ name, tcdDataDefn = defn })
549
  | HsDataDefn { dd_cons = cons, dd_kindSig = Just _ } <- defn
550
  = mapM_ (wrapLocM kcConDecl) cons
551
552
553
554
555
556
    -- hs_tvs and dd_kindSig already dealt with in getInitialKind
    -- If dd_kindSig is Just, this must be a GADT-style decl,
    --        (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
557

558
  | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } <- defn
559
  = kcTyClTyVars name $
560
    do  { _ <- tcHsContext ctxt
561
        ; mapM_ (wrapLocM kcConDecl) cons }
562

563
kcTyClDecl decl@(SynDecl {}) = pprPanic "kcTyClDecl" (ppr decl)
564

565
566
567
kcTyClDecl (ClassDecl { tcdLName = L _ name
                      , tcdCtxt = ctxt, tcdSigs = sigs })
  = kcTyClTyVars name $
568
    do  { _ <- tcHsContext ctxt
569
        ; mapM_ (wrapLocM kc_sig)     sigs }
dreixel's avatar
dreixel committed
570
  where
Alan Zimmerman's avatar
Alan Zimmerman committed
571
    kc_sig (ClassOpSig _ nms op_ty) = kcHsSigType nms op_ty
572
    kc_sig _                        = return ()
573

574
kcTyClDecl (FamDecl (FamilyDecl { fdLName  = L _ fam_tc_name
575
576
577
578
579
                                , fdInfo   = fd_info }))
-- closed type families look at their equations, but other families don't
-- do anything here
  = case fd_info of
      ClosedTypeFamily (Just eqns) ->
580
581
        do { fam_tc <- kcLookupTcTyCon fam_tc_name
           ; mapM_ (kcTyFamInstEqn (famTyConShape fam_tc)) eqns }
582
      _ -> return ()
dreixel's avatar
dreixel committed
583
584

-------------------
585
kcConDecl :: ConDecl Name -> TcM ()
Alan Zimmerman's avatar
Alan Zimmerman committed
586
587
588
kcConDecl (ConDeclH98 { con_name = name, con_qvars = ex_tvs
                      , con_cxt = ex_ctxt, con_details = details })
  = addErrCtxt (dataConCtxtName [name]) $
589
590
         -- the 'False' says that the existentials don't have a CUSK, as the
         -- concept doesn't really apply here. We just need to bring the variables
591
         -- into scope.
592
593
    do { _ <- kcHsTyVarBndrs (unLoc name) False False False
                             ((fromMaybe emptyLHsQTvs ex_tvs)) $
Alan Zimmerman's avatar
Alan Zimmerman committed
594
              do { _ <- tcHsContext (fromMaybe (noLoc []) ex_ctxt)
595
596
                 ; mapM_ (tcHsOpenType . getBangType) (hsConDeclArgTys details)
                 ; return (panic "kcConDecl", ()) }
597
598
              -- We don't need to check the telescope here, because that's
              -- done in tcConDecl
599
       ; return () }
600

Alan Zimmerman's avatar
Alan Zimmerman committed
601
602
603
604
605
606
607
kcConDecl (ConDeclGADT { con_names = names
                       , con_type = ty })
  = addErrCtxt (dataConCtxtName names) $
      do { _ <- tcGadtSigType (ppr names) (unLoc $ head names) ty
         ; return () }


Austin Seipp's avatar
Austin Seipp committed
608
{-
609
610
Note [Recursion and promoting data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
611
612
613
614
615
616
617
618
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:
619
620
  T -> ATcTyCon <some initial kind>
  K -> APromotionErr
621

622
APromotionErr is only used for DataCons, and only used during type checking
623
624
in tcTyClGroup.

625

Austin Seipp's avatar
Austin Seipp committed
626
627
************************************************************************
*                                                                      *
628
\subsection{Type checking}
Austin Seipp's avatar
Austin Seipp committed
629
630
*                                                                      *
************************************************************************
631

dreixel's avatar
dreixel committed
632
633
634
635
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,
636
we discarded the kind-checked types (eg RHSs of data type decls);
dreixel's avatar
dreixel committed
637
638
639
640
641
642
643
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
644
    to be given kind arguments.
dreixel's avatar
dreixel committed
645
646
647
648
649
650
651

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).
652

dreixel's avatar
dreixel committed
653
654
655
656
657
658
659
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

660
661
  *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
662
663
664
665
666
667
668
669
670
671

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
672
This fancy footwork (with two bindings for T) is only necessary for the
dreixel's avatar
dreixel committed
673
674
TyCons or Classes of this recursive group.  Earlier, finished groups,
live in the global env only.
675

676
677
678
679
680
681
682
683
684
685
686
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
687
declarations]): in the *local* environment, with ATcTyCon. But we still
688
689
690
691
692
693
694
695
696
697
698
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.

699
700
701
702
703
704
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
705
-}
dreixel's avatar
dreixel committed
706

Edward Z. Yang's avatar
Edward Z. Yang committed
707
708
tcTyClDecl :: RolesInfo -> LTyClDecl Name -> TcM TyCon
tcTyClDecl roles_info (L loc decl)
709
  | Just thing <- wiredInNameTyThing_maybe (tcdName decl)
710
711
712
  = case thing of -- See Note [Declarations for wired-in things]
      ATyCon tc -> return tc
      _ -> pprPanic "tcTyClDecl" (ppr thing)
713
714

  | otherwise
715
  = setSrcSpan loc $ tcAddDeclCtxt decl $
716
    do { traceTc "tcTyAndCl-x" (ppr decl)
Edward Z. Yang's avatar
Edward Z. Yang committed
717
       ; tcTyClDecl1 Nothing roles_info decl }
718

719
  -- "type family" declarations
Edward Z. Yang's avatar
Edward Z. Yang committed
720
721
tcTyClDecl1 :: Maybe Class -> RolesInfo -> TyClDecl Name -> TcM TyCon
tcTyClDecl1 parent _roles_info (FamDecl { tcdFam = fd })
722
  = tcFamDecl1 parent fd
723

724
  -- "type" synonym declaration
Edward Z. Yang's avatar
Edward Z. Yang committed
725
tcTyClDecl1 _parent roles_info
726
            (SynDecl { tcdLName = L _ tc_name, tcdRhs = rhs })
727
  = ASSERT( isNothing _parent )
728
    tcTyClTyVars tc_name $ \ binders res_kind ->
Edward Z. Yang's avatar
Edward Z. Yang committed
729
    tcTySynRhs roles_info tc_name binders res_kind rhs
730

731
  -- "data/newtype" declaration
Edward Z. Yang's avatar
Edward Z. Yang committed
732
tcTyClDecl1 _parent roles_info
733
            (DataDecl { tcdLName = L _ tc_name, tcdDataDefn = defn })
734
  = ASSERT( isNothing _parent )
735
    tcTyClTyVars tc_name $ \ tycon_binders res_kind ->
Edward Z. Yang's avatar
Edward Z. Yang committed
736
    tcDataDefn roles_info tc_name tycon_binders res_kind defn
737

Edward Z. Yang's avatar
Edward Z. Yang committed
738
tcTyClDecl1 _parent roles_info
739
            (ClassDecl { tcdLName = L _ class_name
740
            , tcdCtxt = ctxt, tcdMeths = meths
741
            , tcdFDs = fundeps, tcdSigs = sigs
742
            , tcdATs = ats, tcdATDefs = at_defs })
743
  = ASSERT( isNothing _parent )
744
    do { clas <- fixM $ \ clas ->
Gabor Greif's avatar
Gabor Greif committed
745
            -- We need the knot because 'clas' is passed into tcClassATs
746
            tcTyClTyVars class_name $ \ binders res_kind ->
747
            do { MASSERT( isConstraintKind res_kind )
748
               ; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders)
749
750
               ; let tycon_name = class_name        -- We use the same name
                     roles = roles_info tycon_name  -- for TyCon and Class
dreixel's avatar
dreixel committed
751

752
               ; ctxt' <- solveEqualities $ tcHsContext ctxt
753
               ; ctxt' <- zonkTcTypeToTypes emptyZonkEnv ctxt'
754
755
                       -- Squeeze out any kind unification variables
               ; fds'  <- mapM (addLocM tc_fundep) fundeps
756
               ; sig_stuff <- tcClassSigs class_name sigs meths
757
               ; at_stuff <- tcClassATs class_name clas ats at_defs
758
               ; mindef <- tcClassMinimalDef class_name sigs sig_stuff
759
               ; clas <- buildClass
760
                            class_name binders roles ctxt'
761
                            fds' at_stuff
Edward Z. Yang's avatar
Edward Z. Yang committed
762
                            sig_stuff mindef
763
               ; traceTc "tcClassDecl" (ppr fundeps $$ ppr binders $$
764
                                        ppr fds')
765
766
767
               ; return clas }

         ; return (classTyCon clas) }
768
  where
769
770
    tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM (tcLookupTyVar . unLoc) tvs1 ;
                                ; tvs2' <- mapM (tcLookupTyVar . unLoc) tvs2 ;
771
                                ; return (tvs1', tvs2') }
Jan Stolarek's avatar
Jan Stolarek committed
772

773
tcFamDecl1 :: Maybe Class -> FamilyDecl Name -> TcM TyCon
774
tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_name)
775
776
                              , fdTyVars = tvs, fdResultSig = L _ sig
                              , fdInjectivityAnn = inj })
777
  | DataFamily <- fam_info
778
  = tcTyClTyVars tc_name $ \ binders res_kind -> do
779
780
  { traceTc "data family:" (ppr tc_name)
  ; checkFamFlag tc_name
781
  ; (extra_binders, real_res_kind) <- tcDataKindSig res_kind
782
  ; tc_rep_name <- newTyConRepName tc_name
783
784
  ; let tycon = mkFamilyTyCon tc_name (binders `chkAppend` extra_binders)
                              real_res_kind
785
786
787
788
789
790
                              (resultVariableName sig)
                              (DataFamilyTyCon tc_rep_name)
                              parent NotInjective
  ; return tycon }

  | OpenTypeFamily <- fam_info
791
  = tcTyClTyVars tc_name $ \ binders res_kind -> do
792
  { traceTc "open type family:" (ppr tc_name)
793
  ; checkFamFlag tc_name
794
795
  ; inj' <- tcInjectivity binders inj
  ; let tycon = mkFamilyTyCon tc_name binders res_kind
796
797
                               (resultVariableName sig) OpenSynFamilyTyCon
                               parent inj'
798
  ; return tycon }
799

800
801
802
803
  | ClosedTypeFamily mb_eqns <- fam_info
  = -- Closed type families are a little tricky, because they contain the definition
    -- of both the type family and the equations for a CoAxiom.
    do { traceTc "Closed type family:" (ppr tc_name)
Jan Stolarek's avatar
Jan Stolarek committed
804
805
         -- the variables in the header scope only over the injectivity
         -- declaration but this is not involved here
806
       ; (inj', binders, res_kind)
807
            <- tcTyClTyVars tc_name
808
809
810
               $ \ binders res_kind ->
               do { inj' <- tcInjectivity binders inj
                  ; return (inj', binders, res_kind) }
811
812
813

       ; checkFamFlag tc_name -- make sure we have -XTypeFamilies

814
815
816
         -- If Nothing, this is an abstract family in a hs-boot file;
         -- but eqns might be empty in the Just case as well
       ; case mb_eqns of
817
           Nothing   ->
818
               return $ mkFamilyTyCon tc_name binders res_kind
819
820
821
                                      (resultVariableName sig)
                                      AbstractClosedSynFamilyTyCon parent
                                      inj'
822
823
           Just eqns -> do {

824
         -- Process the equations, creating CoAxBranches
825
       ; let fam_tc_shape = (tc_name, length $ hsQTvExplicit tvs, binders, res_kind)
Jan Stolarek's avatar
Jan Stolarek committed
826

827
       ; branches <- mapM (tcTyFamInstEqn fam_tc_shape Nothing) eqns
Jan Stolarek's avatar
Jan Stolarek committed
828
829
830
831
832
         -- Do not attempt to drop equations dominated by earlier
         -- ones here; in the case of mutual recursion with a data
         -- type, we get a knot-tying failure.  Instead we check
         -- for this afterwards, in TcValidity.checkValidCoAxiom
         -- Example: tc265
833

Jan Stolarek's avatar
Jan Stolarek committed
834
         -- Create a CoAxiom, with the correct src location. It is Vitally
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
835
836
837
838
839
840
         -- Important that we do not pass the branches into
         -- newFamInstAxiomName. They have types that have been zonked inside
         -- the knot and we will die if we look at them. This is OK here
         -- because there will only be one axiom, so we don't need to
         -- differentiate names.
         -- See [Zonking inside the knot] in TcHsType
841
       ; co_ax_name <- newFamInstAxiomName tc_lname []
842

843
       ; let mb_co_ax
Jan Stolarek's avatar
Jan Stolarek committed
844
845
846
              | null eqns = Nothing   -- mkBranchedCoAxiom fails on empty list
              | otherwise = Just (mkBranchedCoAxiom co_ax_name fam_tc branches)

847
             fam_tc = mkFamilyTyCon tc_name binders res_kind (resultVariableName sig)
848
                      (ClosedSynFamilyTyCon mb_co_ax) parent inj'
Jan Stolarek's avatar
Jan Stolarek committed
849

850
851
852
         -- We check for instance validity later, when doing validity
         -- checking for the tycon. Exception: checking equations
         -- overlap done by dropDominatedAxioms
853
       ; return fam_tc } }
854

855
  | otherwise = panic "tcFamInst1"  -- Silence pattern-exhaustiveness checker
856

857

Jan Stolarek's avatar
Jan Stolarek committed
858
859
-- | Maybe return a list of Bools that say whether a type family was declared
-- injective in the corresponding type arguments. Length of the list is equal to
860
861
-- the number of arguments (including implicit kind/coercion arguments).
-- True on position
Jan Stolarek's avatar
Jan Stolarek committed
862
863
-- N means that a function is injective in its Nth argument. False means it is
-- not.
864
tcInjectivity :: [TyConBinder] -> Maybe (LInjectivityAnn Name)
Jan Stolarek's avatar
Jan Stolarek committed
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
              -> TcM Injectivity
tcInjectivity _ Nothing
  = return NotInjective

  -- User provided an injectivity annotation, so for each tyvar argument we
  -- check whether a type family was declared injective in that argument. We
  -- return a list of Bools, where True means that corresponding type variable
  -- was mentioned in lInjNames (type family is injective in that argument) and
  -- False means that it was not mentioned in lInjNames (type family is not
  -- injective in that type variable). We also extend injectivity information to
  -- kind variables, so if a user declares:
  --
  --   type family F (a :: k1) (b :: k2) = (r :: k3) | r -> a
  --
  -- then we mark both `a` and `k1` as injective.
  -- NB: the return kind is considered to be *input* argument to a type family.
  -- Since injectivity allows to infer input arguments from the result in theory
  -- we should always mark the result kind variable (`k3` in this example) as
  -- injective.  The reason is that result type has always an assigned kind and
  -- therefore we can always infer the result kind if we know the result type.
  -- But this does not seem to be useful in any way so we don't do it.  (Another
  -- reason is that the implementation would not be straightforward.)
887
tcInjectivity tcbs (Just (L loc (InjectivityAnn _ lInjNames)))
Jan Stolarek's avatar
Jan Stolarek committed
888
  = setSrcSpan loc $
889
890
    do { let tvs = binderVars tcbs
       ; dflags <- getDynFlags
891
       ; checkTc (xopt LangExt.TypeFamilyDependencies dflags)
892
                 (text "Illegal injectivity annotation" $$
893
                  text "Use TypeFamilyDependencies to allow this")
894
       ; inj_tvs <- mapM (tcLookupTyVar . unLoc) lInjNames
895
       ; inj_tvs <- mapM zonkTcTyVarToTyVar inj_tvs -- zonk the kinds
896
897
       ; let inj_ktvs = filterVarSet isTyVar $  -- no injective coercion vars
                        closeOverKinds (mkVarSet inj_tvs)
Jan Stolarek's avatar
Jan Stolarek committed
898
899
900
901
902
       ; let inj_bools = map (`elemVarSet` inj_ktvs) tvs
       ; traceTc "tcInjectivity" (vcat [ ppr tvs, ppr lInjNames, ppr inj_tvs
                                       , ppr inj_ktvs, ppr inj_bools ])
       ; return $ Injective inj_bools }

Edward Z. Yang's avatar
Edward Z. Yang committed
903
tcTySynRhs :: RolesInfo
904
           -> Name
905
           -> [TyConBinder] -> Kind
906
           -> LHsType Name -> TcM TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
907
tcTySynRhs roles_info tc_name binders res_kind hs_ty
908
909
  = do { env <- getLclEnv
       ; traceTc "tc-syn" (ppr tc_name $$ ppr (tcl_env env))
910
       ; rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind
911
       ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty
Edward Z. Yang's avatar
Edward Z. Yang committed
912
       ; let roles = roles_info tc_name
913
             tycon = buildSynTyCon tc_name binders res_kind roles