Fix haddocks for marker events in Debug.Trace
[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 :: Hole -> 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_hole = hole }
194
195 ----------------------------------------------
196 -- Cloning constraints
197 ----------------------------------------------
198
199 cloneWanted :: Ct -> TcM Ct
200 cloneWanted ct
201 | ev@(CtWanted { ctev_dest = HoleDest {}, ctev_pred = pty }) <- ctEvidence ct
202 = do { co_hole <- newCoercionHole pty
203 ; return (mkNonCanonical (ev { ctev_dest = HoleDest co_hole })) }
204 | otherwise
205 = return ct
206
207 cloneWC :: WantedConstraints -> TcM WantedConstraints
208 -- Clone all the evidence bindings in
209 -- a) the ic_bind field of any implications
210 -- b) the CoercionHoles of any wanted constraints
211 -- so that solving the WantedConstraints will not have any visible side
212 -- effect, /except/ from causing unifications
213 cloneWC wc@(WC { wc_simple = simples, wc_impl = implics })
214 = do { simples' <- mapBagM cloneWanted simples
215 ; implics' <- mapBagM cloneImplication implics
216 ; return (wc { wc_simple = simples', wc_impl = implics' }) }
217
218 cloneImplication :: Implication -> TcM Implication
219 cloneImplication implic@(Implic { ic_binds = binds, ic_wanted = inner_wanted })
220 = do { binds' <- cloneEvBindsVar binds
221 ; inner_wanted' <- cloneWC inner_wanted
222 ; return (implic { ic_binds = binds', ic_wanted = inner_wanted' }) }
223
224 ----------------------------------------------
225 -- Emitting constraints
226 ----------------------------------------------
227
228 -- | Emits a new Wanted. Deals with both equalities and non-equalities.
229 emitWanted :: CtOrigin -> TcPredType -> TcM EvTerm
230 emitWanted origin pty
231 = do { ev <- newWanted origin Nothing pty
232 ; emitSimple $ mkNonCanonical ev
233 ; return $ ctEvTerm ev }
234
235 emitDerivedEqs :: CtOrigin -> [(TcType,TcType)] -> TcM ()
236 -- Emit some new derived nominal equalities
237 emitDerivedEqs origin pairs
238 | null pairs
239 = return ()
240 | otherwise
241 = do { loc <- getCtLocM origin Nothing
242 ; emitSimples (listToBag (map (mk_one loc) pairs)) }
243 where
244 mk_one loc (ty1, ty2)
245 = mkNonCanonical $
246 CtDerived { ctev_pred = mkPrimEqPred ty1 ty2
247 , ctev_loc = loc }
248
249 -- | Emits a new equality constraint
250 emitWantedEq :: CtOrigin -> TypeOrKind -> Role -> TcType -> TcType -> TcM Coercion
251 emitWantedEq origin t_or_k role ty1 ty2
252 = do { hole <- newCoercionHole pty
253 ; loc <- getCtLocM origin (Just t_or_k)
254 ; emitSimple $ mkNonCanonical $
255 CtWanted { ctev_pred = pty, ctev_dest = HoleDest hole
256 , ctev_nosh = WDeriv, ctev_loc = loc }
257 ; return (HoleCo hole) }
258 where
259 pty = mkPrimEqPredRole role ty1 ty2
260
261 -- | Creates a new EvVar and immediately emits it as a Wanted.
262 -- No equality predicates here.
263 emitWantedEvVar :: CtOrigin -> TcPredType -> TcM EvVar
264 emitWantedEvVar origin ty
265 = do { new_cv <- newEvVar ty
266 ; loc <- getCtLocM origin Nothing
267 ; let ctev = CtWanted { ctev_dest = EvVarDest new_cv
268 , ctev_pred = ty
269 , ctev_nosh = WDeriv
270 , ctev_loc = loc }
271 ; emitSimple $ mkNonCanonical ctev
272 ; return new_cv }
273
274 emitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar]
275 emitWantedEvVars orig = mapM (emitWantedEvVar orig)
276
277 newDict :: Class -> [TcType] -> TcM DictId
278 newDict cls tys
279 = do { name <- newSysName (mkDictOcc (getOccName cls))
280 ; return (mkLocalId name (mkClassPred cls tys)) }
281
282 predTypeOccName :: PredType -> OccName
283 predTypeOccName ty = case classifyPredType ty of
284 ClassPred cls _ -> mkDictOcc (getOccName cls)
285 EqPred {} -> mkVarOccFS (fsLit "co")
286 IrredPred {} -> mkVarOccFS (fsLit "irred")
287 ForAllPred {} -> mkVarOccFS (fsLit "df")
288
289 {-
290 ************************************************************************
291 * *
292 Coercion holes
293 * *
294 ************************************************************************
295 -}
296
297 newCoercionHole :: TcPredType -> TcM CoercionHole
298 newCoercionHole pred_ty
299 = do { co_var <- newEvVar pred_ty
300 ; traceTc "New coercion hole:" (ppr co_var)
301 ; ref <- newMutVar Nothing
302 ; return $ CoercionHole { ch_co_var = co_var, ch_ref = ref } }
303
304 -- | Put a value in a coercion hole
305 fillCoercionHole :: CoercionHole -> Coercion -> TcM ()
306 fillCoercionHole (CoercionHole { ch_ref = ref, ch_co_var = cv }) co
307 = do {
308 #if defined(DEBUG)
309 ; cts <- readTcRef ref
310 ; whenIsJust cts $ \old_co ->
311 pprPanic "Filling a filled coercion hole" (ppr cv $$ ppr co $$ ppr old_co)
312 #endif
313 ; traceTc "Filling coercion hole" (ppr cv <+> text ":=" <+> ppr co)
314 ; writeTcRef ref (Just co) }
315
316 -- | Is a coercion hole filled in?
317 isFilledCoercionHole :: CoercionHole -> TcM Bool
318 isFilledCoercionHole (CoercionHole { ch_ref = ref }) = isJust <$> readTcRef ref
319
320 -- | Retrieve the contents of a coercion hole. Panics if the hole
321 -- is unfilled
322 unpackCoercionHole :: CoercionHole -> TcM Coercion
323 unpackCoercionHole hole
324 = do { contents <- unpackCoercionHole_maybe hole
325 ; case contents of
326 Just co -> return co
327 Nothing -> pprPanic "Unfilled coercion hole" (ppr hole) }
328
329 -- | Retrieve the contents of a coercion hole, if it is filled
330 unpackCoercionHole_maybe :: CoercionHole -> TcM (Maybe Coercion)
331 unpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref
332
333 -- | Check that a coercion is appropriate for filling a hole. (The hole
334 -- itself is needed only for printing.
335 -- Always returns the checked coercion, but this return value is necessary
336 -- so that the input coercion is forced only when the output is forced.
337 checkCoercionHole :: CoVar -> Coercion -> TcM Coercion
338 checkCoercionHole cv co
339 | debugIsOn
340 = do { cv_ty <- zonkTcType (varType cv)
341 -- co is already zonked, but cv might not be
342 ; return $
343 ASSERT2( ok cv_ty
344 , (text "Bad coercion hole" <+>
345 ppr cv <> colon <+> vcat [ ppr t1, ppr t2, ppr role
346 , ppr cv_ty ]) )
347 co }
348 | otherwise
349 = return co
350
351 where
352 (Pair t1 t2, role) = coercionKindRole co
353 ok cv_ty | EqPred cv_rel cv_t1 cv_t2 <- classifyPredType cv_ty
354 = t1 `eqType` cv_t1
355 && t2 `eqType` cv_t2
356 && role == eqRelRole cv_rel
357 | otherwise
358 = False
359
360 {-
361 ************************************************************************
362 *
363 Expected types
364 *
365 ************************************************************************
366
367 Note [ExpType]
368 ~~~~~~~~~~~~~~
369
370 An ExpType is used as the "expected type" when type-checking an expression.
371 An ExpType can hold a "hole" that can be filled in by the type-checker.
372 This allows us to have one tcExpr that works in both checking mode and
373 synthesis mode (that is, bidirectional type-checking). Previously, this
374 was achieved by using ordinary unification variables, but we don't need
375 or want that generality. (For example, #11397 was caused by doing the
376 wrong thing with unification variables.) Instead, we observe that these
377 holes should
378
379 1. never be nested
380 2. never appear as the type of a variable
381 3. be used linearly (never be duplicated)
382
383 By defining ExpType, separately from Type, we can achieve goals 1 and 2
384 statically.
385
386 See also [wiki:typechecking]
387
388 Note [TcLevel of ExpType]
389 ~~~~~~~~~~~~~~~~~~~~~~~~~
390 Consider
391
392 data G a where
393 MkG :: G Bool
394
395 foo MkG = True
396
397 This is a classic untouchable-variable / ambiguous GADT return type
398 scenario. But, with ExpTypes, we'll be inferring the type of the RHS.
399 And, because there is only one branch of the case, we won't trigger
400 Note [Case branches must never infer a non-tau type] of TcMatches.
401 We thus must track a TcLevel in an Inferring ExpType. If we try to
402 fill the ExpType and find that the TcLevels don't work out, we
403 fill the ExpType with a tau-tv at the low TcLevel, hopefully to
404 be worked out later by some means. This is triggered in
405 test gadt/gadt-escape1.
406
407 -}
408
409 -- actual data definition is in TcType
410
411 -- | Make an 'ExpType' suitable for inferring a type of kind * or #.
412 newInferExpTypeNoInst :: TcM ExpSigmaType
413 newInferExpTypeNoInst = newInferExpType False
414
415 newInferExpTypeInst :: TcM ExpRhoType
416 newInferExpTypeInst = newInferExpType True
417
418 newInferExpType :: Bool -> TcM ExpType
419 newInferExpType inst
420 = do { u <- newUnique
421 ; tclvl <- getTcLevel
422 ; traceTc "newOpenInferExpType" (ppr u <+> ppr inst <+> ppr tclvl)
423 ; ref <- newMutVar Nothing
424 ; return (Infer (IR { ir_uniq = u, ir_lvl = tclvl
425 , ir_ref = ref, ir_inst = inst })) }
426
427 -- | Extract a type out of an ExpType, if one exists. But one should always
428 -- exist. Unless you're quite sure you know what you're doing.
429 readExpType_maybe :: ExpType -> TcM (Maybe TcType)
430 readExpType_maybe (Check ty) = return (Just ty)
431 readExpType_maybe (Infer (IR { ir_ref = ref})) = readMutVar ref
432
433 -- | Extract a type out of an ExpType. Otherwise, panics.
434 readExpType :: ExpType -> TcM TcType
435 readExpType exp_ty
436 = do { mb_ty <- readExpType_maybe exp_ty
437 ; case mb_ty of
438 Just ty -> return ty
439 Nothing -> pprPanic "Unknown expected type" (ppr exp_ty) }
440
441 -- | Returns the expected type when in checking mode.
442 checkingExpType_maybe :: ExpType -> Maybe TcType
443 checkingExpType_maybe (Check ty) = Just ty
444 checkingExpType_maybe _ = Nothing
445
446 -- | Returns the expected type when in checking mode. Panics if in inference
447 -- mode.
448 checkingExpType :: String -> ExpType -> TcType
449 checkingExpType _ (Check ty) = ty
450 checkingExpType err et = pprPanic "checkingExpType" (text err $$ ppr et)
451
452 tauifyExpType :: ExpType -> TcM ExpType
453 -- ^ Turn a (Infer hole) type into a (Check alpha),
454 -- where alpha is a fresh unification variable
455 tauifyExpType (Check ty) = return (Check ty) -- No-op for (Check ty)
456 tauifyExpType (Infer inf_res) = do { ty <- inferResultToType inf_res
457 ; return (Check ty) }
458
459 -- | Extracts the expected type if there is one, or generates a new
460 -- TauTv if there isn't.
461 expTypeToType :: ExpType -> TcM TcType
462 expTypeToType (Check ty) = return ty
463 expTypeToType (Infer inf_res) = inferResultToType inf_res
464
465 inferResultToType :: InferResult -> TcM Type
466 inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl
467 , ir_ref = ref })
468 = do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy
469 ; tau <- newMetaTyVarTyAtLevel tc_lvl (tYPE rr)
470 -- See Note [TcLevel of ExpType]
471 ; writeMutVar ref (Just tau)
472 ; traceTc "Forcing ExpType to be monomorphic:"
473 (ppr u <+> text ":=" <+> ppr tau)
474 ; return tau }
475
476
477 {- *********************************************************************
478 * *
479 SkolemTvs (immutable)
480 * *
481 ********************************************************************* -}
482
483 tcInstType :: ([TyVar] -> TcM (TCvSubst, [TcTyVar]))
484 -- ^ How to instantiate the type variables
485 -> Id -- ^ Type to instantiate
486 -> TcM ([(Name, TcTyVar)], TcThetaType, TcType) -- ^ Result
487 -- (type vars, preds (incl equalities), rho)
488 tcInstType inst_tyvars id
489 = case tcSplitForAllTys (idType id) of
490 ([], rho) -> let -- There may be overloading despite no type variables;
491 -- (?x :: Int) => Int -> Int
492 (theta, tau) = tcSplitPhiTy rho
493 in
494 return ([], theta, tau)
495
496 (tyvars, rho) -> do { (subst, tyvars') <- inst_tyvars tyvars
497 ; let (theta, tau) = tcSplitPhiTy (substTyAddInScope subst rho)
498 tv_prs = map tyVarName tyvars `zip` tyvars'
499 ; return (tv_prs, theta, tau) }
500
501 tcSkolDFunType :: DFunId -> TcM ([TcTyVar], TcThetaType, TcType)
502 -- Instantiate a type signature with skolem constants.
503 -- We could give them fresh names, but no need to do so
504 tcSkolDFunType dfun
505 = do { (tv_prs, theta, tau) <- tcInstType tcInstSuperSkolTyVars dfun
506 ; return (map snd tv_prs, theta, tau) }
507
508 tcSuperSkolTyVars :: [TyVar] -> (TCvSubst, [TcTyVar])
509 -- Make skolem constants, but do *not* give them new names, as above
510 -- Moreover, make them "super skolems"; see comments with superSkolemTv
511 -- see Note [Kind substitution when instantiating]
512 -- Precondition: tyvars should be ordered by scoping
513 tcSuperSkolTyVars = mapAccumL tcSuperSkolTyVar emptyTCvSubst
514
515 tcSuperSkolTyVar :: TCvSubst -> TyVar -> (TCvSubst, TcTyVar)
516 tcSuperSkolTyVar subst tv
517 = (extendTvSubstWithClone subst tv new_tv, new_tv)
518 where
519 kind = substTyUnchecked subst (tyVarKind tv)
520 new_tv = mkTcTyVar (tyVarName tv) kind superSkolemTv
521
522 -- | Given a list of @['TyVar']@, skolemize the type variables,
523 -- returning a substitution mapping the original tyvars to the
524 -- skolems, and the list of newly bound skolems.
525 tcInstSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
526 -- See Note [Skolemising type variables]
527 tcInstSkolTyVars = tcInstSkolTyVarsX emptyTCvSubst
528
529 tcInstSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
530 -- See Note [Skolemising type variables]
531 tcInstSkolTyVarsX = tcInstSkolTyVarsPushLevel False
532
533 tcInstSuperSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
534 -- See Note [Skolemising type variables]
535 tcInstSuperSkolTyVars = tcInstSuperSkolTyVarsX emptyTCvSubst
536
537 tcInstSuperSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
538 -- See Note [Skolemising type variables]
539 tcInstSuperSkolTyVarsX subst = tcInstSkolTyVarsPushLevel True subst
540
541 tcInstSkolTyVarsPushLevel :: Bool -> TCvSubst -> [TyVar]
542 -> TcM (TCvSubst, [TcTyVar])
543 -- Skolemise one level deeper, hence pushTcLevel
544 -- See Note [Skolemising type variables]
545 tcInstSkolTyVarsPushLevel overlappable subst tvs
546 = do { tc_lvl <- getTcLevel
547 ; let pushed_lvl = pushTcLevel tc_lvl
548 ; tcInstSkolTyVarsAt pushed_lvl overlappable subst tvs }
549
550 tcInstSkolTyVarsAt :: TcLevel -> Bool
551 -> TCvSubst -> [TyVar]
552 -> TcM (TCvSubst, [TcTyVar])
553 tcInstSkolTyVarsAt lvl overlappable subst tvs
554 = freshenTyCoVarsX new_skol_tv subst tvs
555 where
556 details = SkolemTv lvl overlappable
557 new_skol_tv name kind = mkTcTyVar name kind details
558
559 ------------------
560 freshenTyVarBndrs :: [TyVar] -> TcM (TCvSubst, [TyVar])
561 -- ^ Give fresh uniques to a bunch of TyVars, but they stay
562 -- as TyVars, rather than becoming TcTyVars
563 -- Used in FamInst.newFamInst, and Inst.newClsInst
564 freshenTyVarBndrs = freshenTyCoVars mkTyVar
565
566 freshenCoVarBndrsX :: TCvSubst -> [CoVar] -> TcM (TCvSubst, [CoVar])
567 -- ^ Give fresh uniques to a bunch of CoVars
568 -- Used in FamInst.newFamInst
569 freshenCoVarBndrsX subst = freshenTyCoVarsX mkCoVar subst
570
571 ------------------
572 freshenTyCoVars :: (Name -> Kind -> TyCoVar)
573 -> [TyVar] -> TcM (TCvSubst, [TyCoVar])
574 freshenTyCoVars mk_tcv = freshenTyCoVarsX mk_tcv emptyTCvSubst
575
576 freshenTyCoVarsX :: (Name -> Kind -> TyCoVar)
577 -> TCvSubst -> [TyCoVar]
578 -> TcM (TCvSubst, [TyCoVar])
579 freshenTyCoVarsX mk_tcv = mapAccumLM (freshenTyCoVarX mk_tcv)
580
581 freshenTyCoVarX :: (Name -> Kind -> TyCoVar)
582 -> TCvSubst -> TyCoVar -> TcM (TCvSubst, TyCoVar)
583 -- This a complete freshening operation:
584 -- the skolems have a fresh unique, and a location from the monad
585 -- See Note [Skolemising type variables]
586 freshenTyCoVarX mk_tcv subst tycovar
587 = do { loc <- getSrcSpanM
588 ; uniq <- newUnique
589 ; let old_name = tyVarName tycovar
590 new_name = mkInternalName uniq (getOccName old_name) loc
591 new_kind = substTyUnchecked subst (tyVarKind tycovar)
592 new_tcv = mk_tcv new_name new_kind
593 subst1 = extendTCvSubstWithClone subst tycovar new_tcv
594 ; return (subst1, new_tcv) }
595
596 {- Note [Skolemising type variables]
597 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
598 The tcInstSkolTyVars family of functions instantiate a list of TyVars
599 to fresh skolem TcTyVars. Important notes:
600
601 a) Level allocation. We generally skolemise /before/ calling
602 pushLevelAndCaptureConstraints. So we want their level to the level
603 of the soon-to-be-created implication, which has a level ONE HIGHER
604 than the current level. Hence the pushTcLevel. It feels like a
605 slight hack.
606
607 b) The [TyVar] should be ordered (kind vars first)
608 See Note [Kind substitution when instantiating]
609
610 c) It's a complete freshening operation: the skolems have a fresh
611 unique, and a location from the monad
612
613 d) The resulting skolems are
614 non-overlappable for tcInstSkolTyVars,
615 but overlappable for tcInstSuperSkolTyVars
616 See TcDerivInfer Note [Overlap and deriving] for an example
617 of where this matters.
618
619 Note [Kind substitution when instantiating]
620 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
621 When we instantiate a bunch of kind and type variables, first we
622 expect them to be topologically sorted.
623 Then we have to instantiate the kind variables, build a substitution
624 from old variables to the new variables, then instantiate the type
625 variables substituting the original kind.
626
627 Exemple: If we want to instantiate
628 [(k1 :: *), (k2 :: *), (a :: k1 -> k2), (b :: k1)]
629 we want
630 [(?k1 :: *), (?k2 :: *), (?a :: ?k1 -> ?k2), (?b :: ?k1)]
631 instead of the buggous
632 [(?k1 :: *), (?k2 :: *), (?a :: k1 -> k2), (?b :: k1)]
633
634
635 ************************************************************************
636 * *
637 MetaTvs (meta type variables; mutable)
638 * *
639 ************************************************************************
640 -}
641
642 {-
643 Note [TyVarTv]
644 ~~~~~~~~~~~~
645
646 A TyVarTv can unify with type *variables* only, including other TyVarTvs and
647 skolems. Sometimes, they can unify with type variables that the user would
648 rather keep distinct; see #11203 for an example. So, any client of this
649 function needs to either allow the TyVarTvs to unify with each other or check
650 that they don't (say, with a call to findDubTyVarTvs).
651
652 Before #15050 this (under the name SigTv) was used for ScopedTypeVariables in
653 patterns, to make sure these type variables only refer to other type variables,
654 but this restriction was dropped, and ScopedTypeVariables can now refer to full
655 types (GHC Proposal 29).
656
657 The remaining uses of newTyVarTyVars are
658 * In kind signatures, see
659 TcTyClsDecls Note [Inferring kinds for type declarations]
660 and Note [Kind checking for GADTs]
661 * In partial type signatures, see Note [Quantified variables in partial type signatures]
662 -}
663
664 newMetaTyVarName :: FastString -> TcM Name
665 -- Makes a /System/ Name, which is eagerly eliminated by
666 -- the unifier; see TcUnify.nicer_to_update_tv1, and
667 -- TcCanonical.canEqTyVarTyVar (nicer_to_update_tv2)
668 newMetaTyVarName str
669 = do { uniq <- newUnique
670 ; return (mkSystemName uniq (mkTyVarOccFS str)) }
671
672 cloneMetaTyVarName :: Name -> TcM Name
673 cloneMetaTyVarName name
674 = do { uniq <- newUnique
675 ; return (mkSystemName uniq (nameOccName name)) }
676 -- See Note [Name of an instantiated type variable]
677
678 {- Note [Name of an instantiated type variable]
679 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
680 At the moment we give a unification variable a System Name, which
681 influences the way it is tidied; see TypeRep.tidyTyVarBndr.
682
683 Note [Unification variables need fresh Names]
684 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
685 Whenever we allocate a unification variable (MetaTyVar) we give
686 it a fresh name. #16221 is a very tricky case that illustrates
687 why this is important:
688
689 data SameKind :: k -> k -> *
690 data T0 a = forall k2 (b :: k2). MkT0 (SameKind a b) !Int
691
692 When kind-checking T0, we give (a :: kappa1). Then, in kcConDecl
693 we allocate a unification variable kappa2 for k2, and then we
694 end up unifying kappa1 := kappa2 (because of the (SameKind a b).
695
696 Now we generalise over kappa2; but if kappa2's Name is k2,
697 we'll end up giving T0 the kind forall k2. k2 -> *. Nothing
698 directly wrong with that but when we typecheck the data constrautor
699 we end up giving it the type
700 MkT0 :: forall k1 (a :: k1) k2 (b :: k2).
701 SameKind @k2 a b -> Int -> T0 @{k2} a
702 which is bogus. The result type should be T0 @{k1} a.
703
704 And there no reason /not/ to clone the Name when making a
705 unification variable. So that's what we do.
706 -}
707
708 newAnonMetaTyVar :: MetaInfo -> Kind -> TcM TcTyVar
709 -- Make a new meta tyvar out of thin air
710 newAnonMetaTyVar meta_info kind
711 = do { let s = case meta_info of
712 TauTv -> fsLit "t"
713 FlatMetaTv -> fsLit "fmv"
714 FlatSkolTv -> fsLit "fsk"
715 TyVarTv -> fsLit "a"
716 ; name <- newMetaTyVarName s
717 ; details <- newMetaDetails meta_info
718 ; let tyvar = mkTcTyVar name kind details
719 ; traceTc "newAnonMetaTyVar" (ppr tyvar)
720 ; return tyvar }
721
722 -- makes a new skolem tv
723 newSkolemTyVar :: Name -> Kind -> TcM TcTyVar
724 newSkolemTyVar name kind
725 = do { lvl <- getTcLevel
726 ; return (mkTcTyVar name kind (SkolemTv lvl False)) }
727
728 newTyVarTyVar :: Name -> Kind -> TcM TcTyVar
729 -- See Note [TyVarTv]
730 -- See Note [Unification variables need fresh Names]
731 newTyVarTyVar name kind
732 = do { details <- newMetaDetails TyVarTv
733 ; uniq <- newUnique
734 ; let name' = name `setNameUnique` uniq
735 tyvar = mkTcTyVar name' kind details
736 -- Don't use cloneMetaTyVar, which makes a SystemName
737 -- We want to keep the original more user-friendly Name
738 -- In practical terms that means that in error messages,
739 -- when the Name is tidied we get 'a' rather than 'a0'
740 ; traceTc "newTyVarTyVar" (ppr tyvar)
741 ; return tyvar }
742
743 newPatSigTyVar :: Name -> Kind -> TcM TcTyVar
744 newPatSigTyVar name kind
745 = do { details <- newMetaDetails TauTv
746 ; uniq <- newUnique
747 ; let name' = name `setNameUnique` uniq
748 tyvar = mkTcTyVar name' kind details
749 -- Don't use cloneMetaTyVar;
750 -- same reasoning as in newTyVarTyVar
751 ; traceTc "newPatSigTyVar" (ppr tyvar)
752 ; return tyvar }
753
754 cloneAnonMetaTyVar :: MetaInfo -> TyVar -> TcKind -> TcM TcTyVar
755 -- Make a fresh MetaTyVar, basing the name
756 -- on that of the supplied TyVar
757 cloneAnonMetaTyVar info tv kind
758 = do { details <- newMetaDetails info
759 ; name <- cloneMetaTyVarName (tyVarName tv)
760 ; let tyvar = mkTcTyVar name kind details
761 ; traceTc "cloneAnonMetaTyVar" (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar))
762 ; return tyvar }
763
764 newFskTyVar :: TcType -> TcM TcTyVar
765 newFskTyVar fam_ty
766 = do { details <- newMetaDetails FlatSkolTv
767 ; name <- newMetaTyVarName (fsLit "fsk")
768 ; return (mkTcTyVar name (tcTypeKind fam_ty) details) }
769
770 newFmvTyVar :: TcType -> TcM TcTyVar
771 -- Very like newMetaTyVar, except sets mtv_tclvl to one less
772 -- so that the fmv is untouchable.
773 newFmvTyVar fam_ty
774 = do { details <- newMetaDetails FlatMetaTv
775 ; name <- newMetaTyVarName (fsLit "s")
776 ; return (mkTcTyVar name (tcTypeKind fam_ty) details) }
777
778 newMetaDetails :: MetaInfo -> TcM TcTyVarDetails
779 newMetaDetails info
780 = do { ref <- newMutVar Flexi
781 ; tclvl <- getTcLevel
782 ; return (MetaTv { mtv_info = info
783 , mtv_ref = ref
784 , mtv_tclvl = tclvl }) }
785
786 cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
787 cloneMetaTyVar tv
788 = ASSERT( isTcTyVar tv )
789 do { ref <- newMutVar Flexi
790 ; name' <- cloneMetaTyVarName (tyVarName tv)
791 ; let details' = case tcTyVarDetails tv of
792 details@(MetaTv {}) -> details { mtv_ref = ref }
793 _ -> pprPanic "cloneMetaTyVar" (ppr tv)
794 tyvar = mkTcTyVar name' (tyVarKind tv) details'
795 ; traceTc "cloneMetaTyVar" (ppr tyvar)
796 ; return tyvar }
797
798 -- Works for both type and kind variables
799 readMetaTyVar :: TyVar -> TcM MetaDetails
800 readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )
801 readMutVar (metaTyVarRef tyvar)
802
803 isFilledMetaTyVar_maybe :: TcTyVar -> TcM (Maybe Type)
804 isFilledMetaTyVar_maybe tv
805 | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv
806 = do { cts <- readTcRef ref
807 ; case cts of
808 Indirect ty -> return (Just ty)
809 Flexi -> return Nothing }
810 | otherwise
811 = return Nothing
812
813 isFilledMetaTyVar :: TyVar -> TcM Bool
814 -- True of a filled-in (Indirect) meta type variable
815 isFilledMetaTyVar tv = isJust <$> isFilledMetaTyVar_maybe tv
816
817 isUnfilledMetaTyVar :: TyVar -> TcM Bool
818 -- True of a un-filled-in (Flexi) meta type variable
819 -- NB: Not the opposite of isFilledMetaTyVar
820 isUnfilledMetaTyVar tv
821 | MetaTv { mtv_ref = ref } <- tcTyVarDetails tv
822 = do { details <- readMutVar ref
823 ; return (isFlexi details) }
824 | otherwise = return False
825
826 --------------------
827 -- Works with both type and kind variables
828 writeMetaTyVar :: TcTyVar -> TcType -> TcM ()
829 -- Write into a currently-empty MetaTyVar
830
831 writeMetaTyVar tyvar ty
832 | not debugIsOn
833 = writeMetaTyVarRef tyvar (metaTyVarRef tyvar) ty
834
835 -- Everything from here on only happens if DEBUG is on
836 | not (isTcTyVar tyvar)
837 = ASSERT2( False, text "Writing to non-tc tyvar" <+> ppr tyvar )
838 return ()
839
840 | MetaTv { mtv_ref = ref } <- tcTyVarDetails tyvar
841 = writeMetaTyVarRef tyvar ref ty
842
843 | otherwise
844 = ASSERT2( False, text "Writing to non-meta tyvar" <+> ppr tyvar )
845 return ()
846
847 --------------------
848 writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
849 -- Here the tyvar is for error checking only;
850 -- the ref cell must be for the same tyvar
851 writeMetaTyVarRef tyvar ref ty
852 | not debugIsOn
853 = do { traceTc "writeMetaTyVar" (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)
854 <+> text ":=" <+> ppr ty)
855 ; writeTcRef ref (Indirect ty) }
856
857 -- Everything from here on only happens if DEBUG is on
858 | otherwise
859 = do { meta_details <- readMutVar ref;
860 -- Zonk kinds to allow the error check to work
861 ; zonked_tv_kind <- zonkTcType tv_kind
862 ; zonked_ty_kind <- zonkTcType ty_kind
863 ; let kind_check_ok = tcIsConstraintKind zonked_tv_kind
864 || tcEqKind zonked_ty_kind zonked_tv_kind
865 -- Hack alert! tcIsConstraintKind: see TcHsType
866 -- Note [Extra-constraint holes in partial type signatures]
867
868 kind_msg = hang (text "Ill-kinded update to meta tyvar")
869 2 ( ppr tyvar <+> text "::" <+> (ppr tv_kind $$ ppr zonked_tv_kind)
870 <+> text ":="
871 <+> ppr ty <+> text "::" <+> (ppr zonked_ty_kind) )
872
873 ; traceTc "writeMetaTyVar" (ppr tyvar <+> text ":=" <+> ppr ty)
874
875 -- Check for double updates
876 ; MASSERT2( isFlexi meta_details, double_upd_msg meta_details )
877
878 -- Check for level OK
879 -- See Note [Level check when unifying]
880 ; MASSERT2( level_check_ok, level_check_msg )
881
882 -- Check Kinds ok
883 ; MASSERT2( kind_check_ok, kind_msg )
884
885 -- Do the write
886 ; writeMutVar ref (Indirect ty) }
887 where
888 tv_kind = tyVarKind tyvar
889 ty_kind = tcTypeKind ty
890
891 tv_lvl = tcTyVarLevel tyvar
892 ty_lvl = tcTypeLevel ty
893
894 level_check_ok = not (ty_lvl `strictlyDeeperThan` tv_lvl)
895 level_check_msg = ppr ty_lvl $$ ppr tv_lvl $$ ppr tyvar $$ ppr ty
896
897 double_upd_msg details = hang (text "Double update of meta tyvar")
898 2 (ppr tyvar $$ ppr details)
899
900 {- Note [Level check when unifying]
901 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
902 When unifying
903 alpha:lvl := ty
904 we expect that the TcLevel of 'ty' will be <= lvl.
905 However, during unflatting we do
906 fuv:l := ty:(l+1)
907 which is usually wrong; hence the check isFmmvTyVar in level_check_ok.
908 See Note [TcLevel assignment] in TcType.
909 -}
910
911 {-
912 % Generating fresh variables for pattern match check
913 -}
914
915
916 {-
917 ************************************************************************
918 * *
919 MetaTvs: TauTvs
920 * *
921 ************************************************************************
922
923 Note [Never need to instantiate coercion variables]
924 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
925 With coercion variables sloshing around in types, it might seem that we
926 sometimes need to instantiate coercion variables. This would be problematic,
927 because coercion variables inhabit unboxed equality (~#), and the constraint
928 solver thinks in terms only of boxed equality (~). The solution is that
929 we never need to instantiate coercion variables in the first place.
930
931 The tyvars that we need to instantiate come from the types of functions,
932 data constructors, and patterns. These will never be quantified over
933 coercion variables, except for the special case of the promoted Eq#. But,
934 that can't ever appear in user code, so we're safe!
935 -}
936
937
938 newFlexiTyVar :: Kind -> TcM TcTyVar
939 newFlexiTyVar kind = newAnonMetaTyVar TauTv kind
940
941 newFlexiTyVarTy :: Kind -> TcM TcType
942 newFlexiTyVarTy kind = do
943 tc_tyvar <- newFlexiTyVar kind
944 return (mkTyVarTy tc_tyvar)
945
946 newFlexiTyVarTys :: Int -> Kind -> TcM [TcType]
947 newFlexiTyVarTys n kind = replicateM n (newFlexiTyVarTy kind)
948
949 newOpenTypeKind :: TcM TcKind
950 newOpenTypeKind
951 = do { rr <- newFlexiTyVarTy runtimeRepTy
952 ; return (tYPE rr) }
953
954 -- | Create a tyvar that can be a lifted or unlifted type.
955 -- Returns alpha :: TYPE kappa, where both alpha and kappa are fresh
956 newOpenFlexiTyVarTy :: TcM TcType
957 newOpenFlexiTyVarTy
958 = do { kind <- newOpenTypeKind
959 ; newFlexiTyVarTy kind }
960
961 newMetaTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
962 -- Instantiate with META type variables
963 -- Note that this works for a sequence of kind, type, and coercion variables
964 -- variables. Eg [ (k:*), (a:k->k) ]
965 -- Gives [ (k7:*), (a8:k7->k7) ]
966 newMetaTyVars = newMetaTyVarsX emptyTCvSubst
967 -- emptyTCvSubst has an empty in-scope set, but that's fine here
968 -- Since the tyvars are freshly made, they cannot possibly be
969 -- captured by any existing for-alls.
970
971 newMetaTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
972 -- Just like newMetaTyVars, but start with an existing substitution.
973 newMetaTyVarsX subst = mapAccumLM newMetaTyVarX subst
974
975 newMetaTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
976 -- Make a new unification variable tyvar whose Name and Kind come from
977 -- an existing TyVar. We substitute kind variables in the kind.
978 newMetaTyVarX subst tyvar = new_meta_tv_x TauTv subst tyvar
979
980 newMetaTyVarTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
981 newMetaTyVarTyVars = mapAccumLM newMetaTyVarTyVarX emptyTCvSubst
982
983 newMetaTyVarTyVarX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
984 -- Just like newMetaTyVarX, but make a TyVarTv
985 newMetaTyVarTyVarX subst tyvar = new_meta_tv_x TyVarTv subst tyvar
986
987 newWildCardX :: TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
988 newWildCardX subst tv
989 = do { new_tv <- newAnonMetaTyVar TauTv (substTy subst (tyVarKind tv))
990 ; return (extendTvSubstWithClone subst tv new_tv, new_tv) }
991
992 new_meta_tv_x :: MetaInfo -> TCvSubst -> TyVar -> TcM (TCvSubst, TcTyVar)
993 new_meta_tv_x info subst tv
994 = do { new_tv <- cloneAnonMetaTyVar info tv substd_kind
995 ; let subst1 = extendTvSubstWithClone subst tv new_tv
996 ; return (subst1, new_tv) }
997 where
998 substd_kind = substTyUnchecked subst (tyVarKind tv)
999 -- NOTE: #12549 is fixed so we could use
1000 -- substTy here, but the tc_infer_args problem
1001 -- is not yet fixed so leaving as unchecked for now.
1002 -- OLD NOTE:
1003 -- Unchecked because we call newMetaTyVarX from
1004 -- tcInstTyBinder, which is called from tcInferApps
1005 -- which does not yet take enough trouble to ensure
1006 -- the in-scope set is right; e.g. #12785 trips
1007 -- if we use substTy here
1008
1009 newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType
1010 newMetaTyVarTyAtLevel tc_lvl kind
1011 = do { ref <- newMutVar Flexi
1012 ; name <- newMetaTyVarName (fsLit "p")
1013 ; let details = MetaTv { mtv_info = TauTv
1014 , mtv_ref = ref
1015 , mtv_tclvl = tc_lvl }
1016 ; return (mkTyVarTy (mkTcTyVar name kind details)) }
1017
1018 {- *********************************************************************
1019 * *
1020 Finding variables to quantify over
1021 * *
1022 ********************************************************************* -}
1023
1024 {- Note [Dependent type variables]
1025 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1026 In Haskell type inference we quantify over type variables; but we only
1027 quantify over /kind/ variables when -XPolyKinds is on. Without -XPolyKinds
1028 we default the kind variables to *.
1029
1030 So, to support this defaulting, and only for that reason, when
1031 collecting the free vars of a type (in candidateQTyVarsOfType and friends),
1032 prior to quantifying, we must keep the type and kind variables separate.
1033
1034 But what does that mean in a system where kind variables /are/ type
1035 variables? It's a fairly arbitrary distinction based on how the
1036 variables appear:
1037
1038 - "Kind variables" appear in the kind of some other free variable
1039 or in the kind of a locally quantified type variable
1040 (forall (a :: kappa). ...) or in the kind of a coercion
1041 (a |> (co :: kappa1 ~ kappa2)).
1042
1043 These are the ones we default to * if -XPolyKinds is off
1044
1045 - "Type variables" are all free vars that are not kind variables
1046
1047 E.g. In the type T k (a::k)
1048 'k' is a kind variable, because it occurs in the kind of 'a',
1049 even though it also appears at "top level" of the type
1050 'a' is a type variable, because it doesn't
1051
1052 We gather these variables using a CandidatesQTvs record:
1053 DV { dv_kvs: Variables free in the kind of a free type variable
1054 or of a forall-bound type variable
1055 , dv_tvs: Variables sytactically free in the type }
1056
1057 So: dv_kvs are the kind variables of the type
1058 (dv_tvs - dv_kvs) are the type variable of the type
1059
1060 Note that
1061
1062 * A variable can occur in both.
1063 T k (x::k) The first occurrence of k makes it
1064 show up in dv_tvs, the second in dv_kvs
1065
1066 * We include any coercion variables in the "dependent",
1067 "kind-variable" set because we never quantify over them.
1068
1069 * The "kind variables" might depend on each other; e.g
1070 (k1 :: k2), (k2 :: *)
1071 The "type variables" do not depend on each other; if
1072 one did, it'd be classified as a kind variable!
1073
1074 Note [CandidatesQTvs determinism and order]
1075 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1076 * Determinism: when we quantify over type variables we decide the
1077 order in which they appear in the final type. Because the order of
1078 type variables in the type can end up in the interface file and
1079 affects some optimizations like worker-wrapper, we want this order to
1080 be deterministic.
1081
1082 To achieve that we use deterministic sets of variables that can be
1083 converted to lists in a deterministic order. For more information
1084 about deterministic sets see Note [Deterministic UniqFM] in UniqDFM.
1085
1086 * Order: as well as being deterministic, we use an
1087 accumulating-parameter style for candidateQTyVarsOfType so that we
1088 add variables one at a time, left to right. That means we tend to
1089 produce the variables in left-to-right order. This is just to make
1090 it bit more predictable for the programmer.
1091
1092 Note [Naughty quantification candidates]
1093 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1094 Consider (#14880, dependent/should_compile/T14880-2), suppose
1095 we are trying to generalise this type:
1096
1097 forall arg. ... (alpha[tau]:arg) ...
1098
1099 We have a metavariable alpha whose kind mentions a skolem variable
1100 bound inside the very type we are generalising.
1101 This can arise while type-checking a user-written type signature
1102 (see the test case for the full code).
1103
1104 We cannot generalise over alpha! That would produce a type like
1105 forall {a :: arg}. forall arg. ...blah...
1106 The fact that alpha's kind mentions arg renders it completely
1107 ineligible for generalisation.
1108
1109 However, we are not going to learn any new constraints on alpha,
1110 because its kind isn't even in scope in the outer context (but see Wrinkle).
1111 So alpha is entirely unconstrained.
1112
1113 What then should we do with alpha? During generalization, every
1114 metavariable is either (A) promoted, (B) generalized, or (C) zapped
1115 (according again to Note [Recipe for checking a signature] in
1116 TcHsType).
1117
1118 * We can't generalise it.
1119 * We can't promote it, because its kind prevents that
1120 * We can't simply leave it be, because this type is about to
1121 go into the typing environment (as the type of some let-bound
1122 variable, say), and then chaos erupts when we try to instantiate.
1123
1124 So, we zap it, eagerly, to Any. We don't have to do this eager zapping
1125 in terms (say, in `length []`) because terms are never re-examined before
1126 the final zonk (which zaps any lingering metavariables to Any).
1127
1128 We do this eager zapping in candidateQTyVars, which always precedes
1129 generalisation, because at that moment we have a clear picture of what
1130 skolems are in scope within the type itself (e.g. that 'forall arg').
1131
1132 Wrinkle:
1133
1134 We must make absolutely sure that alpha indeed is not
1135 from an outer context. (Otherwise, we might indeed learn more information
1136 about it.) This can be done easily: we just check alpha's TcLevel.
1137 That level must be strictly greater than the ambient TcLevel in order
1138 to treat it as naughty. We say "strictly greater than" because the call to
1139 candidateQTyVars is made outside the bumped TcLevel, as stated in the
1140 comment to candidateQTyVarsOfType. The level check is done in go_tv
1141 in collect_cand_qtvs. Skipping this check caused #16517.
1142
1143 -}
1144
1145 data CandidatesQTvs
1146 -- See Note [Dependent type variables]
1147 -- See Note [CandidatesQTvs determinism and order]
1148 --
1149 -- Invariants:
1150 -- * All variables are fully zonked, including their kinds
1151 -- * All variables are at a level greater than the ambient level
1152 -- See Note [Use level numbers for quantification]
1153 --
1154 -- This *can* contain skolems. For example, in `data X k :: k -> Type`
1155 -- we need to know that the k is a dependent variable. This is done
1156 -- by collecting the candidates in the kind after skolemising. It also
1157 -- comes up when generalizing a associated type instance, where instance
1158 -- variables are skolems. (Recall that associated type instances are generalized
1159 -- independently from their enclosing class instance, and the associated
1160 -- type instance may be generalized by more, fewer, or different variables
1161 -- than the class instance.)
1162 --
1163 = DV { dv_kvs :: DTyVarSet -- "kind" metavariables (dependent)
1164 , dv_tvs :: DTyVarSet -- "type" metavariables (non-dependent)
1165 -- A variable may appear in both sets
1166 -- E.g. T k (x::k) The first occurrence of k makes it
1167 -- show up in dv_tvs, the second in dv_kvs
1168 -- See Note [Dependent type variables]
1169
1170 , dv_cvs :: CoVarSet
1171 -- These are covars. Included only so that we don't repeatedly
1172 -- look at covars' kinds in accumulator. Not used by quantifyTyVars.
1173 }
1174
1175 instance Semi.Semigroup CandidatesQTvs where
1176 (DV { dv_kvs = kv1, dv_tvs = tv1, dv_cvs = cv1 })
1177 <> (DV { dv_kvs = kv2, dv_tvs = tv2, dv_cvs = cv2 })
1178 = DV { dv_kvs = kv1 `unionDVarSet` kv2
1179 , dv_tvs = tv1 `unionDVarSet` tv2
1180 , dv_cvs = cv1 `unionVarSet` cv2 }
1181
1182 instance Monoid CandidatesQTvs where
1183 mempty = DV { dv_kvs = emptyDVarSet, dv_tvs = emptyDVarSet, dv_cvs = emptyVarSet }
1184 mappend = (Semi.<>)
1185
1186 instance Outputable CandidatesQTvs where
1187 ppr (DV {dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs })
1188 = text "DV" <+> braces (pprWithCommas id [ text "dv_kvs =" <+> ppr kvs
1189 , text "dv_tvs =" <+> ppr tvs
1190 , text "dv_cvs =" <+> ppr cvs ])
1191
1192
1193 candidateKindVars :: CandidatesQTvs -> TyVarSet
1194 candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs)
1195
1196 partitionCandidates :: CandidatesQTvs -> (TyVar -> Bool) -> (DTyVarSet, CandidatesQTvs)
1197 partitionCandidates dvs@(DV { dv_kvs = kvs, dv_tvs = tvs }) pred
1198 = (extracted, dvs { dv_kvs = rest_kvs, dv_tvs = rest_tvs })
1199 where
1200 (extracted_kvs, rest_kvs) = partitionDVarSet pred kvs
1201 (extracted_tvs, rest_tvs) = partitionDVarSet pred tvs
1202 extracted = extracted_kvs `unionDVarSet` extracted_tvs
1203
1204 -- | Gathers free variables to use as quantification candidates (in
1205 -- 'quantifyTyVars'). This might output the same var
1206 -- in both sets, if it's used in both a type and a kind.
1207 -- The variables to quantify must have a TcLevel strictly greater than
1208 -- the ambient level. (See Wrinkle in Note [Naughty quantification candidates])
1209 -- See Note [CandidatesQTvs determinism and order]
1210 -- See Note [Dependent type variables]
1211 candidateQTyVarsOfType :: TcType -- not necessarily zonked
1212 -> TcM CandidatesQTvs
1213 candidateQTyVarsOfType ty = collect_cand_qtvs False emptyVarSet mempty ty
1214
1215 -- | Like 'candidateQTyVarsOfType', but over a list of types
1216 -- The variables to quantify must have a TcLevel strictly greater than
1217 -- the ambient level. (See Wrinkle in Note [Naughty quantification candidates])
1218 candidateQTyVarsOfTypes :: [Type] -> TcM CandidatesQTvs
1219 candidateQTyVarsOfTypes tys = foldlM (collect_cand_qtvs False emptyVarSet) mempty tys
1220
1221 -- | Like 'candidateQTyVarsOfType', but consider every free variable
1222 -- to be dependent. This is appropriate when generalizing a *kind*,
1223 -- instead of a type. (That way, -XNoPolyKinds will default the variables
1224 -- to Type.)
1225 candidateQTyVarsOfKind :: TcKind -- Not necessarily zonked
1226 -> TcM CandidatesQTvs
1227 candidateQTyVarsOfKind ty = collect_cand_qtvs True emptyVarSet mempty ty
1228
1229 candidateQTyVarsOfKinds :: [TcKind] -- Not necessarily zonked
1230 -> TcM CandidatesQTvs
1231 candidateQTyVarsOfKinds tys = foldM (collect_cand_qtvs True emptyVarSet) mempty tys
1232
1233 delCandidates :: CandidatesQTvs -> [Var] -> CandidatesQTvs
1234 delCandidates (DV { dv_kvs = kvs, dv_tvs = tvs, dv_cvs = cvs }) vars
1235 = DV { dv_kvs = kvs `delDVarSetList` vars
1236 , dv_tvs = tvs `delDVarSetList` vars
1237 , dv_cvs = cvs `delVarSetList` vars }
1238
1239 collect_cand_qtvs
1240 :: Bool -- True <=> consider every fv in Type to be dependent
1241 -> VarSet -- Bound variables (locals only)
1242 -> CandidatesQTvs -- Accumulating parameter
1243 -> Type -- Not necessarily zonked
1244 -> TcM CandidatesQTvs
1245
1246 -- Key points:
1247 -- * Looks through meta-tyvars as it goes;
1248 -- no need to zonk in advance
1249 --
1250 -- * Needs to be monadic anyway, because it does the zap-naughty
1251 -- stuff; see Note [Naughty quantification candidates]
1252 --
1253 -- * Returns fully-zonked CandidateQTvs, including their kinds
1254 -- so that subsequent dependency analysis (to build a well
1255 -- scoped telescope) works correctly
1256
1257 collect_cand_qtvs is_dep bound dvs ty
1258 = go dvs ty
1259 where
1260 is_bound tv = tv `elemVarSet` bound
1261
1262 -----------------
1263 go :: CandidatesQTvs -> TcType -> TcM CandidatesQTvs
1264 -- Uses accumulating-parameter style
1265 go dv (AppTy t1 t2) = foldlM go dv [t1, t2]
1266 go dv (TyConApp _ tys) = foldlM go dv tys
1267 go dv (FunTy _ arg res) = foldlM go dv [arg, res]
1268 go dv (LitTy {}) = return dv
1269 go dv (CastTy ty co) = do dv1 <- go dv ty
1270 collect_cand_qtvs_co bound dv1 co
1271 go dv (CoercionTy co) = collect_cand_qtvs_co bound dv co
1272
1273 go dv (TyVarTy tv)
1274 | is_bound tv = return dv
1275 | otherwise = do { m_contents <- isFilledMetaTyVar_maybe tv
1276 ; case m_contents of
1277 Just ind_ty -> go dv ind_ty
1278 Nothing -> go_tv dv tv }
1279
1280 go dv (ForAllTy (Bndr tv _) ty)
1281 = do { dv1 <- collect_cand_qtvs True bound dv (tyVarKind tv)
1282 ; collect_cand_qtvs is_dep (bound `extendVarSet` tv) dv1 ty }
1283
1284 -----------------
1285 go_tv dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) tv
1286 | tv `elemDVarSet` kvs
1287 = return dv -- We have met this tyvar aleady
1288
1289 | not is_dep
1290 , tv `elemDVarSet` tvs
1291 = return dv -- We have met this tyvar aleady
1292
1293 | otherwise
1294 = do { tv_kind <- zonkTcType (tyVarKind tv)
1295 -- This zonk is annoying, but it is necessary, both to
1296 -- ensure that the collected candidates have zonked kinds
1297 -- (#15795) and to make the naughty check
1298 -- (which comes next) works correctly
1299
1300 ; cur_lvl <- getTcLevel
1301 ; if | tcTyVarLevel tv <= cur_lvl
1302 -> return dv -- this variable is from an outer context; skip
1303 -- See Note [Use level numbers ofor quantification]
1304
1305 | intersectsVarSet bound (tyCoVarsOfType tv_kind)
1306 -- the tyvar must not be from an outer context, but we have
1307 -- already checked for this.
1308 -- See Note [Naughty quantification candidates]
1309 -> do { traceTc "Zapping naughty quantifier" $
1310 vcat [ ppr tv <+> dcolon <+> ppr tv_kind
1311 , text "bound:" <+> pprTyVars (nonDetEltsUniqSet bound)
1312 , text "fvs:" <+> pprTyVars (nonDetEltsUniqSet $
1313 tyCoVarsOfType tv_kind) ]
1314
1315 ; writeMetaTyVar tv (anyTypeOfKind tv_kind)
1316
1317 -- See Note [Recurring into kinds for candidateQTyVars]
1318 ; collect_cand_qtvs True bound dv tv_kind }
1319
1320 | otherwise
1321 -> do { let tv' = tv `setTyVarKind` tv_kind
1322 dv' | is_dep = dv { dv_kvs = kvs `extendDVarSet` tv' }
1323 | otherwise = dv { dv_tvs = tvs `extendDVarSet` tv' }
1324 -- See Note [Order of accumulation]
1325
1326 -- See Note [Recurring into kinds for candidateQTyVars]
1327 ; collect_cand_qtvs True bound dv' tv_kind } }
1328
1329 collect_cand_qtvs_co :: VarSet -- bound variables
1330 -> CandidatesQTvs -> Coercion
1331 -> TcM CandidatesQTvs
1332 collect_cand_qtvs_co bound = go_co
1333 where
1334 go_co dv (Refl ty) = collect_cand_qtvs True bound dv ty
1335 go_co dv (GRefl _ ty mco) = do dv1 <- collect_cand_qtvs True bound dv ty
1336 go_mco dv1 mco
1337 go_co dv (TyConAppCo _ _ cos) = foldlM go_co dv cos
1338 go_co dv (AppCo co1 co2) = foldlM go_co dv [co1, co2]
1339 go_co dv (FunCo _ co1 co2) = foldlM go_co dv [co1, co2]
1340 go_co dv (AxiomInstCo _ _ cos) = foldlM go_co dv cos
1341 go_co dv (AxiomRuleCo _ cos) = foldlM go_co dv cos
1342 go_co dv (UnivCo prov _ t1 t2) = do dv1 <- go_prov dv prov
1343 dv2 <- collect_cand_qtvs True bound dv1 t1
1344 collect_cand_qtvs True bound dv2 t2
1345 go_co dv (SymCo co) = go_co dv co
1346 go_co dv (TransCo co1 co2) = foldlM go_co dv [co1, co2]
1347 go_co dv (NthCo _ _ co) = go_co dv co
1348 go_co dv (LRCo _ co) = go_co dv co
1349 go_co dv (InstCo co1 co2) = foldlM go_co dv [co1, co2]
1350 go_co dv (KindCo co) = go_co dv co
1351 go_co dv (SubCo co) = go_co dv co
1352
1353 go_co dv (HoleCo hole)
1354 = do m_co <- unpackCoercionHole_maybe hole
1355 case m_co of
1356 Just co -> go_co dv co
1357 Nothing -> go_cv dv (coHoleCoVar hole)
1358
1359 go_co dv (CoVarCo cv) = go_cv dv cv
1360
1361 go_co dv (ForAllCo tcv kind_co co)
1362 = do { dv1 <- go_co dv kind_co
1363 ; collect_cand_qtvs_co (bound `extendVarSet` tcv) dv1 co }
1364
1365 go_mco dv MRefl = return dv
1366 go_mco dv (MCo co) = go_co dv co
1367
1368 go_prov dv UnsafeCoerceProv = return dv
1369 go_prov dv (PhantomProv co) = go_co dv co
1370 go_prov dv (ProofIrrelProv co) = go_co dv co
1371 go_prov dv (PluginProv _) = return dv
1372
1373 go_cv :: CandidatesQTvs -> CoVar -> TcM CandidatesQTvs
1374 go_cv dv@(DV { dv_cvs = cvs }) cv
1375 | is_bound cv = return dv
1376 | cv `elemVarSet` cvs = return dv
1377
1378 -- See Note [Recurring into kinds for candidateQTyVars]
1379 | otherwise = collect_cand_qtvs True bound
1380 (dv { dv_cvs = cvs `extendVarSet` cv })
1381 (idType cv)
1382
1383 is_bound tv = tv `elemVarSet` bound
1384
1385 {- Note [Order of accumulation]
1386 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1387 You might be tempted (like I was) to use unitDVarSet and mappend
1388 rather than extendDVarSet. However, the union algorithm for
1389 deterministic sets depends on (roughly) the size of the sets. The
1390 elements from the smaller set end up to the right of the elements from
1391 the larger one. When sets are equal, the left-hand argument to
1392 `mappend` goes to the right of the right-hand argument.
1393
1394 In our case, if we use unitDVarSet and mappend, we learn that the free
1395 variables of (a -> b -> c -> d) are [b, a, c, d], and we then quantify
1396 over them in that order. (The a comes after the b because we union the
1397 singleton sets as ({a} `mappend` {b}), producing {b, a}. Thereafter,
1398 the size criterion works to our advantage.) This is just annoying to
1399 users, so I use `extendDVarSet`, which unambiguously puts the new
1400 element to the right.
1401
1402 Note that the unitDVarSet/mappend implementation would not be wrong
1403 against any specification -- just suboptimal and confounding to users.
1404
1405 Note [Recurring into kinds for candidateQTyVars]
1406 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1407 First, read Note [Closing over free variable kinds] in TyCoFVs, paying
1408 attention to the end of the Note about using an empty bound set when
1409 traversing a variable's kind.
1410
1411 That Note concludes with the recommendation that we empty out the bound
1412 set when recurring into the kind of a type variable. Yet, we do not do
1413 this here. I have two tasks in order to convince you that this code is
1414 right. First, I must show why it is safe to ignore the reasoning in that
1415 Note. Then, I must show why is is necessary to contradict the reasoning in
1416 that Note.
1417
1418 Why it is safe: There can be no
1419 shadowing in the candidateQ... functions: they work on the output of
1420 type inference, which is seeded by the renamer and its insistence to
1421 use different Uniques for different variables. (In contrast, the Core
1422 functions work on the output of optimizations, which may introduce
1423 shadowing.) Without shadowing, the problem studied by
1424 Note [Closing over free variable kinds] in TyCoFVs cannot happen.
1425
1426 Why it is necessary:
1427 Wiping the bound set would be just plain wrong here. Consider
1428
1429 forall k1 k2 (a :: k1). Proxy k2 (a |> (hole :: k1 ~# k2))
1430
1431 We really don't want to think k1 and k2 are free here. (It's true that we'll
1432 never be able to fill in `hole`, but we don't want to go off the rails just
1433 because we have an insoluble coercion hole.) So: why is it wrong to wipe
1434 the bound variables here but right in Core? Because the final statement
1435 in Note [Closing over free variable kinds] in TyCoFVs is wrong: not
1436 every variable is either free or bound. A variable can be a hole, too!
1437 The reasoning in that Note then breaks down.
1438
1439 And the reasoning applies just as well to free non-hole variables, so we
1440 retain the bound set always.
1441
1442 -}
1443
1444 {- *********************************************************************
1445 * *
1446 Quantification
1447 * *
1448 ************************************************************************
1449
1450 Note [quantifyTyVars]
1451 ~~~~~~~~~~~~~~~~~~~~~
1452 quantifyTyVars is given the free vars of a type that we
1453 are about to wrap in a forall.
1454
1455 It takes these free type/kind variables (partitioned into dependent and
1456 non-dependent variables) skolemises metavariables with a TcLevel greater
1457 than the ambient level (see Note [Use level numbers of quantification]).
1458
1459 * This function distinguishes between dependent and non-dependent
1460 variables only to keep correct defaulting behavior with -XNoPolyKinds.
1461 With -XPolyKinds, it treats both classes of variables identically.
1462
1463 * quantifyTyVars never quantifies over
1464 - a coercion variable (or any tv mentioned in the kind of a covar)
1465 - a runtime-rep variable
1466
1467 Note [Use level numbers for quantification]
1468 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1469 The level numbers assigned to metavariables are very useful. Not only
1470 do they track touchability (Note [TcLevel and untouchable type variables]
1471 in TcType), but they also allow us to determine which variables to
1472 generalise. The rule is this:
1473
1474 When generalising, quantify only metavariables with a TcLevel greater
1475 than the ambient level.
1476
1477 This works because we bump the level every time we go inside a new
1478 source-level construct. In a traditional generalisation algorithm, we
1479 would gather all free variables that aren't free in an environment.
1480 However, if a variable is in that environment, it will always have a lower
1481 TcLevel: it came from an outer scope. So we can replace the "free in
1482 environment" check with a level-number check.
1483
1484 Here is an example:
1485
1486 f x = x + (z True)
1487 where
1488 z y = x * x
1489
1490 We start by saying (x :: alpha[1]). When inferring the type of z, we'll
1491 quickly discover that z :: alpha[1]. But it would be disastrous to
1492 generalise over alpha in the type of z. So we need to know that alpha
1493 comes from an outer environment. By contrast, the type of y is beta[2],
1494 and we are free to generalise over it. What's the difference between
1495 alpha[1] and beta[2]? Their levels. beta[2] has the right TcLevel for
1496 generalisation, and so we generalise it. alpha[1] does not, and so
1497 we leave it alone.
1498
1499 Note that not *every* variable with a higher level will get generalised,
1500 either due to the monomorphism restriction or other quirks. See, for
1501 example, the code in TcSimplify.decideMonoTyVars and in
1502 TcHsType.kindGeneralizeSome, both of which exclude certain otherwise-eligible
1503 variables from being generalised.
1504
1505 Using level numbers for quantification is implemented in the candidateQTyVars...
1506 functions, by adding only those variables with a level strictly higher than
1507 the ambient level to the set of candidates.
1508
1509 Note [quantifyTyVars determinism]
1510 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1511 The results of quantifyTyVars are wrapped in a forall and can end up in the
1512 interface file. One such example is inferred type signatures. They also affect
1513 the results of optimizations, for example worker-wrapper. This means that to
1514 get deterministic builds quantifyTyVars needs to be deterministic.
1515
1516 To achieve this CandidatesQTvs is backed by deterministic sets which allows them
1517 to be later converted to a list in a deterministic order.
1518
1519 For more information about deterministic sets see
1520 Note [Deterministic UniqFM] in UniqDFM.
1521 -}
1522
1523 quantifyTyVars
1524 :: CandidatesQTvs -- See Note [Dependent type variables]
1525 -- Already zonked
1526 -> TcM [TcTyVar]
1527 -- See Note [quantifyTyVars]
1528 -- Can be given a mixture of TcTyVars and TyVars, in the case of
1529 -- associated type declarations. Also accepts covars, but *never* returns any.
1530 -- According to Note [Use level numbers for quantification] and the
1531 -- invariants on CandidateQTvs, we do not have to filter out variables
1532 -- free in the environment here. Just quantify unconditionally, subject
1533 -- to the restrictions in Note [quantifyTyVars].
1534 quantifyTyVars dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
1535 -- short-circuit common case
1536 | isEmptyDVarSet dep_tkvs
1537 , isEmptyDVarSet nondep_tkvs
1538 = do { traceTc "quantifyTyVars has nothing to quantify" empty
1539 ; return [] }
1540
1541 | otherwise
1542 = do { traceTc "quantifyTyVars 1" (ppr dvs)
1543
1544 ; let dep_kvs = scopedSort $ dVarSetElems dep_tkvs
1545 -- scopedSort: put the kind variables into
1546 -- well-scoped order.
1547 -- E.g. [k, (a::k)] not the other way roud
1548
1549 nondep_tvs = dVarSetElems (nondep_tkvs `minusDVarSet` dep_tkvs)
1550 -- See Note [Dependent type variables]
1551 -- The `minus` dep_tkvs removes any kind-level vars
1552 -- e.g. T k (a::k) Since k appear in a kind it'll
1553 -- be in dv_kvs, and is dependent. So remove it from
1554 -- dv_tvs which will also contain k
1555 -- NB kinds of tvs are zonked by zonkTyCoVarsAndFV
1556
1557 -- In the non-PolyKinds case, default the kind variables
1558 -- to *, and zonk the tyvars as usual. Notice that this
1559 -- may make quantifyTyVars return a shorter list
1560 -- than it was passed, but that's ok
1561 ; poly_kinds <- xoptM LangExt.PolyKinds
1562 ; dep_kvs' <- mapMaybeM (zonk_quant (not poly_kinds)) dep_kvs
1563 ; nondep_tvs' <- mapMaybeM (zonk_quant False) nondep_tvs
1564 ; let final_qtvs = dep_kvs' ++ nondep_tvs'
1565 -- Because of the order, any kind variables
1566 -- mentioned in the kinds of the nondep_tvs'
1567 -- now refer to the dep_kvs'
1568
1569 ; traceTc "quantifyTyVars 2"
1570 (vcat [ text "nondep:" <+> pprTyVars nondep_tvs
1571 , text "dep:" <+> pprTyVars dep_kvs
1572 , text "dep_kvs'" <+> pprTyVars dep_kvs'
1573 , text "nondep_tvs'" <+> pprTyVars nondep_tvs' ])
1574
1575 -- We should never quantify over coercion variables; check this
1576 ; let co_vars = filter isCoVar final_qtvs
1577 ; MASSERT2( null co_vars, ppr co_vars )
1578
1579 ; return final_qtvs }
1580 where
1581 -- zonk_quant returns a tyvar if it should be quantified over;
1582 -- otherwise, it returns Nothing. The latter case happens for
1583 -- * Kind variables, with -XNoPolyKinds: don't quantify over these
1584 -- * RuntimeRep variables: we never quantify over these
1585 zonk_quant default_kind tkv
1586 | not (isTyVar tkv)
1587 = return Nothing -- this can happen for a covar that's associated with
1588 -- a coercion hole. Test case: typecheck/should_compile/T2494
1589
1590 | not (isTcTyVar tkv) -- I don't think this can ever happen.
1591 -- Hence the assert
1592 = ASSERT2( False, text "quantifying over a TyVar" <+> ppr tkv)
1593 return (Just tkv)
1594
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)