TcHsType.hs 145 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5
\section[TcMonoType]{Typechecking user-specified @MonoTypes@}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

Richard Eisenberg's avatar
Richard Eisenberg committed
8
{-# LANGUAGE CPP, TupleSections, MultiWayIf, RankNTypes #-}
Ryan Scott's avatar
Ryan Scott committed
9
{-# LANGUAGE ScopedTypeVariables #-}
10
{-# LANGUAGE TypeApplications #-}
11
{-# LANGUAGE TypeFamilies #-}
12
{-# LANGUAGE ViewPatterns #-}
Ian Lynagh's avatar
Ian Lynagh committed
13

14 15
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

16
module TcHsType (
17
        -- Type signatures
18
        kcClassSigType, tcClassSigType,
19
        tcHsSigType, tcHsSigWcType,
20
        tcHsPartialSigType,
21
        tcStandaloneKindSig,
22
        funsSigCtxt, addSigCtxt, pprSigCtxt,
23 24

        tcHsClsInstType,
Ryan Scott's avatar
Ryan Scott committed
25
        tcHsDeriv, tcDerivStrategy,
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
26
        tcHsTypeApp,
27
        UserTypeCtxt(..),
28 29 30 31 32
        bindImplicitTKBndrs_Tv, bindImplicitTKBndrs_Skol,
            bindImplicitTKBndrs_Q_Tv, bindImplicitTKBndrs_Q_Skol,
        bindExplicitTKBndrs_Tv, bindExplicitTKBndrs_Skol,
            bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol,
        ContextKind(..),
33

34
                -- Type checking type and class decls
35 36
        kcLookupTcTyCon, bindTyClTyVars,
        etaExpandAlgTyCon, tcbVisibilities,
dreixel's avatar
dreixel committed
37

38
          -- tyvars
39
        zonkAndScopedSort,
40

41 42
        -- Kind-checking types
        -- No kind generalisation, no checkValidType
43 44 45
        InitialKindStrategy(..),
        SAKS_or_CUSK(..),
        kcDeclHeader,
46
        tcNamedWildCardBinders,
47 48
        tcHsLiftedType,   tcHsOpenType,
        tcHsLiftedTypeNC, tcHsOpenTypeNC,
Richard Eisenberg's avatar
Richard Eisenberg committed
49
        tcLHsType, tcLHsTypeUnsaturated, tcCheckLHsType,
50
        tcHsMbContext, tcHsContext, tcLHsPredType, tcInferApps,
51
        failIfEmitsConstraints,
52
        solveEqualities, -- useful re-export
batterseapower's avatar
batterseapower committed
53

54 55
        typeLevelMode, kindLevelMode,

56 57
        kindGeneralizeAll, kindGeneralizeSome, kindGeneralizeNone,
        checkExpectedKind_pp,
58

59
        -- Sort-checking kinds
60
        tcLHsKindSig, checkDataKindSig, DataSort(..),
61
        checkClassKindSig,
62

63
        -- Pattern type signatures
Tobias Dammers's avatar
Tobias Dammers committed
64 65 66 67
        tcHsPatSigType, tcPatSig,

        -- Error messages
        funAppCtxt, addTyConFlavCtxt
68 69 70 71
   ) where

#include "HsVersions.h"

72 73
import GhcPrelude

Sylvain Henry's avatar
Sylvain Henry committed
74
import GHC.Hs
75
import TcRnMonad
76 77 78
import TcOrigin
import Predicate
import Constraint
79
import TcEvidence
80 81
import TcEnv
import TcMType
82
import TcValidity
83
import TcUnify
84
import GHC.IfaceToCore
85
import TcSimplify
86
import TcHsSyn
87
import TyCoRep
88
import TyCoPpr
89
import TcErrors ( reportAllUnsolved )
90
import TcType
Simon Peyton Jones's avatar
Simon Peyton Jones committed
91
import Inst   ( tcInstInvisibleTyBinders, tcInstInvisibleTyBinder )
92
import Type
My Nguyen's avatar
My Nguyen committed
93
import TysPrim
94
import RdrName( lookupLocalRdrOcc )
95
import Var
96
import VarSet
97
import TyCon
cactus's avatar
cactus committed
98
import ConLike
99
import DataCon
100 101
import Class
import Name
102
-- import NameSet
103
import VarEnv
104 105 106
import TysWiredIn
import BasicTypes
import SrcLoc
107 108
import Constants ( mAX_CTUPLE_SIZE )
import ErrUtils( MsgDoc )
109
import Unique
110
import UniqSet
111
import Util
112
import UniqSupply
113
import Outputable
114
import FastString
115
import PrelNames hiding ( wildCardName )
116
import DynFlags
117
import qualified GHC.LanguageExtensions as LangExt
118

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
119
import Maybes
120
import Data.List ( find )
121
import Control.Monad
122

Austin Seipp's avatar
Austin Seipp committed
123
{-
124 125 126
        ----------------------------
                General notes
        ----------------------------
127

128 129 130 131 132
Unlike with expressions, type-checking types both does some checking and
desugars at the same time. This is necessary because we often want to perform
equality checks on the types right away, and it would be incredibly painful
to do this on un-desugared types. Luckily, desugared types are close enough
to HsTypes to make the error messages sane.
133

134 135 136
During type-checking, we perform as little validity checking as possible.
Generally, after type-checking, you will want to do validity checking, say
with TcValidity.checkValidType.
137 138 139

Validity checking
~~~~~~~~~~~~~~~~~
140
Some of the validity check could in principle be done by the kind checker,
141 142 143 144
but not all:

- During desugaring, we normalise by expanding type synonyms.  Only
  after this step can we check things like type-synonym saturation
145 146
  e.g.  type T k = k Int
        type S a = a
147 148 149 150 151 152
  Then (T S) is ok, because T is saturated; (T S) expands to (S Int);
  and then S is saturated.  This is a GHC extension.

- Similarly, also a GHC extension, we look through synonyms before complaining
  about the form of a class or instance declaration

153
- Ambiguity checks involve functional dependencies
154 155 156 157 158

Also, in a mutually recursive group of types, we can't look at the TyCon until we've
finished building the loop.  So to keep things simple, we postpone most validity
checking until step (3).

159 160
%************************************************************************
%*                                                                      *
161
              Check types AND do validity checking
Austin Seipp's avatar
Austin Seipp committed
162 163 164
*                                                                      *
************************************************************************
-}
165

166 167 168 169 170 171
funsSigCtxt :: [Located Name] -> UserTypeCtxt
-- Returns FunSigCtxt, with no redundant-context-reporting,
-- form a list of located names
funsSigCtxt (L _ name1 : _) = FunSigCtxt name1 False
funsSigCtxt []              = panic "funSigCtxt"

172
addSigCtxt :: UserTypeCtxt -> LHsType GhcRn -> TcM a -> TcM a
173 174 175
addSigCtxt ctxt hs_ty thing_inside
  = setSrcSpan (getLoc hs_ty) $
    addErrCtxt (pprSigCtxt ctxt hs_ty) $
176 177
    thing_inside

178
pprSigCtxt :: UserTypeCtxt -> LHsType GhcRn -> SDoc
179 180 181 182 183 184 185 186 187 188 189 190 191
-- (pprSigCtxt ctxt <extra> <type>)
-- prints    In the type signature for 'f':
--              f :: <type>
-- The <extra> is either empty or "the ambiguity check for"
pprSigCtxt ctxt hs_ty
  | Just n <- isSigMaybe ctxt
  = hang (text "In the type signature:")
       2 (pprPrefixOcc n <+> dcolon <+> ppr hs_ty)

  | otherwise
  = hang (text "In" <+> pprUserTypeCtxt ctxt <> colon)
       2 (ppr hs_ty)

192
tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type
193
-- This one is used when we have a LHsSigWcType, but in
194
-- a place where wildcards aren't allowed. The renamer has
Gabor Greif's avatar
Gabor Greif committed
195
-- already checked this, so we can simply ignore it.
196 197
tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty)

198 199 200 201 202 203 204 205 206 207 208 209 210
kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM ()
kcClassSigType skol_info names sig_ty
  = discardResult $
    tcClassSigType skol_info names sig_ty
  -- tcClassSigType does a fair amount of extra work that we don't need,
  -- such as ordering quantified variables. But we absolutely do need
  -- to push the level when checking method types and solve local equalities,
  -- and so it seems easier just to call tcClassSigType than selectively
  -- extract the lines of code from tc_hs_sig_type that we really need.
  -- If we don't push the level, we get #16517, where GHC accepts
  --   class C a where
  --     meth :: forall k. Proxy (a :: k) -> ()
  -- Note that k is local to meth -- this is hogwash.
211

212
tcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM Type
213
-- Does not do validity checking
214
tcClassSigType skol_info names sig_ty
215
  = addSigCtxt (funsSigCtxt names) (hsSigType sig_ty) $
216
    snd <$> tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind)
217 218 219
       -- Do not zonk-to-Type, nor perform a validity check
       -- We are in a knot with the class and associated types
       -- Zonking and validity checking is done by tcClassDecl
220 221 222 223 224 225 226 227 228 229 230 231
       -- No need to fail here if the type has an error:
       --   If we're in the kind-checking phase, the solveEqualities
       --     in kcTyClGroup catches the error
       --   If we're in the type-checking phase, the solveEqualities
       --     in tcClassDecl1 gets it
       -- Failing fast here degrades the error message in, e.g., tcfail135:
       --   class Foo f where
       --     baa :: f a -> f
       -- If we fail fast, we're told that f has kind `k1` when we wanted `*`.
       -- It should be that f has kind `k2 -> *`, but we never get a chance
       -- to run the solver where the kind of f is touchable. This is
       -- painfully delicate.
232

233
tcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type
234
-- Does validity checking
235
-- See Note [Recipe for checking a signature]
236 237
tcHsSigType ctxt sig_ty
  = addSigCtxt ctxt (hsSigType sig_ty) $
Simon Peyton Jones's avatar
Simon Peyton Jones committed
238
    do { traceTc "tcHsSigType {" (ppr sig_ty)
239

240
          -- Generalise here: see Note [Kind generalisation]
241 242
       ; (insol, ty) <- tc_hs_sig_type skol_info sig_ty
                                       (expectedKindInCtxt ctxt)
243
       ; ty <- zonkTcType ty
244

245 246 247
       ; when insol failM
       -- See Note [Fail fast if there are insoluble kind equalities] in TcSimplify

248
       ; checkValidType ctxt ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
249
       ; traceTc "end tcHsSigType }" (ppr ty)
250
       ; return ty }
251 252
  where
    skol_info = SigTypeSkol ctxt
253

254 255 256 257 258 259 260 261 262 263 264
-- Does validity checking and zonking.
tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind)
tcStandaloneKindSig (L _ kisig) = case kisig of
  StandaloneKindSig _ (L _ name) ksig ->
    let ctxt = StandaloneKindSigCtxt name in
    addSigCtxt ctxt (hsSigType ksig) $
    do { kind <- tcTopLHsType kindLevelMode ksig (expectedKindInCtxt ctxt)
       ; checkValidType ctxt kind
       ; return (name, kind) }
  XStandaloneKindSig nec -> noExtCon nec

265
tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn
266
               -> ContextKind -> TcM (Bool, TcType)
267 268 269
-- Kind-checks/desugars an 'LHsSigType',
--   solve equalities,
--   and then kind-generalizes.
270
-- This will never emit constraints, as it uses solveEqualities internally.
271
-- No validity checking or zonking
272 273
-- Returns also a Bool indicating whether the type induced an insoluble constraint;
-- True <=> constraint is insoluble
274 275 276 277 278 279 280 281 282 283 284 285 286
tc_hs_sig_type skol_info hs_sig_type ctxt_kind
  | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type
  = do { (tc_lvl, (wanted, (spec_tkvs, ty)))
              <- pushTcLevelM                           $
                 solveLocalEqualitiesX "tc_hs_sig_type" $
                 bindImplicitTKBndrs_Skol sig_vars      $
                 do { kind <- newExpectedKind ctxt_kind
                    ; tc_lhs_type typeLevelMode hs_ty kind }
       -- Any remaining variables (unsolved in the solveLocalEqualities)
       -- should be in the global tyvars, and therefore won't be quantified

       ; spec_tkvs <- zonkAndScopedSort spec_tkvs
       ; let ty1 = mkSpecForAllTys spec_tkvs ty
287 288 289 290 291 292 293 294 295

       -- This bit is very much like decideMonoTyVars in TcSimplify,
       -- but constraints are so much simpler in kinds, it is much
       -- easier here. (In particular, we never quantify over a
       -- constraint in a type.)
       ; constrained <- zonkTyCoVarsAndFV (tyCoVarsOfWC wanted)
       ; let should_gen = not . (`elemVarSet` constrained)

       ; kvs <- kindGeneralizeSome should_gen ty1
296 297 298
       ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs)
                                  tc_lvl wanted

299
       ; return (insolubleWC wanted, mkInvForAllTys kvs ty1) }
300

301
tc_hs_sig_type _ (XHsImplicitBndrs nec) _ = noExtCon nec
302

303
tcTopLHsType :: TcTyMode -> LHsSigType GhcRn -> ContextKind -> TcM Type
304 305 306 307 308
-- tcTopLHsType is used for kind-checking top-level HsType where
--   we want to fully solve /all/ equalities, and report errors
-- Does zonking, but not validity checking because it's used
--   for things (like deriving and instances) that aren't
--   ordinary types
309
tcTopLHsType mode hs_sig_type ctxt_kind
310 311 312 313 314 315 316
  | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type
  = do { traceTc "tcTopLHsType {" (ppr hs_ty)
       ; (spec_tkvs, ty)
              <- pushTcLevelM_                     $
                 solveEqualities                   $
                 bindImplicitTKBndrs_Skol sig_vars $
                 do { kind <- newExpectedKind ctxt_kind
317
                    ; tc_lhs_type mode hs_ty kind }
318 319 320

       ; spec_tkvs <- zonkAndScopedSort spec_tkvs
       ; let ty1 = mkSpecForAllTys spec_tkvs ty
321
       ; kvs <- kindGeneralizeAll ty1  -- "All" because it's a top-level type
322 323 324 325
       ; final_ty <- zonkTcTypeToType (mkInvForAllTys kvs ty1)
       ; traceTc "End tcTopLHsType }" (vcat [ppr hs_ty, ppr final_ty])
       ; return final_ty}

326
tcTopLHsType _ (XHsImplicitBndrs nec) _ = noExtCon nec
327

328
-----------------
329
tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Kind])
330
-- Like tcHsSigType, but for the ...deriving( C t1 ty2 ) clause
331
-- Returns the C, [ty1, ty2, and the kinds of C's remaining arguments
332 333
-- E.g.    class C (a::*) (b::k->k)
--         data T a b = ... deriving( C Int )
334
--    returns ([k], C, [k, Int], [k->k])
335
-- Return values are fully zonked
336
tcHsDeriv hs_ty
337 338
  = do { ty <- checkNoErrs $  -- Avoid redundant error report
                              -- with "illegal deriving", below
339
               tcTopLHsType typeLevelMode hs_ty AnyKind
340
       ; let (tvs, pred)    = splitForAllTys ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
341
             (kind_args, _) = splitFunTys (tcTypeKind pred)
342
       ; case getClassPredTys_maybe pred of
343
           Just (cls, tys) -> return (tvs, cls, tys, kind_args)
344
           Nothing -> failWithTc (text "Illegal deriving item" <+> quotes (ppr hs_ty)) }
345

346 347 348 349 350 351 352 353 354 355
-- | Typecheck a deriving strategy. For most deriving strategies, this is a
-- no-op, but for the @via@ strategy, this requires typechecking the @via@ type.
tcDerivStrategy ::
     Maybe (LDerivStrategy GhcRn)
     -- ^ The deriving strategy
  -> TcM (Maybe (LDerivStrategy GhcTc), [TyVar])
     -- ^ The typechecked deriving strategy and the tyvars that it binds
     -- (if using 'ViaStrategy').
tcDerivStrategy mb_lds
  = case mb_lds of
Ryan Scott's avatar
Ryan Scott committed
356
      Nothing -> boring_case Nothing
357
      Just (L loc ds) ->
358 359
        setSrcSpan loc $ do
          (ds', tvs) <- tc_deriv_strategy ds
360
          pure (Just (L loc ds'), tvs)
Ryan Scott's avatar
Ryan Scott committed
361 362
  where
    tc_deriv_strategy :: DerivStrategy GhcRn
363
                      -> TcM (DerivStrategy GhcTc, [TyVar])
Ryan Scott's avatar
Ryan Scott committed
364 365 366 367
    tc_deriv_strategy StockStrategy    = boring_case StockStrategy
    tc_deriv_strategy AnyclassStrategy = boring_case AnyclassStrategy
    tc_deriv_strategy NewtypeStrategy  = boring_case NewtypeStrategy
    tc_deriv_strategy (ViaStrategy ty) = do
368
      ty' <- checkNoErrs $ tcTopLHsType typeLevelMode ty AnyKind
Ryan Scott's avatar
Ryan Scott committed
369
      let (via_tvs, via_pred) = splitForAllTys ty'
370 371 372 373
      pure (ViaStrategy via_pred, via_tvs)

    boring_case :: ds -> TcM (ds, [TyVar])
    boring_case ds = pure (ds, [])
Ryan Scott's avatar
Ryan Scott committed
374

375
tcHsClsInstType :: UserTypeCtxt    -- InstDeclCtxt or SpecInstCtxt
376
                -> LHsSigType GhcRn
377
                -> TcM Type
378
-- Like tcHsSigType, but for a class instance declaration
379 380
tcHsClsInstType user_ctxt hs_inst_ty
  = setSrcSpan (getLoc (hsSigType hs_inst_ty)) $
381 382 383 384 385
    do { -- Fail eagerly if tcTopLHsType fails.  We are at top level so
         -- these constraints will never be solved later. And failing
         -- eagerly avoids follow-on errors when checkValidInstance
         -- sees an unsolved coercion hole
         inst_ty <- checkNoErrs $
386
                    tcTopLHsType typeLevelMode hs_inst_ty (TheKind constraintKind)
387 388
       ; checkValidInstance user_ctxt hs_inst_ty inst_ty
       ; return inst_ty }
389

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
390 391
----------------------------------------------
-- | Type-check a visible type application
392
tcHsTypeApp :: LHsWcType GhcRn -> Kind -> TcM Type
393
-- See Note [Recipe for checking a signature] in TcHsType
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
394
tcHsTypeApp wc_ty kind
395
  | HsWC { hswc_ext = sig_wcs, hswc_body = hs_ty } <- wc_ty
396
  = do { ty <- solveLocalEqualities "tcHsTypeApp" $
397 398
               -- We are looking at a user-written type, very like a
               -- signature so we want to solve its equalities right now
My Nguyen's avatar
My Nguyen committed
399 400 401
               unsetWOptM Opt_WarnPartialTypeSignatures $
               setXOptM LangExt.PartialTypeSignatures $
               -- See Note [Wildcards in visible type application]
402
               tcNamedWildCardBinders sig_wcs $ \ _ ->
403
               tcCheckLHsType hs_ty kind
404 405 406 407 408 409 410
       -- We do not kind-generalize type applications: we just
       -- instantiate with exactly what the user says.
       -- See Note [No generalization in type application]
       -- We still must call kindGeneralizeNone, though, according
       -- to Note [Recipe for checking a signature]
       ; kindGeneralizeNone ty
       ; ty <- zonkTcType ty
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
411 412
       ; checkValidType TypeAppCtxt ty
       ; return ty }
413
tcHsTypeApp (XHsWildCardBndrs nec) _ = noExtCon nec
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
414

My Nguyen's avatar
My Nguyen committed
415 416
{- Note [Wildcards in visible type application]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
417 418 419 420 421 422 423 424 425 426
A HsWildCardBndrs's hswc_ext now only includes /named/ wildcards, so
any unnamed wildcards stay unchanged in hswc_body.  When called in
tcHsTypeApp, tcCheckLHsType will call emitAnonWildCardHoleConstraint
on these anonymous wildcards. However, this would trigger
error/warning when an anonymous wildcard is passed in as a visible type
argument, which we do not want because users should be able to write
@_ to skip a instantiating a type variable variable without fuss. The
solution is to switch the PartialTypeSignatures flags here to let the
typechecker know that it's checking a '@_' and do not emit hole
constraints on it.  See related Note [Wildcards in visible kind
Sylvain Henry's avatar
Sylvain Henry committed
427
application] and Note [The wildcard story for types] in GHC.Hs.Types
428 429

Ugh!
430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445

Note [No generalization in type application]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We do not kind-generalize type applications. Imagine

  id @(Proxy Nothing)

If we kind-generalized, we would get

  id @(forall {k}. Proxy @(Maybe k) (Nothing @k))

which is very sneakily impredicative instantiation.

There is also the possibility of mentioning a wildcard
(`id @(Proxy _)`), which definitely should not be kind-generalized.

My Nguyen's avatar
My Nguyen committed
446 447
-}

Austin Seipp's avatar
Austin Seipp committed
448 449 450
{-
************************************************************************
*                                                                      *
451
            The main kind checker: no validity checks here
Richard Eisenberg's avatar
Richard Eisenberg committed
452 453
*                                                                      *
************************************************************************
Austin Seipp's avatar
Austin Seipp committed
454
-}
455

dreixel's avatar
dreixel committed
456
---------------------------
457
tcHsOpenType, tcHsLiftedType,
458
  tcHsOpenTypeNC, tcHsLiftedTypeNC :: LHsType GhcRn -> TcM TcType
459 460
-- Used for type signatures
-- Do not do validity checking
461 462 463
tcHsOpenType ty   = addTypeCtxt ty $ tcHsOpenTypeNC ty
tcHsLiftedType ty = addTypeCtxt ty $ tcHsLiftedTypeNC ty

464
tcHsOpenTypeNC   ty = do { ek <- newOpenTypeKind
465 466
                         ; tc_lhs_type typeLevelMode ty ek }
tcHsLiftedTypeNC ty = tc_lhs_type typeLevelMode ty liftedTypeKind
467 468

-- Like tcHsType, but takes an expected kind
469
tcCheckLHsType :: LHsType GhcRn -> Kind -> TcM TcType
470
tcCheckLHsType hs_ty exp_kind
471
  = addTypeCtxt hs_ty $
472
    tc_lhs_type typeLevelMode hs_ty exp_kind
473

474
tcLHsType :: LHsType GhcRn -> TcM (TcType, TcKind)
475
-- Called from outside: set the context
476
tcLHsType ty = addTypeCtxt ty (tc_infer_lhs_type typeLevelMode ty)
dreixel's avatar
dreixel committed
477

Richard Eisenberg's avatar
Richard Eisenberg committed
478 479 480
-- Like tcLHsType, but use it in a context where type synonyms and type families
-- do not need to be saturated, like in a GHCi :kind call
tcLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
481 482 483 484 485 486 487 488 489 490 491 492 493
tcLHsTypeUnsaturated hs_ty
  | Just (hs_fun_ty, hs_args) <- splitHsAppTys (unLoc hs_ty)
  = addTypeCtxt hs_ty $
    do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty
       ; tcInferApps_nosat mode hs_fun_ty fun_ty hs_args }
         -- Notice the 'nosat'; do not instantiate trailing
         -- invisible arguments of a type family.
         -- See Note [Dealing with :kind]

  | otherwise
  = addTypeCtxt hs_ty $
    tc_infer_lhs_type mode hs_ty

Richard Eisenberg's avatar
Richard Eisenberg committed
494
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
495 496 497 498 499 500 501 502 503 504 505 506
    mode = typeLevelMode

{- Note [Dealing with :kind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this GHCi command
  ghci> type family F :: Either j k
  ghci> :kind F
  F :: forall {j,k}. Either j k

We will only get the 'forall' if we /refrain/ from saturating those
invisible binders. But generally we /do/ saturate those invisible
binders (see tcInferApps), and we want to do so for nested application
507
even in GHCi.  Consider for example (#16287)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
508 509 510 511 512 513 514 515 516
  ghci> type family F :: k
  ghci> data T :: (forall k. k) -> Type
  ghci> :kind T F
We want to reject this. It's just at the very top level that we want
to switch off saturation.

So tcLHsTypeUnsaturated does a little special case for top level
applications.  Actually the common case is a bare variable, as above.

Richard Eisenberg's avatar
Richard Eisenberg committed
517

518 519 520 521 522 523 524 525 526 527 528 529
************************************************************************
*                                                                      *
      Type-checking modes
*                                                                      *
************************************************************************

The kind-checker is parameterised by a TcTyMode, which contains some
information about where we're checking a type.

The renamer issues errors about what it can. All errors issued here must
concern things that the renamer can't handle.

Austin Seipp's avatar
Austin Seipp committed
530
-}
531

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
532 533 534 535
-- | Info about the context in which we're checking a type. Currently,
-- differentiates only between types and kinds, but this will likely
-- grow, at least to include the distinction between patterns and
-- not-patterns.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
536 537 538
--
-- To find out where the mode is used, search for 'mode_level'
data TcTyMode = TcTyMode { mode_level :: TypeOrKind }
539 540

typeLevelMode :: TcTyMode
Simon Peyton Jones's avatar
Simon Peyton Jones committed
541
typeLevelMode = TcTyMode { mode_level = TypeLevel }
542 543

kindLevelMode :: TcTyMode
Simon Peyton Jones's avatar
Simon Peyton Jones committed
544
kindLevelMode = TcTyMode { mode_level = KindLevel }
545 546 547 548 549

-- switch to kind level
kindLevel :: TcTyMode -> TcTyMode
kindLevel mode = mode { mode_level = KindLevel }

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
550 551 552
instance Outputable TcTyMode where
  ppr = ppr . mode_level

553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570
{-
Note [Bidirectional type checking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In expressions, whenever we see a polymorphic identifier, say `id`, we are
free to instantiate it with metavariables, knowing that we can always
re-generalize with type-lambdas when necessary. For example:

  rank2 :: (forall a. a -> a) -> ()
  x = rank2 id

When checking the body of `x`, we can instantiate `id` with a metavariable.
Then, when we're checking the application of `rank2`, we notice that we really
need a polymorphic `id`, and then re-generalize over the unconstrained
metavariable.

In types, however, we're not so lucky, because *we cannot re-generalize*!
There is no lambda. So, we must be careful only to instantiate at the last
possible moment, when we're sure we're never going to want the lost polymorphism
Simon Peyton Jones's avatar
Simon Peyton Jones committed
571
again. This is done in calls to tcInstInvisibleTyBinders.
572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596

To implement this behavior, we use bidirectional type checking, where we
explicitly think about whether we know the kind of the type we're checking
or not. Note that there is a difference between not knowing a kind and
knowing a metavariable kind: the metavariables are TauTvs, and cannot become
forall-quantified kinds. Previously (before dependent types), there were
no higher-rank kinds, and so we could instantiate early and be sure that
no types would have polymorphic kinds, and so we could always assume that
the kind of a type was a fresh metavariable. Not so anymore, thus the
need for two algorithms.

For HsType forms that can never be kind-polymorphic, we implement only the
"down" direction, where we safely assume a metavariable kind. For HsType forms
that *can* be kind-polymorphic, we implement just the "up" (functions with
"infer" in their name) version, as we gain nothing by also implementing the
"down" version.

Note [Future-proofing the type checker]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As discussed in Note [Bidirectional type checking], each HsType form is
handled in *either* tc_infer_hs_type *or* tc_hs_type. These functions
are mutually recursive, so that either one can work for any type former.
But, we want to make sure that our pattern-matches are complete. So,
we have a bunch of repetitive code just so that we get warnings if we're
missing any patterns.
597

598
-}
599

600
------------------------------------------
601 602 603
-- | Check and desugar a type, returning the core type and its
-- possibly-polymorphic kind. Much like 'tcInferRho' at the expression
-- level.
604
tc_infer_lhs_type :: TcTyMode -> LHsType GhcRn -> TcM (TcType, TcKind)
605 606
tc_infer_lhs_type mode (L span ty)
  = setSrcSpan span $
Simon Peyton Jones's avatar
Simon Peyton Jones committed
607
    tc_infer_hs_type mode ty
608

Simon Peyton Jones's avatar
Simon Peyton Jones committed
609 610 611 612 613 614 615 616
---------------------------
-- | Call 'tc_infer_hs_type' and check its result against an expected kind.
tc_infer_hs_type_ek :: HasDebugCallStack => TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType
tc_infer_hs_type_ek mode hs_ty ek
  = do { (ty, k) <- tc_infer_hs_type mode hs_ty
       ; checkExpectedKind hs_ty ty k ek }

---------------------------
617 618
-- | Infer the kind of a type and desugar. This is the "up" type-checker,
-- as described in Note [Bidirectional type checking]
619
tc_infer_hs_type :: TcTyMode -> HsType GhcRn -> TcM (TcType, TcKind)
620

Simon Peyton Jones's avatar
Simon Peyton Jones committed
621 622
tc_infer_hs_type mode (HsParTy _ t)
  = tc_infer_lhs_type mode t
623

Simon Peyton Jones's avatar
Simon Peyton Jones committed
624 625 626 627
tc_infer_hs_type mode ty
  | Just (hs_fun_ty, hs_args) <- splitHsAppTys ty
  = do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty
       ; tcInferApps mode hs_fun_ty fun_ty hs_args }
628

629
tc_infer_hs_type mode (HsKindSig _ ty sig)
630
  = do { sig' <- tcLHsKindSig KindSigCtxt sig
631
                 -- We must typecheck the kind signature, and solve all
632 633
                 -- its equalities etc; from this point on we may do
                 -- things like instantiate its foralls, so it needs
634
                 -- to be fully determined (#14904)
635
       ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr sig')
636 637
       ; ty' <- tc_lhs_type mode ty sig'
       ; return (ty', sig') }
638

639
-- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceType' to communicate
640 641 642 643 644
-- the splice location to the typechecker. Here we skip over it in order to have
-- the same kind inferred for a given expression whether it was produced from
-- splices or not.
--
-- See Note [Delaying modFinalizers in untyped splices].
645
tc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)))
646
  = tc_infer_hs_type mode ty
647

648
tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty
649
tc_infer_hs_type _    (XHsType (NHsCoreTy ty))
Simon Peyton Jones's avatar
Simon Peyton Jones committed
650
  = return (ty, tcTypeKind ty)
My Nguyen's avatar
My Nguyen committed
651 652 653 654 655 656 657

tc_infer_hs_type _ (HsExplicitListTy _ _ tys)
  | null tys  -- this is so that we can use visible kind application with '[]
              -- e.g ... '[] @Bool
  = return (mkTyConTy promotedNilDataCon,
            mkSpecForAllTys [alphaTyVar] $ mkListTy alphaTy)

658 659 660 661 662
tc_infer_hs_type mode other_ty
  = do { kv <- newMetaKindVar
       ; ty' <- tc_hs_type mode other_ty kv
       ; return (ty', kv) }

663
------------------------------------------
664
tc_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType
665
tc_lhs_type mode (L span ty) exp_kind
666
  = setSrcSpan span $
667
    tc_hs_type mode ty exp_kind
668

669
tc_hs_type :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType
670 671
-- See Note [Bidirectional type checking]

672 673 674
tc_hs_type mode (HsParTy _ ty)   exp_kind = tc_lhs_type mode ty exp_kind
tc_hs_type mode (HsDocTy _ ty _) exp_kind = tc_lhs_type mode ty exp_kind
tc_hs_type _ ty@(HsBangTy _ bang _) _
675 676
    -- While top-level bangs at this point are eliminated (eg !(Maybe Int)),
    -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of
677 678 679 680 681 682 683 684 685
    -- bangs are invalid, so fail. (#7210, #14761)
    = do { let bangError err = failWith $
                 text "Unexpected" <+> text err <+> text "annotation:" <+> ppr ty $$
                 text err <+> text "annotation cannot appear nested inside a type"
         ; case bang of
             HsSrcBang _ SrcUnpack _           -> bangError "UNPACK"
             HsSrcBang _ SrcNoUnpack _         -> bangError "NOUNPACK"
             HsSrcBang _ NoSrcUnpack SrcLazy   -> bangError "laziness"
             HsSrcBang _ _ _                   -> bangError "strictness" }
686
tc_hs_type _ ty@(HsRecTy {})      _
687
      -- Record types (which only show up temporarily in constructor
688
      -- signatures) should have been removed by now
689
    = failWithTc (text "Record syntax is illegal here:" <+> ppr ty)
690

691
-- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceType'.
692 693 694 695
-- Here we get rid of it and add the finalizers to the global environment
-- while capturing the local environment.
--
-- See Note [Delaying modFinalizers in untyped splices].
696
tc_hs_type mode (HsSpliceTy _ (HsSpliced _ mod_finalizers (HsSplicedTy ty)))
697 698 699 700
           exp_kind
  = do addModFinalizersWithLclEnv mod_finalizers
       tc_hs_type mode ty exp_kind

701 702
-- This should never happen; type splices are expanded by the renamer
tc_hs_type _ ty@(HsSpliceTy {}) _exp_kind
703
  = failWithTc (text "Unexpected type splice:" <+> ppr ty)
704

705
---------- Functions and applications
706
tc_hs_type mode (HsFunTy _ ty1 ty2) exp_kind
707
  = tc_fun_type mode ty1 ty2 exp_kind
708

709
tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind
710
  | op `hasKey` funTyConKey
711
  = tc_fun_type mode ty1 ty2 exp_kind
712 713

--------- Foralls
Ryan Scott's avatar
Ryan Scott committed
714 715
tc_hs_type mode forall@(HsForAllTy { hst_fvf = fvf, hst_bndrs = hs_tvs
                                   , hst_body = ty }) exp_kind
716 717 718 719
  = do { (tclvl, wanted, (tvs', ty'))
            <- pushLevelAndCaptureConstraints $
               bindExplicitTKBndrs_Skol hs_tvs $
               tc_lhs_type mode ty exp_kind
720
    -- Do not kind-generalise here!  See Note [Kind generalisation]
721
    -- Why exp_kind?  See Note [Body kind of HsForAllTy]
Ryan Scott's avatar
Ryan Scott committed
722 723 724 725
       ; let argf        = case fvf of
                             ForallVis   -> Required
                             ForallInvis -> Specified
             bndrs       = mkTyVarBinders argf tvs'
726 727 728 729 730
             skol_info   = ForAllSkol (ppr forall)
             m_telescope = Just (sep (map ppr hs_tvs))

       ; emitResidualTvConstraint skol_info m_telescope tvs' tclvl wanted

731
       ; return (mkForAllTys bndrs ty') }
732

Simon Peyton Jones's avatar
Simon Peyton Jones committed
733
tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind
734
  | null (unLoc ctxt)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
735
  = tc_lhs_type mode rn_ty exp_kind
736

Simon Peyton Jones's avatar
Simon Peyton Jones committed
737 738
  -- See Note [Body kind of a HsQualTy]
  | tcIsConstraintKind exp_kind
739
  = do { ctxt' <- tc_hs_context mode ctxt
Simon Peyton Jones's avatar
Simon Peyton Jones committed
740 741
       ; ty'   <- tc_lhs_type mode rn_ty constraintKind
       ; return (mkPhiTy ctxt' ty') }
742

Simon Peyton Jones's avatar
Simon Peyton Jones committed
743 744
  | otherwise
  = do { ctxt' <- tc_hs_context mode ctxt
745

Simon Peyton Jones's avatar
Simon Peyton Jones committed
746 747 748 749 750
       ; ek <- newOpenTypeKind  -- The body kind (result of the function) can
                                -- be TYPE r, for any r, hence newOpenTypeKind
       ; ty' <- tc_lhs_type mode rn_ty ek
       ; checkExpectedKind (unLoc rn_ty) (mkPhiTy ctxt' ty')
                           liftedTypeKind exp_kind }
751 752

--------- Lists, arrays, and tuples
753
tc_hs_type mode rn_ty@(HsListTy _ elt_ty) exp_kind
754
  = do { tau_ty <- tc_lhs_type mode elt_ty liftedTypeKind
755
       ; checkWiredInTyCon listTyCon
Simon Peyton Jones's avatar
Simon Peyton Jones committed
756
       ; checkExpectedKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind }
757

Sylvain Henry's avatar
Sylvain Henry committed
758
-- See Note [Distinguishing tuple kinds] in GHC.Hs.Types
759
-- See Note [Inferring tuple kinds]
760
tc_hs_type mode rn_ty@(HsTupleTy _ HsBoxedOrConstraintTuple hs_tys) exp_kind
761
     -- (NB: not zonking before looking at exp_k, to avoid left-right bias)
762
  | Just tup_sort <- tupKindSort_maybe exp_kind
763
  = traceTc "tc_hs_type tuple" (ppr hs_tys) >>
764
    tc_tuple rn_ty mode tup_sort hs_tys exp_kind
dreixel's avatar
dreixel committed
765
  | otherwise
Austin Seipp's avatar
Austin Seipp committed
766
  = do { traceTc "tc_hs_type tuple 2" (ppr hs_tys)
767 768
       ; (tys, kinds) <- mapAndUnzipM (tc_infer_lhs_type mode) hs_tys
       ; kinds <- mapM zonkTcType kinds
769
           -- Infer each arg type separately, because errors can be
770
           -- confusing if we give them a shared kind.  Eg #7410
771 772 773 774
           -- (Either Int, Int), we do not want to get an error saying
           -- "the second argument of a tuple should have kind *->*"

       ; let (arg_kind, tup_sort)
775 776 777
               = case [ (k,s) | k <- kinds
                              , Just s <- [tupKindSort_maybe k] ] of
                    ((k,s) : _) -> (k,s)
778
                    [] -> (liftedTypeKind, BoxedTuple)
779 780
         -- In the [] case, it's not clear what the kind is, so guess *

781
       ; tys' <- sequence [ setSrcSpan loc $
Simon Peyton Jones's avatar
Simon Peyton Jones committed
782
                            checkExpectedKind hs_ty ty kind arg_kind
783
                          | ((L loc hs_ty),ty,kind) <- zip3 hs_tys tys kinds ]
784

Simon Peyton Jones's avatar
Simon Peyton Jones committed
785
       ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind }
786

dreixel's avatar
dreixel committed
787

788
tc_hs_type mode rn_ty@(HsTupleTy _ hs_tup_sort tys) exp_kind
789
  = tc_tuple rn_ty mode tup_sort tys exp_kind
790 791 792 793 794 795 796
  where
    tup_sort = case hs_tup_sort of  -- Fourth case dealt with above
                  HsUnboxedTuple    -> UnboxedTuple
                  HsBoxedTuple      -> BoxedTuple
                  HsConstraintTuple -> ConstraintTuple
                  _                 -> panic "tc_hs_type HsTupleTy"

797
tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind
798
  = do { let arity = length hs_tys
799 800
       ; arg_kinds <- mapM (\_ -> newOpenTypeKind) hs_tys
       ; tau_tys   <- zipWithM (tc_lhs_type mode) hs_tys arg_kinds
801
       ; let arg_reps = map kindRep arg_kinds
Richard Eisenberg's avatar
Richard Eisenberg committed
802
             arg_tys  = arg_reps ++ tau_tys
Simon Peyton Jones's avatar
Simon Peyton Jones committed
803 804 805
             sum_ty   = mkTyConApp (sumTyCon arity) arg_tys
             sum_kind = unboxedSumKind arg_reps
       ; checkExpectedKind rn_ty sum_ty sum_kind exp_kind
806
       }
dreixel's avatar
dreixel committed
807

808
--------- Promoted lists and tuples
809
tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind
810
  = do { tks <- mapM (tc_infer_lhs_type mode) tys
811
       ; (taus', kind) <- unifyKinds tys tks
812
       ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus')
Simon Peyton Jones's avatar
Simon Peyton Jones committed
813
       ; checkExpectedKind rn_ty ty (mkListTy kind) exp_kind }
814
  where
815 816
    mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b]
    mk_nil  k     = mkTyConApp (promoteDataCon nilDataCon) [k]
817

818
tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
819 820 821 822 823 824
  -- using newMetaKindVar means that we force instantiations of any polykinded
  -- types. At first, I just used tc_infer_lhs_type, but that led to #11255.
  = do { ks   <- replicateM arity newMetaKindVar
       ; taus <- zipWithM (tc_lhs_type mode) tys ks
       ; let kind_con   = tupleTyCon           Boxed arity
             ty_con     = promotedTupleDataCon Boxed arity
825
             tup_k      = mkTyConApp kind_con ks
Simon Peyton Jones's avatar
Simon Peyton Jones committed
826
       ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind }
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
827 828
  where
    arity = length tys
829 830

--------- Constraint types
831
tc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind
832 833
  = do { MASSERT( isTypeLevel (mode_level mode) )
       ; ty' <- tc_lhs_type mode ty liftedTypeKind
834
       ; let n' = mkStrLitTy $ hsIPNameFS n
835
       ; ipClass <- tcLookupClass ipClassName
Simon Peyton Jones's avatar
Simon Peyton Jones committed
836 837
       ; checkExpectedKind rn_ty (mkClassPred ipClass [n',ty'])
                           constraintKind exp_kind }
838

Simon Peyton Jones's avatar
Simon Peyton Jones committed
839
tc_hs_type _ rn_ty@(HsStarTy _ _) exp_kind
840 841
  -- Desugaring 'HsStarTy' to 'Data.Kind.Type' here means that we don't have to
  -- handle it in 'coreView' and 'tcView'.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
842
  = checkExpectedKind rn_ty liftedTypeKind liftedTypeKind exp_kind
843

844
--------- Literals
Simon Peyton Jones's avatar
Simon Peyton Jones committed
845
tc_hs_type _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind
846
  = do { checkWiredInTyCon typeNatKindCon
Simon Peyton Jones's avatar
Simon Peyton Jones committed
847
       ; checkExpectedKind rn_ty (mkNumLitTy n) typeNatKind exp_kind }
848

Simon Peyton Jones's avatar
Simon Peyton Jones committed
849
tc_hs_type _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind
850
  = do { checkWiredInTyCon typeSymbolKindCon
Simon Peyton Jones's avatar
Simon Peyton Jones committed
851
       ; checkExpectedKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind }
852 853 854

--------- Potentially kind-polymorphic types: call the "up" checker
-- See Note [Future-proofing the type checker]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
855 856 857 858 859
tc_hs_type mode ty@(HsTyVar {})            ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(HsAppTy {})            ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(HsAppKindTy{})         ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(HsOpTy {})             ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(HsKindSig {})          ek = tc_infer_hs_type_ek mode ty ek
860
tc_hs_type mode ty@(XHsType (NHsCoreTy{})) ek = tc_infer_hs_type_ek mode ty ek
861
tc_hs_type _    wc@(HsWildCardTy _)        ek = tcAnonWildCardOcc wc ek
862

Simon Peyton Jones's avatar
Simon Peyton Jones committed
863 864 865 866 867 868 869 870 871
------------------------------------------
tc_fun_type :: TcTyMode -> LHsType GhcRn -> LHsType GhcRn -> TcKind
            -> TcM TcType
tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of
  TypeLevel ->
    do { arg_k <- newOpenTypeKind
       ; res_k <- newOpenTypeKind
       ; ty1' <- tc_lhs_type mode ty1 arg_k
       ; ty2' <- tc_lhs_type mode ty2 res_k
872
       ; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2')
Simon Peyton Jones's avatar
Simon Peyton Jones committed
873 874 875 876
                           liftedTypeKind exp_kind }
  KindLevel ->  -- no representation polymorphism in kinds. yet.
    do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind
       ; ty2' <- tc_lhs_type mode ty2 liftedTypeKind
877
       ; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2')
Simon Peyton Jones's avatar
Simon Peyton Jones committed