ebd531ec1370a2c52a202b4a00574328dd008998
[ghc.git] / compiler / typecheck / TcMType.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 Monadic type operations
7
8 This module contains monadic operations over types that contain
9 mutable type variables.
10 -}
11
12 {-# LANGUAGE CPP, TupleSections, MultiWayIf #-}
13
14 module TcMType (
15 TcTyVar, TcKind, TcType, TcTauType, TcThetaType, TcTyVarSet,
16
17 --------------------------------
18 -- Creating new mutable type variables
19 newFlexiTyVar,
20 newFlexiTyVarTy, -- Kind -> TcM TcType
21 newFlexiTyVarTys, -- Int -> Kind -> TcM [TcType]
22 newOpenFlexiTyVarTy, newOpenTypeKind,
23 newMetaKindVar, newMetaKindVars, newMetaTyVarTyAtLevel,
24 cloneMetaTyVar,
25 newFmvTyVar, newFskTyVar,
26
27 readMetaTyVar, writeMetaTyVar, writeMetaTyVarRef,
28 newMetaDetails, isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar,
29
30 --------------------------------
31 -- Expected types
32 ExpType(..), ExpSigmaType, ExpRhoType,
33 mkCheckExpType,
34 newInferExpType, newInferExpTypeInst, newInferExpTypeNoInst,
35 readExpType, readExpType_maybe,
36 expTypeToType, checkingExpType_maybe, checkingExpType,
37 tauifyExpType, inferResultToType,
38
39 --------------------------------
40 -- Creating new evidence variables
41 newEvVar, newEvVars, newDict,
42 newWanted, newWanteds, newHoleCt, cloneWanted, cloneWC,
43 emitWanted, emitWantedEq, emitWantedEvVar, emitWantedEvVars,
44 emitDerivedEqs,
45 newTcEvBinds, newNoTcEvBinds, addTcEvBind,
46
47 newCoercionHole, fillCoercionHole, isFilledCoercionHole,
48 unpackCoercionHole, unpackCoercionHole_maybe,
49 checkCoercionHole,
50
51 --------------------------------
52 -- Instantiation
53 newMetaTyVars, newMetaTyVarX, newMetaTyVarsX,
54 newMetaTyVarTyVars, newMetaTyVarTyVarX,
55 newTyVarTyVar, newPatSigTyVar, newSkolemTyVar, newWildCardX,
56 tcInstType,
57 tcInstSkolTyVars, tcInstSkolTyVarsX, tcInstSkolTyVarsAt,
58 tcSkolDFunType, tcSuperSkolTyVars, tcInstSuperSkolTyVarsX,
59
60 freshenTyVarBndrs, freshenCoVarBndrsX,
61
62 --------------------------------
63 -- Zonking and tidying
64 zonkTidyTcType, zonkTidyTcTypes, zonkTidyOrigin,
65 tidyEvVar, tidyCt, tidySkolemInfo,
66 zonkTcTyVar, zonkTcTyVars,
67 zonkTcTyVarToTyVar, zonkTyVarTyVarPairs,
68 zonkTyCoVarsAndFV, zonkTcTypeAndFV, zonkDTyCoVarSetAndFV,
69 zonkTyCoVarsAndFVList,
70 candidateQTyVarsOfType, candidateQTyVarsOfKind,
71 candidateQTyVarsOfTypes, candidateQTyVarsOfKinds,
72 CandidatesQTvs(..), delCandidates, candidateKindVars, partitionCandidates,
73 zonkAndSkolemise, skolemiseQuantifiedTyVar,
74 defaultTyVar, quantifyTyVars, isQuantifiableTv,
75 zonkTcType, zonkTcTypes, zonkCo,
76 zonkTyCoVarKind,
77
78 zonkEvVar, zonkWC, zonkSimples,
79 zonkId, zonkCoVar,
80 zonkCt, zonkSkolemInfo,
81
82 skolemiseUnboundMetaTyVar,
83
84 ------------------------------
85 -- Levity polymorphism
86 ensureNotLevPoly, checkForLevPoly, checkForLevPolyX, formatLevPolyErr
87 ) where
88
89 #include "HsVersions.h"
90
91 -- friends:
92 import GhcPrelude
93
94 import TyCoRep
95 import TcType
96 import Type
97 import TyCon
98 import Coercion
99 import Class
100 import Var
101
102 -- others:
103 import TcRnMonad -- TcType, amongst others
104 import TcEvidence
105 import Id
106 import Name
107 import VarSet
108 import TysWiredIn
109 import TysPrim
110 import VarEnv
111 import NameEnv
112 import PrelNames
113 import Util
114 import Outputable
115 import FastString
116 import Bag
117 import Pair
118 import UniqSet
119 import qualified GHC.LanguageExtensions as LangExt
120
121 import Control.Monad
122 import Maybes
123 import Data.List ( mapAccumL )
124 import Control.Arrow ( second )
125 import qualified Data.Semigroup as Semi
126
127 {-
128 ************************************************************************
129 * *
130 Kind variables
131 * *
132 ************************************************************************
133 -}
134
135 mkKindName :: Unique -> Name
136 mkKindName unique = mkSystemName unique kind_var_occ
137
138 kind_var_occ :: OccName -- Just one for all MetaKindVars
139 -- They may be jiggled by tidying
140 kind_var_occ = mkOccName tvName "k"
141
142 newMetaKindVar :: TcM TcKind
143 newMetaKindVar
144 = do { details <- newMetaDetails TauTv
145 ; uniq <- newUnique
146 ; let kv = mkTcTyVar (mkKindName uniq) liftedTypeKind details
147 ; traceTc "newMetaKindVar" (ppr kv)
148 ; return (mkTyVarTy kv) }
149
150 newMetaKindVars :: Int -> TcM [TcKind]
151 newMetaKindVars n = replicateM n newMetaKindVar
152
153 {-
154 ************************************************************************
155 * *
156 Evidence variables; range over constraints we can abstract over
157 * *
158 ************************************************************************
159 -}
160
161 newEvVars :: TcThetaType -> TcM [EvVar]
162 newEvVars theta = mapM newEvVar theta
163
164 --------------
165
166 newEvVar :: TcPredType -> TcRnIf gbl lcl EvVar
167 -- Creates new *rigid* variables for predicates
168 newEvVar ty = do { name <- newSysName (predTypeOccName ty)
169 ; return (mkLocalIdOrCoVar name ty) }
170
171 newWanted :: CtOrigin -> Maybe TypeOrKind -> PredType -> TcM CtEvidence
172 -- Deals with both equality and non-equality predicates
173 newWanted orig t_or_k pty
174 = do loc <- getCtLocM orig t_or_k
175 d <- if isEqPrimPred pty then HoleDest <$> newCoercionHole pty
176 else EvVarDest <$> newEvVar pty
177 return $ CtWanted { ctev_dest = d
178 , ctev_pred = pty
179 , ctev_nosh = WDeriv
180 , ctev_loc = loc }
181
182 newWanteds :: CtOrigin -> ThetaType -> TcM [CtEvidence]
183 newWanteds orig = mapM (newWanted orig Nothing)
184
185 -- | Create a new 'CHoleCan' 'Ct'.
186 newHoleCt :: HoleSort -> Id -> Type -> TcM Ct
187 newHoleCt hole ev ty = do
188 loc <- getCtLocM HoleOrigin Nothing
189 pure $ CHoleCan { cc_ev = CtWanted { ctev_pred = ty
190 , ctev_dest = EvVarDest ev
191 , ctev_nosh = WDeriv
192 , ctev_loc = loc }
193 , cc_occ = getOccName ev
194 , cc_hole = hole }
195
196 ----------------------------------------------
197 -- Cloning constraints
198 ----------------------------------------------
199
200 cloneWanted :: Ct -> TcM Ct
201 cloneWanted ct
202 | ev@(CtWanted { ctev_dest = HoleDest {}, ctev_pred = pty }) <- ctEvidence ct
203 = do { co_hole <- newCoercionHole pty
204 ; return (mkNonCanonical (ev { ctev_dest = HoleDest co_hole })) }
205 | otherwise
206 = return ct
207
208 cloneWC :: WantedConstraints -> TcM WantedConstraints
209 -- Clone all the evidence bindings in
210 -- a) the ic_bind field of any implications
211 -- b) the CoercionHoles of any wanted constraints
212 -- so that solving the WantedConstraints will not have any visible side
213 -- effect, /except/ from causing unifications
214 cloneWC wc@(WC { wc_simple = simples, wc_impl = implics })
215 = do { simples' <- mapBagM cloneWanted simples
216 ; implics' <- mapBagM cloneImplication implics
217 ; return (wc { wc_simple = simples', wc_impl = implics' }) }
218
219 cloneImplication :: Implication -> TcM Implication
220 cloneImplication implic@(Implic { ic_binds = binds, ic_wanted = inner_wanted })
221 = do { binds' <- cloneEvBindsVar binds
222 ; inner_wanted' <- cloneWC inner_wanted
223 ; return (implic { ic_binds = binds', ic_wanted = inner_wanted' }) }
224
225 ----------------------------------------------
226 -- Emitting constraints
227 ----------------------------------------------
228
229 -- | Emits a new Wanted. Deals with both equalities and non-equalities.
230 emitWanted :: CtOrigin -> TcPredType -> TcM EvTerm
231 emitWanted origin pty
232 = do { ev <- newWanted origin Nothing pty
233 ; emitSimple $ mkNonCanonical ev
234 ; return $ ctEvTerm ev }
235
236 emitDerivedEqs :: CtOrigin -> [(TcType,TcType)] -> TcM ()
237 -- Emit some new derived nominal equalities
238 emitDerivedEqs origin pairs
239 | null pairs
240 = return ()
241 | otherwise
242 = do { loc <- getCtLocM origin Nothing
243 ; emitSimples (listToBag (map (mk_one loc) pairs)) }
244 where
245 mk_one loc (ty1, ty2)
246 = mkNonCanonical $
247 CtDerived { ctev_pred = mkPrimEqPred ty1 ty2
248 , ctev_loc = loc }
249
250 -- | Emits a new equality constraint
251 emitWantedEq :: CtOrigin -> TypeOrKind -> Role -> TcType -> TcType -> TcM Coercion
252 emitWantedEq origin t_or_k role ty1 ty2
253 = do { hole <- newCoercionHole pty
254 ; loc <- getCtLocM origin (Just t_or_k)
255 ; emitSimple $ mkNonCanonical $
256 CtWanted { ctev_pred = pty, ctev_dest = HoleDest hole
257 , ctev_nosh = WDeriv, ctev_loc = loc }
258 ; return (HoleCo hole) }
259 where
260 pty = mkPrimEqPredRole role ty1 ty2
261
262 -- | Creates a new EvVar and immediately emits it as a Wanted.
263 -- No equality predicates here.
264 emitWantedEvVar :: CtOrigin -> TcPredType -> TcM EvVar
265 emitWantedEvVar origin ty
266 = do { new_cv <- newEvVar ty
267 ; loc <- getCtLocM origin Nothing
268 ; let ctev = CtWanted { ctev_dest = EvVarDest new_cv
269 , ctev_pred = ty
270 , ctev_nosh = WDeriv
271 , ctev_loc = loc }
272 ; emitSimple $ mkNonCanonical ctev
273 ; return new_cv }
274
275 emitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar]
276 emitWantedEvVars orig = mapM (emitWantedEvVar orig)
277
278 newDict :: Class -> [TcType] -> TcM DictId
279 newDict cls tys
280 = do { name <- newSysName (mkDictOcc (getOccName cls))
281 ; return (mkLocalId name (mkClassPred cls tys)) }
282
283 predTypeOccName :: PredType -> OccName
284 predTypeOccName ty = case classifyPredType ty of
285 ClassPred cls _ -> mkDictOcc (getOccName cls)
286 EqPred {} -> mkVarOccFS (fsLit "co")
287 IrredPred {} -> mkVarOccFS (fsLit "irred")
288 ForAllPred {} -> mkVarOccFS (fsLit "df")
289
290 {-
291 ************************************************************************
292 * *
293 Coercion holes
294 * *
295 ************************************************************************
296 -}
297
298 newCoercionHole :: TcPredType -> TcM CoercionHole
299 newCoercionHole pred_ty
300 = do { co_var <- newEvVar pred_ty
301 ; traceTc "New coercion hole:" (ppr co_var)
302 ; ref <- newMutVar Nothing
303 ; return $ CoercionHole { ch_co_var = co_var, ch_ref = ref } }
304
305 -- | Put a value in a coercion hole
306 fillCoercionHole :: CoercionHole -> Coercion -> TcM ()
307 fillCoercionHole (CoercionHole { ch_ref = ref, ch_co_var = cv }) co
308 = do {
309 #if defined(DEBUG)
310 ; cts <- readTcRef ref
311 ; whenIsJust cts $ \old_co ->
312 pprPanic "Filling a filled coercion hole" (ppr cv $$ ppr co $$ ppr old_co)
313 #endif
314 ; traceTc "Filling coercion hole" (ppr cv <+> text ":=" <+> ppr co)
315 ; writeTcRef ref (Just co) }
316
317 -- | Is a coercion hole filled in?
318 isFilledCoercionHole :: CoercionHole -> TcM Bool
319 isFilledCoercionHole (CoercionHole { ch_ref = ref }) = isJust <$> readTcRef ref
320
321 -- | Retrieve the contents of a coercion hole. Panics if the hole
322 -- is unfilled
323 unpackCoercionHole :: CoercionHole -> TcM Coercion
324 unpackCoercionHole hole
325 = do { contents <- unpackCoercionHole_maybe hole
326 ; case contents of
327 Just co -> return co
328 Nothing -> pprPanic "Unfilled coercion hole" (ppr hole) }
329
330 -- | Retrieve the contents of a coercion hole, if it is filled
331 unpackCoercionHole_maybe :: CoercionHole -> TcM (Maybe Coercion)
332 unpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref
333
334 -- | Check that a coercion is appropriate for filling a hole. (The hole
335 -- itself is needed only for printing.
336 -- Always returns the checked coercion, but this return value is necessary
337 -- so that the input coercion is forced only when the output is forced.
338 checkCoercionHole :: CoVar -> Coercion -> TcM Coercion
339 checkCoercionHole cv co
340 | debugIsOn
341 = do { cv_ty <- zonkTcType (varType cv)
342 -- co is already zonked, but cv might not be
343 ; return $
344 ASSERT2( ok cv_ty
345 , (text "Bad coercion hole" <+>
346 ppr cv <> colon <+> vcat [ ppr t1, ppr t2, ppr role
347 , ppr cv_ty ]) )
348 co }
349 | otherwise
350 = return co
351
352 where
353 (Pair t1 t2, role) = coercionKindRole co
354 ok cv_ty | EqPred cv_rel cv_t1 cv_t2 <- classifyPredType cv_ty
355 = t1 `eqType` cv_t1
356 && t2 `eqType` cv_t2
357 && role == eqRelRole cv_rel
358 | otherwise
359 = False
360
361 {-
362 ************************************************************************
363 *
364 Expected types
365 *
366 ************************************************************************
367
368 Note [ExpType]
369 ~~~~~~~~~~~~~~
370
371 An ExpType is used as the "expected type" when type-checking an expression.
372 An ExpType can hold a "hole" that can be filled in by the type-checker.
373 This allows us to have one tcExpr that works in both checking mode and
374 synthesis mode (that is, bidirectional type-checking). Previously, this
375 was achieved by using ordinary unification variables, but we don't need
376 or want that generality. (For example, #11397 was caused by doing the
377 wrong thing with unification variables.) Instead, we observe that these
378 holes should
379
380 1. never be nested
381 2. never appear as the type of a variable
382 3. be used linearly (never be duplicated)
383
384 By defining ExpType, separately from Type, we can achieve goals 1 and 2
385 statically.
386
387 See also [wiki:typechecking]
388
389 Note [TcLevel of ExpType]
390 ~~~~~~~~~~~~~~~~~~~~~~~~~
391 Consider
392
393 data G a where
394 MkG :: G Bool
395
396 foo MkG = True
397
398 This is a classic untouchable-variable / ambiguous GADT return type
399 scenario. But, with ExpTypes, we'll be inferring the type of the RHS.
400 And, because there is only one branch of the case, we won't trigger
401 Note [Case branches must never infer a non-tau type] of TcMatches.
402 We thus must track a TcLevel in an Inferring ExpType. If we try to
403 fill the ExpType and find that the TcLevels don't work out, we
404 fill the ExpType with a tau-tv at the low TcLevel, hopefully to
405 be worked out later by some means. This is triggered in
406 test gadt/gadt-escape1.
407
408 -}
409
410 -- actual data definition is in TcType
411
412 -- | Make an 'ExpType' suitable for inferring a type of kind * or #.
413 newInferExpTypeNoInst :: TcM ExpSigmaType
414 newInferExpTypeNoInst = newInferExpType False
415
416 newInferExpTypeInst :: TcM ExpRhoType
417 newInferExpTypeInst = newInferExpType True
418
419 newInferExpType :: Bool -> TcM ExpType
420 newInferExpType inst
421 = do { u <- newUnique
422 ; tclvl <- getTcLevel
423 ; traceTc "newOpenInferExpType" (ppr u <+> ppr inst <+> ppr tclvl)
424 ; ref <- newMutVar Nothing
425 ; return (Infer (IR { ir_uniq = u, ir_lvl = tclvl
426 , ir_ref = ref, ir_inst = inst })) }
427
428 -- | Extract a type out of an ExpType, if one exists. But one should always
429 -- exist. Unless you're quite sure you know what you're doing.
430 readExpType_maybe :: ExpType -> TcM (Maybe TcType)
431 readExpType_maybe (Check ty) = return (Just ty)
432 readExpType_maybe (Infer (IR { ir_ref = ref})) = readMutVar ref
433
434 -- | Extract a type out of an ExpType. Otherwise, panics.
435 readExpType :: ExpType -> TcM TcType
436 readExpType exp_ty
437 = do { mb_ty <- readExpType_maybe exp_ty
438 ; case mb_ty of
439 Just ty -> return ty
440 Nothing -> pprPanic "Unknown expected type" (ppr exp_ty) }
441
442 -- | Returns the expected type when in checking mode.
443 checkingExpType_maybe :: ExpType -> Maybe TcType
444 checkingExpType_maybe (Check ty) = Just ty
445 checkingExpType_maybe _ = Nothing
446
447 -- | Returns the expected type when in checking mode. Panics if in inference
448 -- mode.
449 checkingExpType :: String -> ExpType -> TcType
450 checkingExpType _ (Check ty) = ty
451 checkingExpType err et = pprPanic "checkingExpType" (text err $$ ppr et)
452
453 tauifyExpType :: ExpType -> TcM ExpType
454 -- ^ Turn a (Infer hole) type into a (Check alpha),
455 -- where alpha is a fresh unification variable
456 tauifyExpType (Check ty) = return (Check ty) -- No-op for (Check ty)
457 tauifyExpType (Infer inf_res) = do { ty <- inferResultToType inf_res
458 ; return (Check ty) }
459
460 -- | Extracts the expected type if there is one, or generates a new
461 -- TauTv if there isn't.
462 expTypeToType :: ExpType -> TcM TcType
463 expTypeToType (Check ty) = return ty
464 expTypeToType (Infer inf_res) = inferResultToType inf_res
465
466 inferResultToType :: InferResult -> TcM Type
467 inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl
468 , ir_ref = ref })
469 = do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy
470 ; tau <- newMetaTyVarTyAtLevel tc_lvl (tYPE rr)
471 -- See Note [TcLevel of ExpType]
472 ; writeMutVar ref (Just tau)
473 ; traceTc "Forcing ExpType to be monomorphic:"
474 (ppr u <+> text ":=" <+> ppr tau)
475 ; return tau }
476
477
478 {- *********************************************************************
479 * *
480 SkolemTvs (immutable)
481 * *
482 ********************************************************************* -}
483
484 tcInstType :: ([TyVar] -> TcM (TCvSubst, [TcTyVar]))
485 -- ^ How to instantiate the type variables
486 -> Id -- ^ Type to instantiate
487 -> TcM ([(Name, TcTyVar)], TcThetaType, TcType) -- ^ Result
488 -- (type vars, preds (incl equalities), rho)
489 tcInstType inst_tyvars id
490 = case tcSplitForAllTys (idType id) of
491 ([], rho) -> let -- There may be overloading despite no type variables;
492 -- (?x :: Int) => Int -> Int
493 (theta, tau) = tcSplitPhiTy rho
494 in
495 return ([], theta, tau)
496
497 (tyvars, rho) -> do { (subst, tyvars') <- inst_tyvars tyvars
498 ; let (theta, tau) = tcSplitPhiTy (substTyAddInScope subst rho)
499 tv_prs = map tyVarName tyvars `zip` tyvars'
500 ; return (tv_prs, theta, tau) }
501
502 tcSkolDFunType :: DFunId -> TcM ([TcTyVar], TcThetaType, TcType)
503 -- Instantiate a type signature with skolem constants.
504 -- We could give them fresh names, but no need to do so
505 tcSkolDFunType dfun
506 = do { (tv_prs, theta, tau) <- tcInstType tcInstSuperSkolTyVars dfun
507 ; return (map snd tv_prs, theta, tau) }
508
509 tcSuperSkolTyVars :: [TyVar] -> (TCvSubst, [TcTyVar])
510 -- Make skolem constants, but do *not* give them new names, as above
511 -- Moreover, make them "super skolems"; see comments with superSkolemTv
512 -- see Note [Kind substitution when instantiating]
513 -- Precondition: tyvars should be ordered by scoping
514 tcSuperSkolTyVars = mapAccumL tcSuperSkolTyVar emptyTCvSubst
515
516 tcSuperSkolTyVar :: TCvSubst -> TyVar -> (TCvSubst, TcTyVar)
517 tcSuperSkolTyVar subst tv
518 = (extendTvSubstWithClone subst tv new_tv, new_tv)
519 where
520 kind = substTyUnchecked subst (tyVarKind tv)
521 new_tv = mkTcTyVar (tyVarName tv) kind superSkolemTv
522
523 -- | Given a list of @['TyVar']@, skolemize the type variables,
524 -- returning a substitution mapping the original tyvars to the
525 -- skolems, and the list of newly bound skolems.
526 tcInstSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
527 -- See Note [Skolemising type variables]
528 tcInstSkolTyVars = tcInstSkolTyVarsX emptyTCvSubst
529
530 tcInstSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
531 -- See Note [Skolemising type variables]
532 tcInstSkolTyVarsX = tcInstSkolTyVarsPushLevel False
533
534 tcInstSuperSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
535 -- See Note [Skolemising type variables]
536 tcInstSuperSkolTyVars = tcInstSuperSkolTyVarsX emptyTCvSubst
537
538 tcInstSuperSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
539 -- See Note [Skolemising type variables]
540 tcInstSuperSkolTyVarsX subst = tcInstSkolTyVarsPushLevel True subst
541
542 tcInstSkolTyVarsPushLevel :: Bool -> TCvSubst -> [TyVar]
543 -> TcM (TCvSubst, [TcTyVar])
544 -- Skolemise one level deeper, hence pushTcLevel
545 -- See Note [Skolemising type variables]
546 tcInstSkolTyVarsPushLevel overlappable subst tvs
547 = do { tc_lvl <- getTcLevel
548 ; let pushed_lvl = pushTcLevel tc_lvl
549 ; tcInstSkolTyVarsAt pushed_lvl overlappable subst tvs }
550
551 tcInstSkolTyVarsAt :: TcLevel -> Bool
552 -> TCvSubst -> [TyVar]
553 -> TcM (TCvSubst, [TcTyVar])
554 tcInstSkolTyVarsAt lvl overlappable subst tvs
555 = freshenTyCoVarsX new_skol_tv subst tvs
556 where
557 details = SkolemTv lvl overlappable
558 new_skol_tv name kind = mkTcTyVar name kind details
559
560 ------------------
561 freshenTyVarBndrs :: [TyVar] -> TcM (TCvSubst, [TyVar])
562 -- ^ Give fresh uniques to a bunch of TyVars, but they stay
563 -- as TyVars, rather than becoming TcTyVars
564 -- Used in FamInst.newFamInst, and Inst.newClsInst
565 freshenTyVarBndrs = freshenTyCoVars mkTyVar
566
567 freshenCoVarBndrsX :: TCvSubst -> [CoVar] -> TcM (TCvSubst, [CoVar])
568 -- ^ Give fresh uniques to a bunch of CoVars
569 -- Used in FamInst.newFamInst
570 freshenCoVarBndrsX subst = freshenTyCoVarsX mkCoVar subst
571
572 ------------------
573 freshenTyCoVars :: (Name -> Kind -> TyCoVar)
574 -> [TyVar] -> TcM (TCvSubst, [TyCoVar])
575 freshenTyCoVars mk_tcv = freshenTyCoVarsX mk_tcv emptyTCvSubst
576
577 freshenTyCoVarsX :: (Name -> Kind -> TyCoVar)
578 -> TCvSubst -> [TyCoVar]
579 -> TcM (TCvSubst, [TyCoVar])
580 freshenTyCoVarsX mk_tcv = mapAccumLM (freshenTyCoVarX mk_tcv)
581
582 freshenTyCoVarX :: (Name -> Kind -> TyCoVar)
583 -> TCvSubst -> TyCoVar -> TcM (TCvSubst, TyCoVar)
584 -- This a complete freshening operation:
585 -- the skolems have a fresh unique, and a location from the monad
586 -- See Note [Skolemising type variables]
587 freshenTyCoVarX mk_tcv subst tycovar
588 = do { loc <- getSrcSpanM
589 ; uniq <- newUnique
590 ; let old_name = tyVarName tycovar
591 new_name = mkInternalName uniq (getOccName old_name) loc
592 new_kind = substTyUnchecked subst (tyVarKind tycovar)
593 new_tcv = mk_tcv new_name new_kind
594 subst1 = extendTCvSubstWithClone subst tycovar new_tcv
595 ; return (subst1, new_tcv) }
596
597 {- Note [Skolemising type variables]
598 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
599 The tcInstSkolTyVars family of functions instantiate a list of TyVars
600 to fresh skolem TcTyVars. Important notes:
601
602 a) Level allocation. We generally skolemise /before/ calling
603 pushLevelAndCaptureConstraints. So we want their level to the level
604 of the soon-to-be-created implication, which has a level ONE HIGHER
605 than the current level. Hence the pushTcLevel. It feels like a
606 slight hack.
607
608 b) The [TyVar] should be ordered (kind vars first)
609 See Note [Kind substitution when instantiating]
610
611 c) It's a complete freshening operation: the skolems have a fresh
612 unique, and a location from the monad
613
614 d) The resulting skolems are
615 non-overlappable for tcInstSkolTyVars,
616 but overlappable for tcInstSuperSkolTyVars
617 See TcDerivInfer Note [Overlap and deriving] for an example
618 of where this matters.
619
620 Note [Kind substitution when instantiating]
621 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
622 When we instantiate a bunch of kind and type variables, first we
623 expect them to be topologically sorted.
624 Then we have to instantiate the kind variables, build a substitution
625 from old variables to the new variables, then instantiate the type
626 variables substituting the original kind.
627
628 Exemple: If we want to instantiate
629 [(k1 :: *), (k2 :: *), (a :: k1 -> k2), (b :: k1)]
630 we want
631 [(?k1 :: *), (?k2 :: *), (?a :: ?k1 -> ?k2), (?b :: ?k1)]
632 instead of the buggous
633 [(?k1 :: *), (?k2 :: *), (?a :: k1 -> k2), (?b :: k1)]
634
635
636 ************************************************************************
637 * *
638 MetaTvs (meta type variables; mutable)
639 * *
640 ************************************************************************
641 -}
642
643 {-
644 Note [TyVarTv]
645 ~~~~~~~~~~~~
646
647 A TyVarTv can unify with type *variables* only, including other TyVarTvs and
648 skolems. Sometimes, they can unify with type variables that the user would
649 rather keep distinct; see #11203 for an example. So, any client of this
650 function needs to either allow the TyVarTvs to unify with each other or check
651 that they don't (say, with a call to findDubTyVarTvs).
652
653 Before #15050 this (under the name SigTv) was used for ScopedTypeVariables in
654 patterns, to make sure these type variables only refer to other type variables,
655 but this restriction was dropped, and ScopedTypeVariables can now refer to full
656 types (GHC Proposal 29).
657
658 The remaining uses of newTyVarTyVars are
659 * In kind signatures, see
660 TcTyClsDecls Note [Inferring kinds for type declarations]
661 and Note [Kind checking for GADTs]
662 * In partial type signatures, see Note [Quantified variables in partial type signatures]
663 -}
664
665 newMetaTyVarName :: FastString -> TcM Name
666 -- Makes a /System/ Name, which is eagerly eliminated by
667 -- the unifier; see TcUnify.nicer_to_update_tv1, and
668 -- TcCanonical.canEqTyVarTyVar (nicer_to_update_tv2)
669 newMetaTyVarName str
670 = do { uniq <- newUnique
671 ; return (mkSystemName uniq (mkTyVarOccFS str)) }
672
673 cloneMetaTyVarName :: Name -> TcM Name
674 cloneMetaTyVarName name
675 = do { uniq <- newUnique
676 ; return (mkSystemName uniq (nameOccName name)) }
677 -- See Note [Name of an instantiated type variable]
678
679 {- Note [Name of an instantiated type variable]
680 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
681 At the moment we give a unification variable a System Name, which
682 influences the way it is tidied; see TypeRep.tidyTyVarBndr.
683
684 Note [Unification variables need fresh Names]
685 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
686 Whenever we allocate a unification variable (MetaTyVar) we give
687 it a fresh name. #16221 is a very tricky case that illustrates
688 why this is important:
689
690 data SameKind :: k -> k -> *
691 data T0 a = forall k2 (b :: k2). MkT0 (SameKind a b) !Int
692
693 When kind-checking T0, we give (a :: kappa1). Then, in kcConDecl
694 we allocate a unification variable kappa2 for k2, and then we
695 end up unifying kappa1 := kappa2 (because of the (SameKind a b).
696
697 Now we generalise over kappa2; but if kappa2's Name is k2,
698 we'll end up giving T0 the kind forall k2. k2 -> *. Nothing
699 directly wrong with that but when we typecheck the data constrautor
700 we end up giving it the type
701 MkT0 :: forall k1 (a :: k1) k2 (b :: k2).
702 SameKind @k2 a b -> Int -> T0 @{k2} a
703 which is bogus. The result type should be T0 @{k1} a.
704
705 And there no reason /not/ to clone the Name when making a
706 unification variable. So that's what we do.
707 -}
708
709 newAnonMetaTyVar :: MetaInfo -> Kind -> TcM TcTyVar
710 -- Make a new meta tyvar out of thin air
711 newAnonMetaTyVar meta_info kind
712 = do { let s = case meta_info of
713 TauTv -> fsLit "t"
714 FlatMetaTv -> fsLit "fmv"
715 FlatSkolTv -> fsLit "fsk"
716 TyVarTv -> fsLit "a"
717 ; name <- newMetaTyVarName s
718 ; details <- newMetaDetails meta_info
719 ; let tyvar = mkTcTyVar name kind details
720 ; traceTc "newAnonMetaTyVar" (ppr tyvar)
721 ; return tyvar }
722
723 -- makes a new skolem tv
724 newSkolemTyVar :: Name -> Kind -> TcM TcTyVar
725 newSkolemTyVar name kind
726 = do { lvl <- getTcLevel
727 ; return (mkTcTyVar name kind (SkolemTv lvl False)) }
728
729 newTyVarTyVar :: Name -> Kind -> TcM TcTyVar
730 -- See Note [TyVarTv]
731 -- See Note [Unification variables need fresh Names]
732 newTyVarTyVar name kind
733 = do { details <- newMetaDetails TyVarTv
734 ; uniq <- newUnique
735 ; let name' = name `setNameUnique` uniq
736 tyvar = mkTcTyVar name' kind details
737 -- Don't use cloneMetaTyVar, which makes a SystemName
738 -- We want to keep the original more user-friendly Name
739 -- In practical terms that means that in error messages,
740 -- when the Name is tidied we get 'a' rather than 'a0'
741 ; traceTc "newTyVarTyVar" (ppr tyvar)
742 ; return tyvar }
743
744 newPatSigTyVar :: Name -> Kind -> TcM TcTyVar
745 newPatSigTyVar name kind
746 = do { details <- newMetaDetails TauTv
747 ; uniq <- newUnique
748 ; let name' = name `setNameUnique` uniq
749 tyvar = mkTcTyVar name' kind details
750 -- Don't use cloneMetaTyVar;
751 -- same reasoning as in newTyVarTyVar
752 ; traceTc "newPatSigTyVar" (ppr tyvar)
753 ; return tyvar }
754
755 cloneAnonMetaTyVar :: MetaInfo -> TyVar -> TcKind -> TcM TcTyVar
756 -- Make a fresh MetaTyVar, basing the name
757 -- on that of the supplied TyVar
758 cloneAnonMetaTyVar info tv kind
759 = do { details <- newMetaDetails info
760 ; name <- cloneMetaTyVarName (tyVarName tv)
761 ; let tyvar = mkTcTyVar name kind details
762 ; traceTc "cloneAnonMetaTyVar" (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar))
763 ; return tyvar }
764
765 newFskTyVar :: TcType -> TcM TcTyVar
766 newFskTyVar fam_ty
767 = do { details <- newMetaDetails FlatSkolTv
768 ; name <- newMetaTyVarName (fsLit "fsk")
769 ; return (mkTcTyVar name (tcTypeKind fam_ty) details) }
770
771 newFmvTyVar :: TcType -> TcM TcTyVar
772 -- Very like newMetaTyVar, except sets mtv_tclvl to one less
773 -- so that the fmv is untouchable.
774 newFmvTyVar fam_ty
775 = do { details <- newMetaDetails FlatMetaTv
776 ; name <- newMetaTyVarName (fsLit "s")
777 ; return (mkTcTyVar name (tcTypeKind fam_ty) details) }
778
779 newMetaDetails :: MetaInfo -> TcM TcTyVarDetails
780 newMetaDetails info
781 = do { ref <- newMutVar Flexi
782 ; tclvl <- getTcLevel
783 ; return (MetaTv { mtv_info = info
784 , mtv_ref = ref
785 , mtv_tclvl = tclvl }) }
786
787 cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
788 cloneMetaTyVar tv
789 = ASSERT( isTcTyVar tv )
790 do { ref <- newMutVar Flexi
791 ; name' <- cloneMetaTyVarName (tyVarName tv)
792 ; let details' = case tcTyVarDetails tv of
793 details@(MetaTv {}) -> details { mtv_ref = ref }
794 _ -> pprPanic "cloneMetaTyVar" (ppr tv)
795 tyvar = mkTcTyVar name' (tyVarKind tv) details'
796 ; traceTc "cloneMetaTyVar" (ppr tyvar)
797 ; return tyvar }
798
799 -- Works for both type and kind variables
800 readMetaTyVar :: TyVar -> TcM MetaDetails
801 readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )
802 readMutVar (metaTyVarRef tyvar)
803
804 isFilledMetaTyVar_maybe :: TcTyVar -> TcM (Maybe Type)
805 isFilledMetaTyVar_maybe tv
806 | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv
807 = do { cts <- readTcRef ref
808 ; case cts of
809 Indirect ty -> return (Just ty)
810 Flexi -> return Nothing }
811 | otherwise
812 = return Nothing
813
814 isFilledMetaTyVar :: TyVar -> TcM Bool
815 -- True of a filled-in (Indirect) meta type variable
816 isFilledMetaTyVar tv = isJust <$> isFilledMetaTyVar_maybe tv
817
818 isUnfilledMetaTyVar :: TyVar -> TcM Bool
819 -- True of a un-filled-in (Flexi) meta type variable
820 -- NB: Not the opposite of isFilledMetaTyVar
821 isUnfilledMetaTyVar tv
822 | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv
823 = do { details <- readMutVar ref
824 ; return (isFlexi details) }
825 | otherwise = return False
826
827 --------------------
828 -- Works with both type and kind variables
829 writeMetaTyVar :: TcTyVar -> TcType -> TcM ()
830 -- Write into a currently-empty MetaTyVar
831
832 writeMetaTyVar tyvar ty
833 | not debugIsOn
834 = writeMetaTyVarRef tyvar (metaTyVarRef tyvar) ty
835
836 -- Everything from here on only happens if DEBUG is on
837 | not (isTcTyVar tyvar)
838 = ASSERT2( False, text "Writing to non-tc tyvar" <+> ppr tyvar )
839 return ()
840
841 | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar
842 = writeMetaTyVarRef tyvar ref ty
843
844 | otherwise
845 = ASSERT2( False, text "Writing to non-meta tyvar" <+> ppr tyvar )
846 return ()
847
848 --------------------
849 writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
850 -- Here the tyvar is for error checking only;
851 -- the ref cell must be for the same tyvar
852 writeMetaTyVarRef tyvar ref ty
853 | not debugIsOn
854 = do { traceTc "writeMetaTyVar" (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)
855 <+> text ":=" <+> ppr ty)
856 ; writeTcRef ref (Indirect ty) }
857
858 -- Everything from here on only happens if DEBUG is on
859 | otherwise
860 = do { meta_details <- readMutVar ref;
861 -- Zonk kinds to allow the error check to work
862 ; zonked_tv_kind <- zonkTcType tv_kind
863 ; zonked_ty_kind <- zonkTcType ty_kind
864 ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind
865 || tcEqKind zonked_ty_kind zonked_tv_kind
866 -- Hack alert! tcIsConstraintKind: see TcHsType
867 -- Note [Extra-constraint holes in partial type signatures]
868
869 kind_msg = hang (text "Ill-kinded update to meta tyvar")
870 2 ( ppr tyvar <+> text "::" <+> (ppr tv_kind $$ ppr zonked_tv_kind)
871 <+> text ":="
872 <+> ppr ty <+> text "::" <+> (ppr zonked_ty_kind) )
873
874 ; traceTc "writeMetaTyVar" (ppr tyvar <+> text ":=" <+> ppr ty)
875
876 -- Check for double updates
877 ; MASSERT2( isFlexi meta_details, double_upd_msg meta_details )
878
879 -- Check for level OK
880 -- See Note [Level check when unifying]
881 ; MASSERT2( level_check_ok, level_check_msg )
882
883 -- Check Kinds ok
884 ; MASSERT2( kind_check_ok, kind_msg )
885
886 -- Do the write
887 ; writeMutVar ref (Indirect ty) }
888 where
889 tv_kind = tyVarKind tyvar
890 ty_kind = tcTypeKind ty
891
892 tv_lvl = tcTyVarLevel tyvar
893 ty_lvl = tcTypeLevel ty
894
895 level_check_ok = not (ty_lvl `strictlyDeeperThan` tv_lvl)
896 level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty
897
898 double_upd_msg details = hang (text "Double update of meta tyvar")
899 2 (ppr tyvar $$ ppr details)
900
901 {- Note [Level check when unifying]
902 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
903 When unifying
904 alpha:lvl := ty
905 we expect that the TcLevel of 'ty' will be <= lvl.
906 However, during unflatting we do
907 fuv:l := ty:(l+1)
908 which is usually wrong; hence the check isFmmvTyVar in level_check_ok.
909 See Note [TcLevel assignment] in TcType.
910 -}
911
912 {-
913 % Generating fresh variables for pattern match check
914 -}
915
916
917 {-
918 ************************************************************************
919 * *
920 MetaTvs: TauTvs
921 * *
922 ************************************************************************
923
924 Note [Never need to instantiate coercion variables]
925 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
926 With coercion variables sloshing around in types, it might seem that we
927 sometimes need to instantiate coercion variables. This would be problematic,
928 because coercion variables inhabit unboxed equality (~#), and the constraint
929 solver thinks in terms only of boxed equality (~). The solution is that
930 we never need to instantiate coercion variables in the first place.
931
932 The tyvars that we need to instantiate come from the types of functions,
933 data constructors, and patterns. These will never be quantified over
934 coercion variables, except for the special case of the promoted Eq#. But,
935 that can't ever appear in user code, so we're safe!
936 -}
937
938
939 newFlexiTyVar :: Kind -> TcM TcTyVar
940 newFlexiTyVar kind = newAnonMetaTyVar TauTv kind
941
942 newFlexiTyVarTy :: Kind -> TcM TcType
943 newFlexiTyVarTy kind = do
944 tc_tyvar <- newFlexiTyVar kind
945 return (mkTyVarTy tc_tyvar)
946
947 newFlexiTyVarTys :: Int -> Kind -> TcM [TcType]
948 newFlexiTyVarTys n kind = replicateM n (newFlexiTyVarTy kind)
949
950 newOpenTypeKind :: TcM TcKind
951 newOpenTypeKind
952 = do { rr <- newFlexiTyVarTy runtimeRepTy
953 ; return (tYPE rr) }
954
955 -- | Create a tyvar that can be a lifted or unlifted type.
956 -- Returns alpha :: TYPE kappa, where both alpha and kappa are fresh
957 newOpenFlexiTyVarTy :: TcM TcType
958 newOpenFlexiTyVarTy
959 = do { kind <- newOpenTypeKind
960 ; newFlexiTyVarTy kind }
961
962 newMetaTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
963 -- Instantiate with META type variables
964 -- Note that this works for a sequence of kind, type, and coercion variables
965 -- variables. Eg [ (k:*), (a:k->k) ]
966 -- Gives [ (k7:*), (a8:k7->k7) ]
967 newMetaTyVars = newMetaTyVarsX emptyTCvSubst
968 -- emptyTCvSubst has an empty in-scope set, but that's fine here
969 -- Since the tyvars are freshly made, they cannot possibly be
970 -- captured by any existing for-alls.
971
972 newMetaTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
973 -- Just like newMetaTyVars, but start with an existing substitution.
974 newMetaTyVarsX subst = mapAccumLM newMetaTyVarX subst
975
976 newMetaTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
977 -- Make a new unification variable tyvar whose Name and Kind come from
978 -- an existing TyVar. We substitute kind variables in the kind.
979 newMetaTyVarX subst tyvar = new_meta_tv_x TauTv subst tyvar
980
981 newMetaTyVarTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
982 newMetaTyVarTyVars = mapAccumLM newMetaTyVarTyVarX emptyTCvSubst
983
984 newMetaTyVarTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
985 -- Just like newMetaTyVarX, but make a TyVarTv
986 newMetaTyVarTyVarX subst tyvar = new_meta_tv_x TyVarTv subst tyvar
987
988 newWildCardX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
989 newWildCardX subst tv
990 = do { new_tv <- newAnonMetaTyVar TauTv (substTy subst (tyVarKind tv))
991 ; return (extendTvSubstWithClone subst tv new_tv, new_tv) }
992
993 new_meta_tv_x :: MetaInfo -> TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
994 new_meta_tv_x info subst tv
995 = do { new_tv <- cloneAnonMetaTyVar info tv substd_kind
996 ; let subst1 = extendTvSubstWithClone subst tv new_tv
997 ; return (subst1, new_tv) }
998 where
999 substd_kind = substTyUnchecked subst (tyVarKind tv)
1000 -- NOTE: #12549 is fixed so we could use
1001 -- substTy here, but the tc_infer_args problem
1002 -- is not yet fixed so leaving as unchecked for now.
1003 -- OLD NOTE:
1004 -- Unchecked because we call newMetaTyVarX from
1005 -- tcInstTyBinder, which is called from tcInferApps
1006 -- which does not yet take enough trouble to ensure
1007 -- the in-scope set is right; e.g. #12785 trips
1008 -- if we use substTy here
1009
1010 newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType
1011 newMetaTyVarTyAtLevel tc_lvl kind
1012 = do { ref <- newMutVar Flexi
1013 ; name <- newMetaTyVarName (fsLit "p")
1014 ; let details = MetaTv { mtv_info = TauTv
1015 , mtv_ref = ref
1016 , mtv_tclvl = tc_lvl }
1017 ; return (mkTyVarTy (mkTcTyVar name kind details)) }
1018
1019 {- *********************************************************************
1020 * *
1021 Finding variables to quantify over
1022 * *
1023 ********************************************************************* -}
1024
1025 {- Note [Dependent type variables]
1026 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1027 In Haskell type inference we quantify over type variables; but we only
1028 quantify over /kind/ variables when -XPolyKinds is on. Without -XPolyKinds
1029 we default the kind variables to *.
1030
1031 So, to support this defaulting, and only for that reason, when
1032 collecting the free vars of a type (in candidateQTyVarsOfType and friends),
1033 prior to quantifying, we must keep the type and kind variables separate.
1034
1035 But what does that mean in a system where kind variables /are/ type
1036 variables? It's a fairly arbitrary distinction based on how the
1037 variables appear:
1038
1039 - "Kind variables" appear in the kind of some other free variable
1040 or in the kind of a locally quantified type variable
1041 (forall (a :: kappa). ...) or in the kind of a coercion
1042 (a |> (co :: kappa1 ~ kappa2)).
1043
1044 These are the ones we default to * if -XPolyKinds is off
1045
1046 - "Type variables" are all free vars that are not kind variables
1047
1048 E.g. In the type T k (a::k)
1049 'k' is a kind variable, because it occurs in the kind of 'a',
1050 even though it also appears at "top level" of the type
1051 'a' is a type variable, because it doesn't
1052
1053 We gather these variables using a CandidatesQTvs record:
1054 DV { dv_kvs: Variables free in the kind of a free type variable
1055 or of a forall-bound type variable
1056 , dv_tvs: Variables sytactically free in the type }
1057
1058 So: dv_kvs are the kind variables of the type
1059 (dv_tvs - dv_kvs) are the type variable of the type
1060
1061 Note that
1062
1063 * A variable can occur in both.
1064 T k (x::k) The first occurrence of k makes it
1065 show up in dv_tvs, the second in dv_kvs
1066
1067 * We include any coercion variables in the "dependent",
1068 "kind-variable" set because we never quantify over them.
1069
1070 * The "kind variables" might depend on each other; e.g
1071 (k1 :: k2), (k2 :: *)
1072 The "type variables" do not depend on each other; if
1073 one did, it'd be classified as a kind variable!
1074
1075 Note [CandidatesQTvs determinism and order]
1076 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1077 * Determinism: when we quantify over type variables we decide the
1078 order in which they appear in the final type. Because the order of
1079 type variables in the type can end up in the interface file and
1080 affects some optimizations like worker-wrapper, we want this order to
1081 be deterministic.
1082
1083 To achieve that we use deterministic sets of variables that can be
1084 converted to lists in a deterministic order. For more information
1085 about deterministic sets see Note [Deterministic UniqFM] in UniqDFM.
1086
1087 * Order: as well as being deterministic, we use an
1088 accumulating-parameter style for candidateQTyVarsOfType so that we
1089 add variables one at a time, left to right. That means we tend to
1090 produce the variables in left-to-right order. This is just to make
1091 it bit more predictable for the programmer.
1092
1093 Note [Naughty quantification candidates]
1094 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1095 Consider (#14880, dependent/should_compile/T14880-2), suppose
1096 we are trying to generalise this type:
1097
1098 forall arg. ... (alpha[tau]:arg) ...
1099
1100 We have a metavariable alpha whose kind mentions a skolem variable
1101 bound inside the very type we are generalising.
1102 This can arise while type-checking a user-written type signature
1103 (see the test case for the full code).
1104
1105 We cannot generalise over alpha! That would produce a type like
1106 forall {a :: arg}. forall arg. ...blah...
1107 The fact that alpha's kind mentions arg renders it completely
1108 ineligible for generalisation.
1109
1110 However, we are not going to learn any new constraints on alpha,
1111 because its kind isn't even in scope in the outer context (but see Wrinkle).
1112 So alpha is entirely unconstrained.
1113
1114 What then should we do with alpha? During generalization, every
1115 metavariable is either (A) promoted, (B) generalized, or (C) zapped
1116 (according again to Note [Recipe for checking a signature] in
1117 TcHsType).
1118
1119 * We can't generalise it.
1120 * We can't promote it, because its kind prevents that
1121 * We can't simply leave it be, because this type is about to
1122 go into the typing environment (as the type of some let-bound
1123 variable, say), and then chaos erupts when we try to instantiate.
1124
1125 So, we zap it, eagerly, to Any. We don't have to do this eager zapping
1126 in terms (say, in `length []`) because terms are never re-examined before
1127 the final zonk (which zaps any lingering metavariables to Any).
1128
1129 We do this eager zapping in candidateQTyVars, which always precedes
1130 generalisation, because at that moment we have a clear picture of what
1131 skolems are in scope within the type itself (e.g. that 'forall arg').
1132
1133 Wrinkle:
1134
1135 We must make absolutely sure that alpha indeed is not
1136 from an outer context. (Otherwise, we might indeed learn more information
1137 about it.) This can be done easily: we just check alpha's TcLevel.
1138 That level must be strictly greater than the ambient TcLevel in order
1139 to treat it as naughty. We say "strictly greater than" because the call to
1140 candidateQTyVars is made outside the bumped TcLevel, as stated in the
1141 comment to candidateQTyVarsOfType. The level check is done in go_tv
1142 in collect_cand_qtvs. Skipping this check caused #16517.
1143
1144 -}
1145
1146 data CandidatesQTvs
1147 -- See Note [Dependent type variables]
1148 -- See Note [CandidatesQTvs determinism and order]
1149 --
1150 -- Invariants:
1151 -- * All variables are fully zonked, including their kinds
1152 -- * All variables are at a level greater than the ambient level
1153 -- See Note [Use level numbers for quantification]
1154 --
1155 -- This *can* contain skolems. For example, in `data X k :: k -> Type`
1156 -- we need to know that the k is a dependent variable. This is done
1157 -- by collecting the candidates in the kind after skolemising. It also
1158 -- comes up when generalizing a associated type instance, where instance
1159 -- variables are skolems. (Recall that associated type instances are generalized
1160 -- independently from their enclosing class instance, and the associated
1161 -- type instance may be generalized by more, fewer, or different variables
1162 -- than the class instance.)
1163 --
1164 = DV { dv_kvs :: DTyVarSet -- "kind" metavariables (dependent)
1165 , dv_tvs :: DTyVarSet -- "type" metavariables (non-dependent)
1166 -- A variable may appear in both sets
1167 -- E.g. T k (x::k) The first occurrence of k makes it
1168 -- show up in dv_tvs, the second in dv_kvs
1169 -- See Note [Dependent type variables]
1170
1171 , dv_cvs :: CoVarSet
1172 -- These are covars. Included only so that we don't repeatedly
1173 -- look at covars' kinds in accumulator. Not used by quantifyTyVars.
1174 }
1175
1176 instance Semi.Semigroup CandidatesQTvs where
1177 (DV { dv_kvs = kv1, dv_tvs = tv1, dv_cvs = cv1 })
1178 <> (DV { dv_kvs = kv2, dv_tvs = tv2, dv_cvs = cv2 })
1179 = DV { dv_kvs = kv1 `unionDVarSet` kv2
1180 , dv_tvs = tv1 `unionDVarSet` tv2
1181 , dv_cvs = cv1 `unionVarSet` cv2 }
1182
1183 instance Monoid CandidatesQTvs where
1184 mempty = DV { dv_kvs = emptyDVarSet, dv_tvs = emptyDVarSet, dv_cvs = emptyVarSet }
1185 mappend = (Semi.<>)
1186
1187 instance Outputable CandidatesQTvs where
1188 ppr (DV {dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs })
1189 = text "DV" <+> braces (pprWithCommas id [ text "dv_kvs =" <+> ppr kvs
1190 , text "dv_tvs =" <+> ppr tvs
1191 , text "dv_cvs =" <+> ppr cvs ])
1192
1193
1194 candidateKindVars :: CandidatesQTvs -> TyVarSet
1195 candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs)
1196
1197 partitionCandidates :: CandidatesQTvs -> (TyVar -> Bool) -> (DTyVarSet, CandidatesQTvs)
1198 partitionCandidates dvs@(DV { dv_kvs = kvs, dv_tvs = tvs }) pred
1199 = (extracted, dvs { dv_kvs = rest_kvs, dv_tvs = rest_tvs })
1200 where
1201 (extracted_kvs, rest_kvs) = partitionDVarSet pred kvs
1202 (extracted_tvs, rest_tvs) = partitionDVarSet pred tvs
1203 extracted = extracted_kvs `unionDVarSet` extracted_tvs
1204
1205 -- | Gathers free variables to use as quantification candidates (in
1206 -- 'quantifyTyVars'). This might output the same var
1207 -- in both sets, if it's used in both a type and a kind.
1208 -- The variables to quantify must have a TcLevel strictly greater than
1209 -- the ambient level. (See Wrinkle in Note [Naughty quantification candidates])
1210 -- See Note [CandidatesQTvs determinism and order]
1211 -- See Note [Dependent type variables]
1212 candidateQTyVarsOfType :: TcType -- not necessarily zonked
1213 -> TcM CandidatesQTvs
1214 candidateQTyVarsOfType ty = collect_cand_qtvs False emptyVarSet mempty ty
1215
1216 -- | Like 'candidateQTyVarsOfType', but over a list of types
1217 -- The variables to quantify must have a TcLevel strictly greater than
1218 -- the ambient level. (See Wrinkle in Note [Naughty quantification candidates])
1219 candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs
1220 candidateQTyVarsOfTypes tys = foldlM (collect_cand_qtvs False emptyVarSet) mempty tys
1221
1222 -- | Like 'candidateQTyVarsOfType', but consider every free variable
1223 -- to be dependent. This is appropriate when generalizing a *kind*,
1224 -- instead of a type. (That way, -XNoPolyKinds will default the variables
1225 -- to Type.)
1226 candidateQTyVarsOfKind :: TcKind -- Not necessarily zonked
1227 -> TcM CandidatesQTvs
1228 candidateQTyVarsOfKind ty = collect_cand_qtvs True emptyVarSet mempty ty
1229
1230 candidateQTyVarsOfKinds :: [TcKind] -- Not necessarily zonked
1231 -> TcM CandidatesQTvs
1232 candidateQTyVarsOfKinds tys = foldM (collect_cand_qtvs True emptyVarSet) mempty tys
1233
1234 delCandidates :: CandidatesQTvs -> [Var] -> CandidatesQTvs
1235 delCandidates (DV { dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs }) vars
1236 = DV { dv_kvs = kvs `delDVarSetList` vars
1237 , dv_tvs = tvs `delDVarSetList` vars
1238 , dv_cvs = cvs `delVarSetList` vars }
1239
1240 collect_cand_qtvs
1241 :: Bool -- True <=> consider every fv in Type to be dependent
1242 -> VarSet -- Bound variables (locals only)
1243 -> CandidatesQTvs -- Accumulating parameter
1244 -> Type -- Not necessarily zonked
1245 -> TcM CandidatesQTvs
1246
1247 -- Key points:
1248 -- * Looks through meta-tyvars as it goes;
1249 -- no need to zonk in advance
1250 --
1251 -- * Needs to be monadic anyway, because it does the zap-naughty
1252 -- stuff; see Note [Naughty quantification candidates]
1253 --
1254 -- * Returns fully-zonked CandidateQTvs, including their kinds
1255 -- so that subsequent dependency analysis (to build a well
1256 -- scoped telescope) works correctly
1257
1258 collect_cand_qtvs is_dep bound dvs ty
1259 = go dvs ty
1260 where
1261 is_bound tv = tv `elemVarSet` bound
1262
1263 -----------------
1264 go :: CandidatesQTvs -> TcType -> TcM CandidatesQTvs
1265 -- Uses accumulating-parameter style
1266 go dv (AppTy t1 t2) = foldlM go dv [t1, t2]
1267 go dv (TyConApp _ tys) = foldlM go dv tys
1268 go dv (FunTy _ arg res) = foldlM go dv [arg, res]
1269 go dv (LitTy {}) = return dv
1270 go dv (CastTy ty co) = do dv1 <- go dv ty
1271 collect_cand_qtvs_co bound dv1 co
1272 go dv (CoercionTy co) = collect_cand_qtvs_co bound dv co
1273
1274 go dv (TyVarTy tv)
1275 | is_bound tv = return dv
1276 | otherwise = do { m_contents <- isFilledMetaTyVar_maybe tv
1277 ; case m_contents of
1278 Just ind_ty -> go dv ind_ty
1279 Nothing -> go_tv dv tv }
1280
1281 go dv (ForAllTy (Bndr tv _) ty)
1282 = do { dv1 <- collect_cand_qtvs True bound dv (tyVarKind tv)
1283 ; collect_cand_qtvs is_dep (bound `extendVarSet` tv) dv1 ty }
1284
1285 -----------------
1286 go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv
1287 | tv `elemDVarSet` kvs
1288 = return dv -- We have met this tyvar aleady
1289
1290 | not is_dep
1291 , tv `elemDVarSet` tvs
1292 = return dv -- We have met this tyvar aleady
1293
1294 | otherwise
1295 = do { tv_kind <- zonkTcType (tyVarKind tv)
1296 -- This zonk is annoying, but it is necessary, both to
1297 -- ensure that the collected candidates have zonked kinds
1298 -- (#15795) and to make the naughty check
1299 -- (which comes next) works correctly
1300
1301 ; cur_lvl <- getTcLevel
1302 ; if | tcTyVarLevel tv <= cur_lvl
1303 -> return dv -- this variable is from an outer context; skip
1304 -- See Note [Use level numbers ofor quantification]
1305
1306 | intersectsVarSet bound (tyCoVarsOfType tv_kind)
1307 -- the tyvar must not be from an outer context, but we have
1308 -- already checked for this.
1309 -- See Note [Naughty quantification candidates]
1310 -> do { traceTc "Zapping naughty quantifier" $
1311 vcat [ ppr tv <+> dcolon <+> ppr tv_kind
1312 , text "bound:" <+> pprTyVars (nonDetEltsUniqSet bound)
1313 , text "fvs:" <+> pprTyVars (nonDetEltsUniqSet $
1314 tyCoVarsOfType tv_kind) ]
1315
1316 ; writeMetaTyVar tv (anyTypeOfKind tv_kind)
1317
1318 -- See Note [Recurring into kinds for candidateQTyVars]
1319 ; collect_cand_qtvs True bound dv tv_kind }
1320
1321 | otherwise
1322 -> do { let tv' = tv `setTyVarKind` tv_kind
1323 dv' | is_dep = dv { dv_kvs = kvs `extendDVarSet` tv' }
1324 | otherwise = dv { dv_tvs = tvs `extendDVarSet` tv' }
1325 -- See Note [Order of accumulation]
1326
1327 -- See Note [Recurring into kinds for candidateQTyVars]
1328 ; collect_cand_qtvs True bound dv' tv_kind } }
1329
1330 collect_cand_qtvs_co :: VarSet -- bound variables
1331 -> CandidatesQTvs -> Coercion
1332 -> TcM CandidatesQTvs
1333 collect_cand_qtvs_co bound = go_co
1334 where
1335 go_co dv (Refl ty) = collect_cand_qtvs True bound dv ty
1336 go_co dv (GRefl _ ty mco) = do dv1 <- collect_cand_qtvs True bound dv ty
1337 go_mco dv1 mco
1338 go_co dv (TyConAppCo _ _ cos) = foldlM go_co dv cos
1339 go_co dv (AppCo co1 co2) = foldlM go_co dv [co1, co2]
1340 go_co dv (FunCo _ co1 co2) = foldlM go_co dv [co1, co2]
1341 go_co dv (AxiomInstCo _ _ cos) = foldlM go_co dv cos
1342 go_co dv (AxiomRuleCo _ cos) = foldlM go_co dv cos
1343 go_co dv (UnivCo prov _ t1 t2) = do dv1 <- go_prov dv prov
1344 dv2 <- collect_cand_qtvs True bound dv1 t1
1345 collect_cand_qtvs True bound dv2 t2
1346 go_co dv (SymCo co) = go_co dv co
1347 go_co dv (TransCo co1 co2) = foldlM go_co dv [co1, co2]
1348 go_co dv (NthCo _ _ co) = go_co dv co
1349 go_co dv (LRCo _ co) = go_co dv co
1350 go_co dv (InstCo co1 co2) = foldlM go_co dv [co1, co2]
1351 go_co dv (KindCo co) = go_co dv co
1352 go_co dv (SubCo co) = go_co dv co
1353
1354 go_co dv (HoleCo hole)
1355 = do m_co <- unpackCoercionHole_maybe hole
1356 case m_co of
1357 Just co -> go_co dv co
1358 Nothing -> go_cv dv (coHoleCoVar hole)
1359
1360 go_co dv (CoVarCo cv) = go_cv dv cv
1361
1362 go_co dv (ForAllCo tcv kind_co co)
1363 = do { dv1 <- go_co dv kind_co
1364 ; collect_cand_qtvs_co (bound `extendVarSet` tcv) dv1 co }
1365
1366 go_mco dv MRefl = return dv
1367 go_mco dv (MCo co) = go_co dv co
1368
1369 go_prov dv UnsafeCoerceProv = return dv
1370 go_prov dv (PhantomProv co) = go_co dv co
1371 go_prov dv (ProofIrrelProv co) = go_co dv co
1372 go_prov dv (PluginProv _) = return dv
1373
1374 go_cv :: CandidatesQTvs -> CoVar -> TcM CandidatesQTvs
1375 go_cv dv@(DV { dv_cvs = cvs }) cv
1376 | is_bound cv = return dv
1377 | cv `elemVarSet` cvs = return dv
1378
1379 -- See Note [Recurring into kinds for candidateQTyVars]
1380 | otherwise = collect_cand_qtvs True bound
1381 (dv { dv_cvs = cvs `extendVarSet` cv })
1382 (idType cv)
1383
1384 is_bound tv = tv `elemVarSet` bound
1385
1386 {- Note [Order of accumulation]
1387 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1388 You might be tempted (like I was) to use unitDVarSet and mappend
1389 rather than extendDVarSet. However, the union algorithm for
1390 deterministic sets depends on (roughly) the size of the sets. The
1391 elements from the smaller set end up to the right of the elements from
1392 the larger one. When sets are equal, the left-hand argument to
1393 `mappend` goes to the right of the right-hand argument.
1394
1395 In our case, if we use unitDVarSet and mappend, we learn that the free
1396 variables of (a -> b -> c -> d) are [b, a, c, d], and we then quantify
1397 over them in that order. (The a comes after the b because we union the
1398 singleton sets as ({a} `mappend` {b}), producing {b, a}. Thereafter,
1399 the size criterion works to our advantage.) This is just annoying to
1400 users, so I use `extendDVarSet`, which unambiguously puts the new
1401 element to the right.
1402
1403 Note that the unitDVarSet/mappend implementation would not be wrong
1404 against any specification -- just suboptimal and confounding to users.
1405
1406 Note [Recurring into kinds for candidateQTyVars]
1407 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1408 First, read Note [Closing over free variable kinds] in TyCoFVs, paying
1409 attention to the end of the Note about using an empty bound set when
1410 traversing a variable's kind.
1411
1412 That Note concludes with the recommendation that we empty out the bound
1413 set when recurring into the kind of a type variable. Yet, we do not do
1414 this here. I have two tasks in order to convince you that this code is
1415 right. First, I must show why it is safe to ignore the reasoning in that
1416 Note. Then, I must show why is is necessary to contradict the reasoning in
1417 that Note.
1418
1419 Why it is safe: There can be no
1420 shadowing in the candidateQ... functions: they work on the output of
1421 type inference, which is seeded by the renamer and its insistence to
1422 use different Uniques for different variables. (In contrast, the Core
1423 functions work on the output of optimizations, which may introduce
1424 shadowing.) Without shadowing, the problem studied by
1425 Note [Closing over free variable kinds] in TyCoFVs cannot happen.
1426
1427 Why it is necessary:
1428 Wiping the bound set would be just plain wrong here. Consider
1429
1430 forall k1 k2 (a :: k1). Proxy k2 (a |> (hole :: k1 ~# k2))
1431
1432 We really don't want to think k1 and k2 are free here. (It's true that we'll
1433 never be able to fill in `hole`, but we don't want to go off the rails just
1434 because we have an insoluble coercion hole.) So: why is it wrong to wipe
1435 the bound variables here but right in Core? Because the final statement
1436 in Note [Closing over free variable kinds] in TyCoFVs is wrong: not
1437 every variable is either free or bound. A variable can be a hole, too!
1438 The reasoning in that Note then breaks down.
1439
1440 And the reasoning applies just as well to free non-hole variables, so we
1441 retain the bound set always.
1442
1443 -}
1444
1445 {- *********************************************************************
1446 * *
1447 Quantification
1448 * *
1449 ************************************************************************
1450
1451 Note [quantifyTyVars]
1452 ~~~~~~~~~~~~~~~~~~~~~
1453 quantifyTyVars is given the free vars of a type that we
1454 are about to wrap in a forall.
1455
1456 It takes these free type/kind variables (partitioned into dependent and
1457 non-dependent variables) skolemises metavariables with a TcLevel greater
1458 than the ambient level (see Note [Use level numbers of quantification]).
1459
1460 * This function distinguishes between dependent and non-dependent
1461 variables only to keep correct defaulting behavior with -XNoPolyKinds.
1462 With -XPolyKinds, it treats both classes of variables identically.
1463
1464 * quantifyTyVars never quantifies over
1465 - a coercion variable (or any tv mentioned in the kind of a covar)
1466 - a runtime-rep variable
1467
1468 Note [Use level numbers for quantification]
1469 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1470 The level numbers assigned to metavariables are very useful. Not only
1471 do they track touchability (Note [TcLevel and untouchable type variables]
1472 in TcType), but they also allow us to determine which variables to
1473 generalise. The rule is this:
1474
1475 When generalising, quantify only metavariables with a TcLevel greater
1476 than the ambient level.
1477
1478 This works because we bump the level every time we go inside a new
1479 source-level construct. In a traditional generalisation algorithm, we
1480 would gather all free variables that aren't free in an environment.
1481 However, if a variable is in that environment, it will always have a lower
1482 TcLevel: it came from an outer scope. So we can replace the "free in
1483 environment" check with a level-number check.
1484
1485 Here is an example:
1486
1487 f x = x + (z True)
1488 where
1489 z y = x * x
1490
1491 We start by saying (x :: alpha[1]). When inferring the type of z, we'll
1492 quickly discover that z :: alpha[1]. But it would be disastrous to
1493 generalise over alpha in the type of z. So we need to know that alpha
1494 comes from an outer environment. By contrast, the type of y is beta[2],
1495 and we are free to generalise over it. What's the difference between
1496 alpha[1] and beta[2]? Their levels. beta[2] has the right TcLevel for
1497 generalisation, and so we generalise it. alpha[1] does not, and so
1498 we leave it alone.
1499
1500 Note that not *every* variable with a higher level will get generalised,
1501 either due to the monomorphism restriction or other quirks. See, for
1502 example, the code in TcSimplify.decideMonoTyVars and in
1503 TcHsType.kindGeneralizeSome, both of which exclude certain otherwise-eligible
1504 variables from being generalised.
1505
1506 Using level numbers for quantification is implemented in the candidateQTyVars...
1507 functions, by adding only those variables with a level strictly higher than
1508 the ambient level to the set of candidates.
1509
1510 Note [quantifyTyVars determinism]
1511 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1512 The results of quantifyTyVars are wrapped in a forall and can end up in the
1513 interface file. One such example is inferred type signatures. They also affect
1514 the results of optimizations, for example worker-wrapper. This means that to
1515 get deterministic builds quantifyTyVars needs to be deterministic.
1516
1517 To achieve this CandidatesQTvs is backed by deterministic sets which allows them
1518 to be later converted to a list in a deterministic order.
1519
1520 For more information about deterministic sets see
1521 Note [Deterministic UniqFM] in UniqDFM.
1522 -}
1523
1524 quantifyTyVars
1525 :: CandidatesQTvs -- See Note [Dependent type variables]
1526 -- Already zonked
1527 -> TcM [TcTyVar]
1528 -- See Note [quantifyTyVars]
1529 -- Can be given a mixture of TcTyVars and TyVars, in the case of
1530 -- associated type declarations. Also accepts covars, but *never* returns any.
1531 -- According to Note [Use level numbers for quantification] and the
1532 -- invariants on CandidateQTvs, we do not have to filter out variables
1533 -- free in the environment here. Just quantify unconditionally, subject
1534 -- to the restrictions in Note [quantifyTyVars].
1535 quantifyTyVars dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
1536 -- short-circuit common case
1537 | isEmptyDVarSet dep_tkvs
1538 , isEmptyDVarSet nondep_tkvs
1539 = do { traceTc "quantifyTyVars has nothing to quantify" empty
1540 ; return [] }
1541
1542 | otherwise
1543 = do { traceTc "quantifyTyVars 1" (ppr dvs)
1544
1545 ; let dep_kvs = scopedSort $ dVarSetElems dep_tkvs
1546 -- scopedSort: put the kind variables into
1547 -- well-scoped order.
1548 -- E.g. [k, (a::k)] not the other way roud
1549
1550 nondep_tvs = dVarSetElems (nondep_tkvs `minusDVarSet` dep_tkvs)
1551 -- See Note [Dependent type variables]
1552 -- The `minus` dep_tkvs removes any kind-level vars
1553 -- e.g. T k (a::k) Since k appear in a kind it'll
1554 -- be in dv_kvs, and is dependent. So remove it from
1555 -- dv_tvs which will also contain k
1556 -- NB kinds of tvs are zonked by zonkTyCoVarsAndFV
1557
1558 -- In the non-PolyKinds case, default the kind variables
1559 -- to *, and zonk the tyvars as usual. Notice that this
1560 -- may make quantifyTyVars return a shorter list
1561 -- than it was passed, but that's ok
1562 ; poly_kinds <- xoptM LangExt.PolyKinds
1563 ; dep_kvs' <- mapMaybeM (zonk_quant (not poly_kinds)) dep_kvs
1564 ; nondep_tvs' <- mapMaybeM (zonk_quant False) nondep_tvs
1565 ; let final_qtvs = dep_kvs' ++ nondep_tvs'
1566 -- Because of the order, any kind variables
1567 -- mentioned in the kinds of the nondep_tvs'
1568 -- now refer to the dep_kvs'
1569
1570 ; traceTc "quantifyTyVars 2"
1571 (vcat [ text "nondep:" <+> pprTyVars nondep_tvs
1572 , text "dep:" <+> pprTyVars dep_kvs
1573 , text "dep_kvs'" <+> pprTyVars dep_kvs'
1574 , text "nondep_tvs'" <+> pprTyVars nondep_tvs' ])
1575
1576 -- We should never quantify over coercion variables; check this
1577 ; let co_vars = filter isCoVar final_qtvs
1578 ; MASSERT2( null co_vars, ppr co_vars )
1579
1580 ; return final_qtvs }
1581 where
1582 -- zonk_quant returns a tyvar if it should be quantified over;
1583 -- otherwise, it returns Nothing. The latter case happens for
1584 -- * Kind variables, with -XNoPolyKinds: don't quantify over these
1585 -- * RuntimeRep variables: we never quantify over these
1586 zonk_quant default_kind tkv
1587 | not (isTyVar tkv)
1588 = return Nothing -- this can happen for a covar that's associated with
1589 -- a coercion hole. Test case: typecheck/should_compile/T2494
1590
1591 | not (isTcTyVar tkv)
1592 = return (Just tkv) -- For associated types in a class with a standalone
1593 -- kind signature, we have the class variables in
1594 -- scope, and they are TyVars not TcTyVars
1595 | otherwise
1596 = do { deflt_done <- defaultTyVar default_kind tkv
1597 ; case deflt_done of
1598 True -> return Nothing
1599 False -> do { tv <- skolemiseQuantifiedTyVar tkv
1600 ; return (Just tv) } }
1601
1602 isQuantifiableTv :: TcLevel -- Level of the context, outside the quantification
1603 -> TcTyVar
1604 -> Bool
1605 isQuantifiableTv outer_tclvl tcv
1606 | isTcTyVar tcv -- Might be a CoVar; change this when gather covars separately
1607 = tcTyVarLevel tcv > outer_tclvl
1608 | otherwise
1609 = False
1610
1611 zonkAndSkolemise :: TcTyCoVar -> TcM TcTyCoVar
1612 -- A tyvar binder is never a unification variable (TauTv),
1613 -- rather it is always a skolem. It *might* be a TyVarTv.
1614 -- (Because non-CUSK type declarations use TyVarTvs.)
1615 -- Regardless, it may have a kind that has not yet been zonked,
1616 -- and may include kind unification variables.
1617 zonkAndSkolemise tyvar
1618 | isTyVarTyVar tyvar
1619 -- We want to preserve the binding location of the original TyVarTv.
1620 -- This is important for error messages. If we don't do this, then
1621 -- we get bad locations in, e.g., typecheck/should_fail/T2688
1622 = do { zonked_tyvar <- zonkTcTyVarToTyVar tyvar
1623 ; skolemiseQuantifiedTyVar zonked_tyvar }
1624
1625 | otherwise
1626 = ASSERT2( isImmutableTyVar tyvar || isCoVar tyvar, pprTyVar tyvar )
1627 zonkTyCoVarKind tyvar
1628
1629 skolemiseQuantifiedTyVar :: TcTyVar -> TcM TcTyVar
1630 -- The quantified type variables often include meta type variables
1631 -- we want to freeze them into ordinary type variables
1632 -- The meta tyvar is updated to point to the new skolem TyVar. Now any
1633 -- bound occurrences of the original type variable will get zonked to
1634 -- the immutable version.
1635 --
1636 -- We leave skolem TyVars alone; they are immutable.
1637 --
1638 -- This function is called on both kind and type variables,
1639 -- but kind variables *only* if PolyKinds is on.
1640
1641 skolemiseQuantifiedTyVar tv
1642 = case tcTyVarDetails tv of
1643 SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv)
1644 ; return (setTyVarKind tv kind) }
1645 -- It might be a skolem type variable,
1646 -- for example from a user type signature
1647
1648 MetaTv {} -> skolemiseUnboundMetaTyVar tv
1649
1650 _other -> pprPanic "skolemiseQuantifiedTyVar" (ppr tv) -- RuntimeUnk
1651
1652 defaultTyVar :: Bool -- True <=> please default this kind variable to *
1653 -> TcTyVar -- If it's a MetaTyVar then it is unbound
1654 -> TcM Bool -- True <=> defaulted away altogether
1655
1656 defaultTyVar default_kind tv
1657 | not (isMetaTyVar tv)
1658 = return False
1659
1660 | isTyVarTyVar tv
1661 -- Do not default TyVarTvs. Doing so would violate the invariants
1662 -- on TyVarTvs; see Note [Signature skolems] in TcType.
1663 -- #13343 is an example; #14555 is another
1664 -- See Note [Inferring kinds for type declarations] in TcTyClsDecls
1665 = return False
1666
1667
1668 | isRuntimeRepVar tv -- Do not quantify over a RuntimeRep var
1669 -- unless it is a TyVarTv, handled earlier
1670 = do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv)
1671 ; writeMetaTyVar tv liftedRepTy
1672 ; return True }
1673
1674 | default_kind -- -XNoPolyKinds and this is a kind var
1675 = default_kind_var tv -- so default it to * if possible
1676
1677 | otherwise
1678 = return False
1679
1680 where
1681 default_kind_var :: TyVar -> TcM Bool
1682 -- defaultKindVar is used exclusively with -XNoPolyKinds
1683 -- See Note [Defaulting with -XNoPolyKinds]
1684 -- It takes an (unconstrained) meta tyvar and defaults it.
1685 -- Works only on vars of type *; for other kinds, it issues an error.
1686 default_kind_var kv
1687 | isLiftedTypeKind (tyVarKind kv)
1688 = do { traceTc "Defaulting a kind var to *" (ppr kv)
1689 ; writeMetaTyVar kv liftedTypeKind
1690 ; return True }
1691 | otherwise
1692 = do { addErr (vcat [ text "Cannot default kind variable" <+> quotes (ppr kv')
1693 , text "of kind:" <+> ppr (tyVarKind kv')
1694 , text "Perhaps enable PolyKinds or add a kind signature" ])
1695 -- We failed to default it, so return False to say so.
1696 -- Hence, it'll get skolemised. That might seem odd, but we must either
1697 -- promote, skolemise, or zap-to-Any, to satisfy TcHsType
1698 -- Note [Recipe for checking a signature]
1699 -- Otherwise we get level-number assertion failures. It doesn't matter much
1700 -- because we are in an error siutation anyway.
1701 ; return False
1702 }
1703 where
1704 (_, kv') = tidyOpenTyCoVar emptyTidyEnv kv
1705
1706 skolemiseUnboundMetaTyVar :: TcTyVar -> TcM TyVar
1707 -- We have a Meta tyvar with a ref-cell inside it
1708 -- Skolemise it, so that we are totally out of Meta-tyvar-land
1709 -- We create a skolem TcTyVar, not a regular TyVar
1710 -- See Note [Zonking to Skolem]
1711 skolemiseUnboundMetaTyVar tv
1712 = ASSERT2( isMetaTyVar tv, ppr tv )
1713 do { when debugIsOn (check_empty tv)
1714 ; span <- getSrcSpanM -- Get the location from "here"
1715 -- ie where we are generalising
1716 ; kind <- zonkTcType (tyVarKind tv)
1717 ; let uniq = getUnique tv
1718 -- NB: Use same Unique as original tyvar. This is
1719 -- convenient in reading dumps, but is otherwise inessential.
1720
1721 tv_name = getOccName tv
1722 final_name = mkInternalName uniq tv_name span
1723 final_tv = mkTcTyVar final_name kind details
1724
1725 ; traceTc "Skolemising" (ppr tv <+> text ":=" <+> ppr final_tv)
1726 ; writeMetaTyVar tv (mkTyVarTy final_tv)
1727 ; return final_tv }
1728
1729 where
1730 details = SkolemTv (metaTyVarTcLevel tv) False
1731 check_empty tv -- [Sept 04] Check for non-empty.
1732 = when debugIsOn $ -- See note [Silly Type Synonym]
1733 do { cts <- readMetaTyVar tv
1734 ; case cts of
1735 Flexi -> return ()
1736 Indirect ty -> WARN( True, ppr tv $$ ppr ty )
1737 return () }
1738
1739 {- Note [Defaulting with -XNoPolyKinds]
1740 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1741 Consider
1742
1743 data Compose f g a = Mk (f (g a))
1744
1745 We infer
1746
1747 Compose :: forall k1 k2. (k2 -> *) -> (k1 -> k2) -> k1 -> *
1748 Mk :: forall k1 k2 (f :: k2 -> *) (g :: k1 -> k2) (a :: k1).
1749 f (g a) -> Compose k1 k2 f g a
1750
1751 Now, in another module, we have -XNoPolyKinds -XDataKinds in effect.
1752 What does 'Mk mean? Pre GHC-8.0 with -XNoPolyKinds,
1753 we just defaulted all kind variables to *. But that's no good here,
1754 because the kind variables in 'Mk aren't of kind *, so defaulting to *
1755 is ill-kinded.
1756
1757 After some debate on #11334, we decided to issue an error in this case.
1758 The code is in defaultKindVar.
1759
1760 Note [What is a meta variable?]
1761 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1762 A "meta type-variable", also know as a "unification variable" is a placeholder
1763 introduced by the typechecker for an as-yet-unknown monotype.
1764
1765 For example, when we see a call `reverse (f xs)`, we know that we calling
1766 reverse :: forall a. [a] -> [a]
1767 So we know that the argument `f xs` must be a "list of something". But what is
1768 the "something"? We don't know until we explore the `f xs` a bit more. So we set
1769 out what we do know at the call of `reverse` by instantiate its type with a fresh
1770 meta tyvar, `alpha` say. So now the type of the argument `f xs`, and of the
1771 result, is `[alpha]`. The unification variable `alpha` stands for the
1772 as-yet-unknown type of the elements of the list.
1773
1774 As type inference progresses we may learn more about `alpha`. For example, suppose
1775 `f` has the type
1776 f :: forall b. b -> [Maybe b]
1777 Then we instantiate `f`'s type with another fresh unification variable, say
1778 `beta`; and equate `f`'s result type with reverse's argument type, thus
1779 `[alpha] ~ [Maybe beta]`.
1780
1781 Now we can solve this equality to learn that `alpha ~ Maybe beta`, so we've
1782 refined our knowledge about `alpha`. And so on.
1783
1784 If you found this Note useful, you may also want to have a look at
1785 Section 5 of "Practical type inference for higher rank types" (Peyton Jones,
1786 Vytiniotis, Weirich and Shields. J. Functional Programming. 2011).
1787
1788 Note [What is zonking?]
1789 ~~~~~~~~~~~~~~~~~~~~~~~
1790 GHC relies heavily on mutability in the typechecker for efficient operation.
1791 For this reason, throughout much of the type checking process meta type
1792 variables (the MetaTv constructor of TcTyVarDetails) are represented by mutable
1793 variables (known as TcRefs).
1794
1795 Zonking is the process of ripping out these mutable variables and replacing them
1796 with a real Type. This involves traversing the entire type expression, but the
1797 interesting part of replacing the mutable variables occurs in zonkTyVarOcc.
1798
1799 There are two ways to zonk a Type:
1800
1801 * zonkTcTypeToType, which is intended to be used at the end of type-checking
1802 for the final zonk. It has to deal with unfilled metavars, either by filling
1803 it with a value like Any or failing (determined by the UnboundTyVarZonker
1804 used).
1805
1806 * zonkTcType, which will happily ignore unfilled metavars. This is the
1807 appropriate function to use while in the middle of type-checking.
1808
1809 Note [Zonking to Skolem]
1810 ~~~~~~~~~~~~~~~~~~~~~~~~
1811 We used to zonk quantified type variables to regular TyVars. However, this
1812 leads to problems. Consider this program from the regression test suite:
1813
1814 eval :: Int -> String -> String -> String
1815 eval 0 root actual = evalRHS 0 root actual
1816
1817 evalRHS :: Int -> a
1818 evalRHS 0 root actual = eval 0 root actual
1819
1820 It leads to the deferral of an equality (wrapped in an implication constraint)
1821
1822 forall a. () => ((String -> String -> String) ~ a)
1823
1824 which is propagated up to the toplevel (see TcSimplify.tcSimplifyInferCheck).
1825 In the meantime `a' is zonked and quantified to form `evalRHS's signature.
1826 This has the *side effect* of also zonking the `a' in the deferred equality
1827 (which at this point is being handed around wrapped in an implication
1828 constraint).
1829
1830 Finally, the equality (with the zonked `a') will be handed back to the
1831 simplifier by TcRnDriver.tcRnSrcDecls calling TcSimplify.tcSimplifyTop.
1832 If we zonk `a' with a regular type variable, we will have this regular type
1833 variable now floating around in the simplifier, which in many places assumes to
1834 only see proper TcTyVars.
1835
1836 We can avoid this problem by zonking with a skolem. The skolem is rigid
1837 (which we require for a quantified variable), but is still a TcTyVar that the
1838 simplifier knows how to deal with.
1839
1840 Note [Silly Type Synonyms]
1841 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1842 Consider this:
1843 type C u a = u -- Note 'a' unused
1844
1845 foo :: (forall a. C u a -> C u a) -> u
1846 foo x = ...
1847
1848 bar :: Num u => u
1849 bar = foo (\t -> t + t)
1850
1851 * From the (\t -> t+t) we get type {Num d} => d -> d
1852 where d is fresh.
1853
1854 * Now unify with type of foo's arg, and we get:
1855 {Num (C d a)} => C d a -> C d a
1856 where a is fresh.
1857
1858 * Now abstract over the 'a', but float out the Num (C d a) constraint
1859 because it does not 'really' mention a. (see exactTyVarsOfType)
1860 The arg to foo becomes
1861 \/\a -> \t -> t+t
1862
1863 * So we get a dict binding for Num (C d a), which is zonked to give
1864 a = ()
1865 [Note Sept 04: now that we are zonking quantified type variables
1866 on construction, the 'a' will be frozen as a regular tyvar on
1867 quantification, so the floated dict will still have type (C d a).
1868 Which renders this whole note moot; happily!]
1869
1870 * Then the \/\a abstraction has a zonked 'a' in it.
1871
1872 All very silly. I think its harmless to ignore the problem. We'll end up with
1873 a \/\a in the final result but all the occurrences of a will be zonked to ()
1874
1875 ************************************************************************
1876 * *
1877 Zonking types
1878 * *
1879 ************************************************************************
1880
1881 -}
1882
1883 zonkTcTypeAndFV :: TcType -> TcM DTyCoVarSet
1884 -- Zonk a type and take its free variables
1885 -- With kind polymorphism it can be essential to zonk *first*
1886 -- so that we find the right set of free variables. Eg
1887 -- forall k1. forall (a:k2). a
1888 -- where k2:=k1 is in the substitution. We don't want
1889 -- k2 to look free in this type!
1890 zonkTcTypeAndFV ty
1891 = tyCoVarsOfTypeDSet <$> zonkTcType ty
1892
1893 zonkTyCoVar :: TyCoVar -> TcM TcType
1894 -- Works on TyVars and TcTyVars
1895 zonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv
1896 | isTyVar tv = mkTyVarTy <$> zonkTyCoVarKind tv
1897 | otherwise = ASSERT2( isCoVar tv, ppr tv )
1898 mkCoercionTy . mkCoVarCo <$> zonkTyCoVarKind tv
1899 -- Hackily, when typechecking type and class decls
1900 -- we have TyVars in scope added (only) in
1901 -- TcHsType.bindTyClTyVars, but it seems
1902 -- painful to make them into TcTyVars there
1903
1904 zonkTyCoVarsAndFV :: TyCoVarSet -> TcM TyCoVarSet
1905 zonkTyCoVarsAndFV tycovars
1906 = tyCoVarsOfTypes <$> mapM zonkTyCoVar (nonDetEltsUniqSet tycovars)
1907 -- It's OK to use nonDetEltsUniqSet here because we immediately forget about
1908 -- the ordering by turning it into a nondeterministic set and the order
1909 -- of zonking doesn't matter for determinism.
1910
1911 zonkDTyCoVarSetAndFV :: DTyCoVarSet -> TcM DTyCoVarSet
1912 zonkDTyCoVarSetAndFV tycovars
1913 = mkDVarSet <$> (zonkTyCoVarsAndFVList $ dVarSetElems tycovars)
1914
1915 -- Takes a list of TyCoVars, zonks them and returns a
1916 -- deterministically ordered list of their free variables.
1917 zonkTyCoVarsAndFVList :: [TyCoVar] -> TcM [TyCoVar]
1918 zonkTyCoVarsAndFVList tycovars
1919 = tyCoVarsOfTypesList <$> mapM zonkTyCoVar tycovars
1920
1921 zonkTcTyVars :: [TcTyVar] -> TcM [TcType]
1922 zonkTcTyVars tyvars = mapM zonkTcTyVar tyvars
1923
1924 ----------------- Types
1925 zonkTyCoVarKind :: TyCoVar -> TcM TyCoVar
1926 zonkTyCoVarKind tv = do { kind' <- zonkTcType (tyVarKind tv)
1927 ; return (setTyVarKind tv kind') }
1928
1929 zonkTcTypes :: [TcType] -> TcM [TcType]
1930 zonkTcTypes tys = mapM zonkTcType tys
1931
1932 {-
1933 ************************************************************************
1934 * *
1935 Zonking constraints
1936 * *
1937 ************************************************************************
1938 -}
1939
1940 zonkImplication :: Implication -> TcM Implication
1941 zonkImplication implic@(Implic { ic_skols = skols
1942 , ic_given = given
1943 , ic_wanted = wanted
1944 , ic_info = info })
1945 = do { skols' <- mapM zonkTyCoVarKind skols -- Need to zonk their kinds!
1946 -- as #7230 showed
1947 ; given' <- mapM zonkEvVar given
1948 ; info' <- zonkSkolemInfo info
1949 ; wanted' <- zonkWCRec wanted
1950 ; return (implic { ic_skols = skols'
1951 , ic_given = given'
1952 , ic_wanted = wanted'
1953 , ic_info = info' }) }
1954
1955 zonkEvVar :: EvVar -> TcM EvVar
1956 zonkEvVar var = do { ty' <- zonkTcType (varType var)
1957 ; return (setVarType var ty') }
1958
1959
1960 zonkWC :: WantedConstraints -> TcM WantedConstraints
1961 zonkWC wc = zonkWCRec wc
1962
1963 zonkWCRec :: WantedConstraints -> TcM WantedConstraints
1964 zonkWCRec (WC { wc_simple = simple, wc_impl = implic })
1965 = do { simple' <- zonkSimples simple
1966 ; implic' <- mapBagM zonkImplication implic
1967 ; return (WC { wc_simple = simple', wc_impl = implic' }) }
1968
1969 zonkSimples :: Cts -> TcM Cts
1970 zonkSimples cts = do { cts' <- mapBagM zonkCt' cts
1971 ; traceTc "zonkSimples done:" (ppr cts')
1972 ; return cts' }
1973
1974 zonkCt' :: Ct -> TcM Ct
1975 zonkCt' ct = zonkCt ct
1976
1977 {- Note [zonkCt behaviour]
1978 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1979 zonkCt tries to maintain the canonical form of a Ct. For example,
1980 - a CDictCan should stay a CDictCan;
1981 - a CTyEqCan should stay a CTyEqCan (if the LHS stays as a variable.).
1982 - a CHoleCan should stay a CHoleCan
1983 - a CIrredCan should stay a CIrredCan with its cc_insol flag intact
1984
1985 Why?, for example:
1986 - For CDictCan, the @TcSimplify.expandSuperClasses@ step, which runs after the
1987 simple wanted and plugin loop, looks for @CDictCan@s. If a plugin is in use,
1988 constraints are zonked before being passed to the plugin. This means if we
1989 don't preserve a canonical form, @expandSuperClasses@ fails to expand
1990 superclasses. This is what happened in #11525.
1991
1992 - For CHoleCan, once we forget that it's a hole, we can never recover that info.
1993
1994 - For CIrredCan we want to see if a constraint is insoluble with insolubleWC
1995
1996 NB: we do not expect to see any CFunEqCans, because zonkCt is only
1997 called on unflattened constraints.
1998
1999 NB: Constraints are always re-flattened etc by the canonicaliser in
2000 @TcCanonical@ even if they come in as CDictCan. Only canonical constraints that
2001 are actually in the inert set carry all the guarantees. So it is okay if zonkCt
2002 creates e.g. a CDictCan where the cc_tyars are /not/ function free.
2003 -}
2004
2005 zonkCt :: Ct -> TcM Ct
2006 zonkCt ct@(CHoleCan { cc_ev = ev })
2007 = do { ev' <- zonkCtEvidence ev
2008 ; return $ ct { cc_ev = ev' } }
2009
2010 zonkCt ct@(CDictCan { cc_ev = ev, cc_tyargs = args })
2011 = do { ev' <- zonkCtEvidence ev
2012 ; args' <- mapM zonkTcType args
2013 ; return $ ct { cc_ev = ev', cc_tyargs = args' } }
2014
2015 zonkCt ct@(CTyEqCan { cc_ev = ev, cc_tyvar = tv, cc_rhs = rhs })
2016 = do { ev' <- zonkCtEvidence ev
2017 ; tv_ty' <- zonkTcTyVar tv
2018 ; case getTyVar_maybe tv_ty' of
2019 Just tv' -> do { rhs' <- zonkTcType rhs
2020 ; return ct { cc_ev = ev'
2021 , cc_tyvar = tv'
2022 , cc_rhs = rhs' } }
2023 Nothing -> return (mkNonCanonical ev') }
2024
2025 zonkCt ct@(CIrredCan { cc_ev = ev }) -- Preserve the cc_insol flag
2026 = do { ev' <- zonkCtEvidence ev
2027 ; return (ct { cc_ev = ev' }) }
2028
2029 zonkCt ct
2030 = ASSERT( not (isCFunEqCan ct) )
2031 -- We do not expect to see any CFunEqCans, because zonkCt is only called on
2032 -- unflattened constraints.
2033 do { fl' <- zonkCtEvidence (ctEvidence ct)
2034 ; return (mkNonCanonical fl') }
2035
2036 zonkCtEvidence :: CtEvidence -> TcM CtEvidence
2037 zonkCtEvidence ctev@(CtGiven { ctev_pred = pred })
2038 = do { pred' <- zonkTcType pred
2039 ; return (ctev { ctev_pred = pred'}) }
2040 zonkCtEvidence ctev@(CtWanted { ctev_pred = pred, ctev_dest = dest })
2041 = do { pred' <- zonkTcType pred
2042 ; let dest' = case dest of
2043 EvVarDest ev -> EvVarDest $ setVarType ev pred'
2044 -- necessary in simplifyInfer
2045 HoleDest h -> HoleDest h
2046 ; return (ctev { ctev_pred = pred', ctev_dest = dest' }) }
2047 zonkCtEvidence ctev@(CtDerived { ctev_pred = pred })
2048 = do { pred' <- zonkTcType pred
2049 ; return (ctev { ctev_pred = pred' }) }
2050
2051 zonkSkolemInfo :: SkolemInfo -> TcM SkolemInfo
2052 zonkSkolemInfo (SigSkol cx ty tv_prs) = do { ty' <- zonkTcType ty
2053 ; return (SigSkol cx ty' tv_prs) }
2054 zonkSkolemInfo (InferSkol ntys) = do { ntys' <- mapM do_one ntys
2055 ; return (InferSkol ntys') }
2056 where
2057 do_one (n, ty) = do { ty' <- zonkTcType ty; return (n, ty') }
2058 zonkSkolemInfo skol_info = return skol_info
2059
2060 {-
2061 %************************************************************************
2062 %* *
2063 \subsection{Zonking -- the main work-horses: zonkTcType, zonkTcTyVar}
2064 * *
2065 * For internal use only! *
2066 * *
2067 ************************************************************************
2068
2069 -}
2070
2071 -- zonkId is used *during* typechecking just to zonk the Id's type
2072 zonkId :: TcId -> TcM TcId
2073 zonkId id
2074 = do { ty' <- zonkTcType (idType id)
2075 ; return (Id.setIdType id ty') }
2076
2077 zonkCoVar :: CoVar -> TcM CoVar
2078 zonkCoVar = zonkId
2079
2080 -- | A suitable TyCoMapper for zonking a type during type-checking,
2081 -- before all metavars are filled in.
2082 zonkTcTypeMapper :: TyCoMapper () TcM
2083 zonkTcTypeMapper = TyCoMapper
2084 { tcm_tyvar = const zonkTcTyVar
2085 , tcm_covar = const (\cv -> mkCoVarCo <$> zonkTyCoVarKind cv)
2086 , tcm_hole = hole
2087 , tcm_tycobinder = \_env tv _vis -> ((), ) <$> zonkTyCoVarKind tv
2088 , tcm_tycon = zonkTcTyCon }
2089 where
2090 hole :: () -> CoercionHole -> TcM Coercion
2091 hole _ hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
2092 = do { contents <- readTcRef ref
2093 ; case contents of
2094 Just co -> do { co' <- zonkCo co
2095 ; checkCoercionHole cv co' }
2096 Nothing -> do { cv' <- zonkCoVar cv
2097 ; return $ HoleCo (hole { ch_co_var = cv' }) } }
2098
2099 zonkTcTyCon :: TcTyCon -> TcM TcTyCon
2100 -- Only called on TcTyCons
2101 -- A non-poly TcTyCon may have unification
2102 -- variables that need zonking, but poly ones cannot
2103 zonkTcTyCon tc
2104 | tcTyConIsPoly tc = return tc
2105 | otherwise = do { tck' <- zonkTcType (tyConKind tc)
2106 ; return (setTcTyConKind tc tck') }
2107
2108 -- For unbound, mutable tyvars, zonkType uses the function given to it
2109 -- For tyvars bound at a for-all, zonkType zonks them to an immutable
2110 -- type variable and zonks the kind too
2111 zonkTcType :: TcType -> TcM TcType
2112 zonkTcType = mapType zonkTcTypeMapper ()
2113
2114 -- | "Zonk" a coercion -- really, just zonk any types in the coercion
2115 zonkCo :: Coercion -> TcM Coercion
2116 zonkCo = mapCoercion zonkTcTypeMapper ()
2117
2118 zonkTcTyVar :: TcTyVar -> TcM TcType
2119 -- Simply look through all Flexis
2120 zonkTcTyVar tv
2121 | isTcTyVar tv
2122 = case tcTyVarDetails tv of
2123 SkolemTv {} -> zonk_kind_and_return
2124 RuntimeUnk {} -> zonk_kind_and_return
2125 MetaTv { mtv_ref = ref }
2126 -> do { cts <- readMutVar ref
2127 ; case cts of
2128 Flexi -> zonk_kind_and_return
2129 Indirect ty -> do { zty <- zonkTcType ty
2130 ; writeTcRef ref (Indirect zty)
2131 -- See Note [Sharing in zonking]
2132 ; return zty } }
2133
2134 | otherwise -- coercion variable
2135 = zonk_kind_and_return
2136 where
2137 zonk_kind_and_return = do { z_tv <- zonkTyCoVarKind tv
2138 ; return (mkTyVarTy z_tv) }
2139
2140 -- Variant that assumes that any result of zonking is still a TyVar.
2141 -- Should be used only on skolems and TyVarTvs
2142 zonkTcTyVarToTyVar :: HasDebugCallStack => TcTyVar -> TcM TcTyVar
2143 zonkTcTyVarToTyVar tv
2144 = do { ty <- zonkTcTyVar tv
2145 ; let tv' = case tcGetTyVar_maybe ty of
2146 Just tv' -> tv'
2147 Nothing -> pprPanic "zonkTcTyVarToTyVar"
2148 (ppr tv $$ ppr ty)
2149 ; return tv' }
2150
2151 zonkTyVarTyVarPairs :: [(Name,TcTyVar)] -> TcM [(Name,TcTyVar)]
2152 zonkTyVarTyVarPairs prs
2153 = mapM do_one prs
2154 where
2155 do_one (nm, tv) = do { tv' <- zonkTcTyVarToTyVar tv
2156 ; return (nm, tv') }
2157
2158 {- Note [Sharing in zonking]
2159 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2160 Suppose we have
2161 alpha :-> beta :-> gamma :-> ty
2162 where the ":->" means that the unification variable has been
2163 filled in with Indirect. Then when zonking alpha, it'd be nice
2164 to short-circuit beta too, so we end up with
2165 alpha :-> zty
2166 beta :-> zty
2167 gamma :-> zty
2168 where zty is the zonked version of ty. That way, if we come across
2169 beta later, we'll have less work to do. (And indeed the same for
2170 alpha.)
2171
2172 This is easily achieved: just overwrite (Indirect ty) with (Indirect
2173 zty). Non-systematic perf comparisons suggest that this is a modest
2174 win.
2175
2176 But c.f Note [Sharing when zonking to Type] in TcHsSyn.
2177
2178 %************************************************************************
2179 %* *
2180 Tidying
2181 * *
2182 ************************************************************************
2183 -}
2184
2185 zonkTidyTcType :: TidyEnv -> TcType -> TcM (TidyEnv, TcType)
2186 zonkTidyTcType env ty = do { ty' <- zonkTcType ty
2187 ; return (tidyOpenType env ty') }
2188
2189 zonkTidyTcTypes :: TidyEnv -> [TcType] -> TcM (TidyEnv, [TcType])
2190 zonkTidyTcTypes = zonkTidyTcTypes' []
2191 where zonkTidyTcTypes' zs env [] = return (env, reverse zs)
2192 zonkTidyTcTypes' zs env (ty:tys)
2193 = do { (env', ty') <- zonkTidyTcType env ty
2194 ; zonkTidyTcTypes' (ty':zs) env' tys }
2195
2196 zonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin)
2197 zonkTidyOrigin env (GivenOrigin skol_info)
2198 = do { skol_info1 <- zonkSkolemInfo skol_info
2199 ; let skol_info2 = tidySkolemInfo env skol_info1
2200 ; return (env, GivenOrigin skol_info2) }
2201 zonkTidyOrigin env orig@(TypeEqOrigin { uo_actual = act
2202 , uo_expected = exp })
2203 = do { (env1, act') <- zonkTidyTcType env act
2204 ; (env2, exp') <- zonkTidyTcType env1 exp
2205 ; return ( env2, orig { uo_actual = act'
2206 , uo_expected = exp' }) }
2207 zonkTidyOrigin env (KindEqOrigin ty1 m_ty2 orig t_or_k)
2208 = do { (env1, ty1') <- zonkTidyTcType env ty1
2209 ; (env2, m_ty2') <- case m_ty2 of
2210 Just ty2 -> second Just <$> zonkTidyTcType env1 ty2
2211 Nothing -> return (env1, Nothing)
2212 ; (env3, orig') <- zonkTidyOrigin env2 orig
2213 ; return (env3, KindEqOrigin ty1' m_ty2' orig' t_or_k) }
2214 zonkTidyOrigin env (FunDepOrigin1 p1 l1 p2 l2)
2215 = do { (env1, p1') <- zonkTidyTcType env p1
2216 ; (env2, p2') <- zonkTidyTcType env1 p2
2217 ; return (env2, FunDepOrigin1 p1' l1 p2' l2) }
2218 zonkTidyOrigin env (FunDepOrigin2 p1 o1 p2 l2)
2219 = do { (env1, p1') <- zonkTidyTcType env p1
2220 ; (env2, p2') <- zonkTidyTcType env1 p2
2221 ; (env3, o1') <- zonkTidyOrigin env2 o1
2222 ; return (env3, FunDepOrigin2 p1' o1' p2' l2) }
2223 zonkTidyOrigin env orig = return (env, orig)
2224
2225 ----------------
2226 tidyCt :: TidyEnv -> Ct -> Ct
2227 -- Used only in error reporting
2228 -- Also converts it to non-canonical
2229 tidyCt env ct
2230 = case ct of
2231 CHoleCan { cc_ev = ev }
2232 -> ct { cc_ev = tidy_ev env ev }
2233 _ -> mkNonCanonical (tidy_ev env (ctEvidence ct))
2234 where
2235 tidy_ev :: TidyEnv -> CtEvidence -> CtEvidence
2236 -- NB: we do not tidy the ctev_evar field because we don't
2237 -- show it in error messages
2238 tidy_ev env ctev@(CtGiven { ctev_pred = pred })
2239 = ctev { ctev_pred = tidyType env pred }
2240 tidy_ev env ctev@(CtWanted { ctev_pred = pred })
2241 = ctev { ctev_pred = tidyType env pred }
2242 tidy_ev env ctev@(CtDerived { ctev_pred = pred })
2243 = ctev { ctev_pred = tidyType env pred }
2244
2245 ----------------
2246 tidyEvVar :: TidyEnv -> EvVar -> EvVar
2247 tidyEvVar env var = setVarType var (tidyType env (varType var))
2248
2249 ----------------
2250 tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
2251 tidySkolemInfo env (DerivSkol ty) = DerivSkol (tidyType env ty)
2252 tidySkolemInfo env (SigSkol cx ty tv_prs) = tidySigSkol env cx ty tv_prs
2253 tidySkolemInfo env (InferSkol ids) = InferSkol (mapSnd (tidyType env) ids)
2254 tidySkolemInfo env (UnifyForAllSkol ty) = UnifyForAllSkol (tidyType env ty)
2255 tidySkolemInfo _ info = info
2256
2257 tidySigSkol :: TidyEnv -> UserTypeCtxt
2258 -> TcType -> [(Name,TcTyVar)] -> SkolemInfo
2259 -- We need to take special care when tidying SigSkol
2260 -- See Note [SigSkol SkolemInfo] in TcRnTypes
2261 tidySigSkol env cx ty tv_prs
2262 = SigSkol cx (tidy_ty env ty) tv_prs'
2263 where
2264 tv_prs' = mapSnd (tidyTyCoVarOcc env) tv_prs
2265 inst_env = mkNameEnv tv_prs'
2266
2267 tidy_ty env (ForAllTy (Bndr tv vis) ty)
2268 = ForAllTy (Bndr tv' vis) (tidy_ty env' ty)
2269 where
2270 (env', tv') = tidy_tv_bndr env tv
2271
2272 tidy_ty env ty@(FunTy _ arg res)
2273 = ty { ft_arg = tidyType env arg, ft_res = tidy_ty env res }
2274
2275 tidy_ty env ty = tidyType env ty
2276
2277 tidy_tv_bndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
2278 tidy_tv_bndr env@(occ_env, subst) tv
2279 | Just tv' <- lookupNameEnv inst_env (tyVarName tv)
2280 = ((occ_env, extendVarEnv subst tv tv'), tv')
2281
2282 | otherwise
2283 = tidyVarBndr env tv
2284
2285 -------------------------------------------------------------------------
2286 {-
2287 %************************************************************************
2288 %* *
2289 Levity polymorphism checks
2290 * *
2291 ************************************************************************
2292
2293 See Note [Levity polymorphism checking] in DsMonad
2294
2295 -}
2296
2297 -- | According to the rules around representation polymorphism
2298 -- (see https://gitlab.haskell.org/ghc/ghc/wikis/no-sub-kinds), no binder
2299 -- can have a representation-polymorphic type. This check ensures
2300 -- that we respect this rule. It is a bit regrettable that this error
2301 -- occurs in zonking, after which we should have reported all errors.
2302 -- But it's hard to see where else to do it, because this can be discovered
2303 -- only after all solving is done. And, perhaps most importantly, this
2304 -- isn't really a compositional property of a type system, so it's
2305 -- not a terrible surprise that the check has to go in an awkward spot.
2306 ensureNotLevPoly :: Type -- its zonked type
2307 -> SDoc -- where this happened
2308 -> TcM ()
2309 ensureNotLevPoly ty doc
2310 = whenNoErrs $ -- sometimes we end up zonking bogus definitions of type
2311 -- forall a. a. See, for example, test ghci/scripts/T9140
2312 checkForLevPoly doc ty
2313
2314 -- See Note [Levity polymorphism checking] in DsMonad
2315 checkForLevPoly :: SDoc -> Type -> TcM ()
2316 checkForLevPoly = checkForLevPolyX addErr
2317
2318 checkForLevPolyX :: Monad m
2319 => (SDoc -> m ()) -- how to report an error
2320 -> SDoc -> Type -> m ()
2321 checkForLevPolyX add_err extra ty
2322 | isTypeLevPoly ty
2323 = add_err (formatLevPolyErr ty $$ extra)
2324 | otherwise
2325 = return ()
2326
2327 formatLevPolyErr :: Type -- levity-polymorphic type
2328 -> SDoc
2329 formatLevPolyErr ty
2330 = hang (text "A levity-polymorphic type is not allowed here:")
2331 2 (vcat [ text "Type:" <+> pprWithTYPE tidy_ty
2332 , text "Kind:" <+> pprWithTYPE tidy_ki ])
2333 where
2334 (tidy_env, tidy_ty) = tidyOpenType emptyTidyEnv ty
2335 tidy_ki = tidyType tidy_env (tcTypeKind ty)