never executed always true always false
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE RecordWildCards #-}
3 {-# LANGUAGE ExistentialQuantification #-}
4
5 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
6
7 module GHC.Tc.Errors.Hole
8 ( findValidHoleFits
9 , tcCheckHoleFit
10 , withoutUnification
11 , tcSubsumes
12 , isFlexiTyVar
13 , tcFilterHoleFits
14 , getLocalBindings
15 , pprHoleFit
16 , addHoleFitDocs
17 , getHoleFitSortingAlg
18 , getHoleFitDispConfig
19 , HoleFitDispConfig (..)
20 , HoleFitSortingAlg (..)
21 , relevantCts
22 , zonkSubs
23
24 , sortHoleFitsByGraph
25 , sortHoleFitsBySize
26
27
28 -- Re-exported from GHC.Tc.Errors.Hole.FitTypes
29 , HoleFitPlugin (..), HoleFitPluginR (..)
30 )
31 where
32
33 import GHC.Prelude
34
35 import GHC.Tc.Types
36 import GHC.Tc.Utils.Monad
37 import GHC.Tc.Types.Constraint
38 import GHC.Tc.Types.Origin
39 import GHC.Tc.Utils.TcMType
40 import GHC.Tc.Types.Evidence
41 import GHC.Tc.Utils.TcType
42 import GHC.Core.Type
43 import GHC.Core.DataCon
44 import GHC.Types.Name
45 import GHC.Types.Name.Reader ( pprNameProvenance , GlobalRdrElt (..)
46 , globalRdrEnvElts, greMangledName, grePrintableName )
47 import GHC.Builtin.Names ( gHC_ERR )
48 import GHC.Types.Id
49 import GHC.Types.Var.Set
50 import GHC.Types.Var.Env
51 import GHC.Types.TyThing
52 import GHC.Data.Bag
53 import GHC.Core.ConLike ( ConLike(..) )
54 import GHC.Utils.Misc
55 import GHC.Utils.Panic
56 import GHC.Tc.Utils.Env (tcLookup)
57 import GHC.Utils.Outputable
58 import GHC.Driver.Session
59 import GHC.Data.Maybe
60 import GHC.Utils.FV ( fvVarList, fvVarSet, unionFV, mkFVs, FV )
61
62 import Control.Arrow ( (&&&) )
63
64 import Control.Monad ( filterM, replicateM, foldM )
65 import Data.List ( partition, sort, sortOn, nubBy )
66 import Data.Graph ( graphFromEdges, topSort )
67
68
69 import GHC.Tc.Solver ( simplifyTopWanteds, runTcSDerivedsEarlyAbort )
70 import GHC.Tc.Utils.Unify ( tcSubTypeSigma )
71
72 import GHC.HsToCore.Docs ( extractDocs )
73 import qualified Data.Map as Map
74 import GHC.Hs.Doc ( unpackHDS, DeclDocMap(..) )
75 import GHC.Unit.Module.ModIface ( ModIface_(..) )
76 import GHC.Iface.Load ( loadInterfaceForNameMaybe )
77
78 import GHC.Builtin.Utils (knownKeyNames)
79
80 import GHC.Tc.Errors.Hole.FitTypes
81
82
83 {-
84 Note [Valid hole fits include ...]
85 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
86 `findValidHoleFits` returns the "Valid hole fits include ..." message.
87 For example, look at the following definitions in a file called test.hs:
88
89 import Data.List (inits)
90
91 f :: [String]
92 f = _ "hello, world"
93
94 The hole in `f` would generate the message:
95
96 • Found hole: _ :: [Char] -> [String]
97 • In the expression: _
98 In the expression: _ "hello, world"
99 In an equation for ‘f’: f = _ "hello, world"
100 • Relevant bindings include f :: [String] (bound at test.hs:6:1)
101 Valid hole fits include
102 lines :: String -> [String]
103 (imported from ‘Prelude’ at mpt.hs:3:8-9
104 (and originally defined in ‘base-4.11.0.0:Data.OldList’))
105 words :: String -> [String]
106 (imported from ‘Prelude’ at mpt.hs:3:8-9
107 (and originally defined in ‘base-4.11.0.0:Data.OldList’))
108 inits :: forall a. [a] -> [[a]]
109 with inits @Char
110 (imported from ‘Data.List’ at mpt.hs:4:19-23
111 (and originally defined in ‘base-4.11.0.0:Data.OldList’))
112 repeat :: forall a. a -> [a]
113 with repeat @String
114 (imported from ‘Prelude’ at mpt.hs:3:8-9
115 (and originally defined in ‘GHC.List’))
116 fail :: forall (m :: * -> *). Monad m => forall a. String -> m a
117 with fail @[] @String
118 (imported from ‘Prelude’ at mpt.hs:3:8-9
119 (and originally defined in ‘GHC.Base’))
120 return :: forall (m :: * -> *). Monad m => forall a. a -> m a
121 with return @[] @String
122 (imported from ‘Prelude’ at mpt.hs:3:8-9
123 (and originally defined in ‘GHC.Base’))
124 pure :: forall (f :: * -> *). Applicative f => forall a. a -> f a
125 with pure @[] @String
126 (imported from ‘Prelude’ at mpt.hs:3:8-9
127 (and originally defined in ‘GHC.Base’))
128 read :: forall a. Read a => String -> a
129 with read @[String]
130 (imported from ‘Prelude’ at mpt.hs:3:8-9
131 (and originally defined in ‘Text.Read’))
132 mempty :: forall a. Monoid a => a
133 with mempty @([Char] -> [String])
134 (imported from ‘Prelude’ at mpt.hs:3:8-9
135 (and originally defined in ‘GHC.Base’))
136
137 Valid hole fits are found by checking top level identifiers and local bindings
138 in scope for whether their type can be instantiated to the type of the hole.
139 Additionally, we also need to check whether all relevant constraints are solved
140 by choosing an identifier of that type as well, see Note [Relevant constraints]
141
142 Since checking for subsumption results in the side-effect of type variables
143 being unified by the simplifier, we need to take care to restore them after
144 to being flexible type variables after we've checked for subsumption.
145 This is to avoid affecting the hole and later checks by prematurely having
146 unified one of the free unification variables.
147
148 When outputting, we sort the hole fits by the size of the types we'd need to
149 apply by type application to the type of the fit to make it fit. This is done
150 in order to display "more relevant" suggestions first. Another option is to
151 sort by building a subsumption graph of fits, i.e. a graph of which fits subsume
152 what other fits, and then outputting those fits which are subsumed by other
153 fits (i.e. those more specific than other fits) first. This results in the ones
154 "closest" to the type of the hole to be displayed first.
155
156 To help users understand how the suggested fit works, we also display the values
157 that the quantified type variables would take if that fit is used, like
158 `mempty @([Char] -> [String])` and `pure @[] @String` in the example above.
159 If -XTypeApplications is enabled, this can even be copied verbatim as a
160 replacement for the hole.
161
162 Note [Checking hole fits]
163 ~~~~~~~~~~~~~~~~~~~~~~~~~
164 If we have a hole of type hole_ty, we want to know whether a variable
165 of type ty is a valid fit for the whole. This is a subsumption check:
166 we wish to know whether ty <: hole_ty. But, of course, the check
167 must take into account any givens and relevant constraints.
168 (See also Note [Relevant constraints]).
169
170 For the simplifier to be able to use any givens present in the enclosing
171 implications to solve relevant constraints, we nest the wanted subsumption
172 constraints and relevant constraints within the enclosing implications.
173
174 As an example, let's look at the following code:
175
176 f :: Show a => a -> String
177 f x = show _
178
179 Suppose the hole is assigned type a0_a1pd[tau:2].
180 Here the nested implications are just one level deep, namely:
181
182 [Implic {
183 TcLevel = 2
184 Skolems = a_a1pa[sk:2]
185 No-eqs = True
186 Status = Unsolved
187 Given = $dShow_a1pc :: Show a_a1pa[sk:2]
188 Wanted =
189 WC {wc_simple =
190 [WD] $dShow_a1pe {0}:: Show a0_a1pd[tau:2] (CDictCan(psc))}
191 Binds = EvBindsVar<a1pi>
192 Needed inner = []
193 Needed outer = []
194 the type signature for:
195 f :: forall a. Show a => a -> String }]
196
197 As we can see, the givens say that the skolem
198 `a_a1pa[sk:2]` fulfills the Show constraint, and that we must prove
199 the [W] Show a0_a1pd[tau:2] constraint -- that is, whatever fills the
200 hole must have a Show instance.
201
202 When we now check whether `x :: a_a1pa[sk:2]` fits the hole in
203 `tcCheckHoleFit`, the call to `tcSubType` will end up unifying the meta type
204 variable `a0_a1pd[tau:2] := a_a1pa[sk:2]`. By wrapping the wanted constraints
205 needed by tcSubType_NC and the relevant constraints (see Note [Relevant
206 Constraints] for more details) in the nested implications, we can pass the
207 information in the givens along to the simplifier. For our example, we end up
208 needing to check whether the following constraints are soluble.
209
210 WC {wc_impl =
211 Implic {
212 TcLevel = 2
213 Skolems = a_a1pa[sk:2]
214 No-eqs = True
215 Status = Unsolved
216 Given = $dShow_a1pc :: Show a_a1pa[sk:2]
217 Wanted =
218 WC {wc_simple =
219 [WD] $dShow_a1pe {0}:: Show a0_a1pd[tau:2] (CNonCanonical)}
220 Binds = EvBindsVar<a1pl>
221 Needed inner = []
222 Needed outer = []
223 the type signature for:
224 f :: forall a. Show a => a -> String }}
225
226 But since `a0_a1pd[tau:2] := a_a1pa[sk:2]` and we have from the nested
227 implications that Show a_a1pa[sk:2] is a given, this is trivial, and we end up
228 with a final WC of WC {}, confirming x :: a0_a1pd[tau:2] as a match.
229
230 To avoid side-effects on the nested implications, we create a new EvBindsVar so
231 that any changes to the ev binds during a check remains localised to that check.
232 In addition, we call withoutUnification to reset any unified metavariables; this
233 call is actually done outside tcCheckHoleFit so that the results can be formatted
234 for the user before resetting variables.
235
236 Note [Valid refinement hole fits include ...]
237 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
238 When the `-frefinement-level-hole-fits=N` flag is given, we additionally look
239 for "valid refinement hole fits"", i.e. valid hole fits with up to N
240 additional holes in them.
241
242 With `-frefinement-level-hole-fits=0` (the default), GHC will find all
243 identifiers 'f' (top-level or nested) that will fit in the hole.
244
245 With `-frefinement-level-hole-fits=1`, GHC will additionally find all
246 applications 'f _' that will fit in the hole, where 'f' is an in-scope
247 identifier, applied to single argument. It will also report the type of the
248 needed argument (a new hole).
249
250 And similarly as the number of arguments increases
251
252 As an example, let's look at the following code:
253
254 f :: [Integer] -> Integer
255 f = _
256
257 with `-frefinement-level-hole-fits=1`, we'd get:
258
259 Valid refinement hole fits include
260
261 foldl1 (_ :: Integer -> Integer -> Integer)
262 with foldl1 @[] @Integer
263 where foldl1 :: forall (t :: * -> *).
264 Foldable t =>
265 forall a. (a -> a -> a) -> t a -> a
266 foldr1 (_ :: Integer -> Integer -> Integer)
267 with foldr1 @[] @Integer
268 where foldr1 :: forall (t :: * -> *).
269 Foldable t =>
270 forall a. (a -> a -> a) -> t a -> a
271 const (_ :: Integer)
272 with const @Integer @[Integer]
273 where const :: forall a b. a -> b -> a
274 ($) (_ :: [Integer] -> Integer)
275 with ($) @'GHC.Types.LiftedRep @[Integer] @Integer
276 where ($) :: forall a b. (a -> b) -> a -> b
277 fail (_ :: String)
278 with fail @((->) [Integer]) @Integer
279 where fail :: forall (m :: * -> *).
280 Monad m =>
281 forall a. String -> m a
282 return (_ :: Integer)
283 with return @((->) [Integer]) @Integer
284 where return :: forall (m :: * -> *). Monad m => forall a. a -> m a
285 (Some refinement hole fits suppressed;
286 use -fmax-refinement-hole-fits=N or -fno-max-refinement-hole-fits)
287
288 Which are hole fits with holes in them. This allows e.g. beginners to
289 discover the fold functions and similar, but also allows for advanced users
290 to figure out the valid functions in the Free monad, e.g.
291
292 instance Functor f => Monad (Free f) where
293 Pure a >>= f = f a
294 Free f >>= g = Free (fmap _a f)
295
296 Will output (with -frefinment-level-hole-fits=1):
297 Found hole: _a :: Free f a -> Free f b
298 Where: ‘a’, ‘b’ are rigid type variables bound by
299 the type signature for:
300 (>>=) :: forall a b. Free f a -> (a -> Free f b) -> Free f b
301 at fms.hs:25:12-14
302 ‘f’ is a rigid type variable bound by
303 ...
304 Relevant bindings include
305 g :: a -> Free f b (bound at fms.hs:27:16)
306 f :: f (Free f a) (bound at fms.hs:27:10)
307 (>>=) :: Free f a -> (a -> Free f b) -> Free f b
308 (bound at fms.hs:25:12)
309 ...
310 Valid refinement hole fits include
311 ...
312 (=<<) (_ :: a -> Free f b)
313 with (=<<) @(Free f) @a @b
314 where (=<<) :: forall (m :: * -> *) a b.
315 Monad m =>
316 (a -> m b) -> m a -> m b
317 (imported from ‘Prelude’ at fms.hs:5:18-22
318 (and originally defined in ‘GHC.Base’))
319 ...
320
321 Where `(=<<) _` is precisely the function we want (we ultimately want `>>= g`).
322
323 We find these refinement suggestions by considering hole fits that don't
324 fit the type of the hole, but ones that would fit if given an additional
325 argument. We do this by creating a new type variable with `newOpenFlexiTyVar`
326 (e.g. `t_a1/m[tau:1]`), and then considering hole fits of the type
327 `t_a1/m[tau:1] -> v` where `v` is the type of the hole.
328
329 Since the simplifier is free to unify this new type variable with any type, we
330 can discover any identifiers that would fit if given another identifier of a
331 suitable type. This is then generalized so that we can consider any number of
332 additional arguments by setting the `-frefinement-level-hole-fits` flag to any
333 number, and then considering hole fits like e.g. `foldl _ _` with two additional
334 arguments.
335
336 To make sure that the refinement hole fits are useful, we check that the types
337 of the additional holes have a concrete value and not just an invented type
338 variable. This eliminates suggestions such as `head (_ :: [t0 -> a]) (_ :: t0)`,
339 and limits the number of less than useful refinement hole fits.
340
341 Additionally, to further aid the user in their implementation, we show the
342 types of the holes the binding would have to be applied to in order to work.
343 In the free monad example above, this is demonstrated with
344 `(=<<) (_ :: a -> Free f b)`, which tells the user that the `(=<<)` needs to
345 be applied to an expression of type `a -> Free f b` in order to match.
346 If -XScopedTypeVariables is enabled, this hole fit can even be copied verbatim.
347
348 Note [Relevant constraints]
349 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
350 As highlighted by #14273, we need to check any relevant constraints as well
351 as checking for subsumption. Relevant constraints are the simple constraints
352 whose free unification variables are mentioned in the type of the hole.
353
354 In the simplest case, these are all non-hole constraints in the simples, such
355 as is the case in
356
357 f :: String
358 f = show _
359
360 Here, the hole is given type a0_a1kv[tau:1]. Then, the emitted constraint is:
361
362 [WD] $dShow_a1kw {0}:: Show a0_a1kv[tau:1] (CNonCanonical)
363
364 However, when there are multiple holes, we need to be more careful. As an
365 example, Let's take a look at the following code:
366
367 f :: Show a => a -> String
368 f x = show (_b (show _a))
369
370 Here there are two holes, `_a` and `_b`. Suppose _a :: a0_a1pd[tau:2] and
371 _b :: a1_a1po[tau:2]. Then, the simple constraints passed to
372 findValidHoleFits are:
373
374 [[WD] $dShow_a1pe {0}:: Show a0_a1pd[tau:2] (CNonCanonical),
375 [WD] $dShow_a1pp {0}:: Show a1_a1po[tau:2] (CNonCanonical)]
376
377 When we are looking for a match for the hole `_a`, we filter the simple
378 constraints to the "Relevant constraints", by throwing out any constraints
379 which do not mention a variable mentioned in the type of the hole. For hole
380 `_a`, we will then only require that the `$dShow_a1pe` constraint is solved,
381 since that is the only constraint that mentions any free type variables
382 mentioned in the hole constraint for `_a`, namely `a_a1pd[tau:2]`, and
383 similarly for the hole `_b` we only require that the `$dShow_a1pe` constraint
384 is solved.
385
386 Note [Leaking errors]
387 ~~~~~~~~~~~~~~~~~~~~~
388 When considering candidates, GHC believes that we're checking for validity in
389 actual source. However, As evidenced by #15321, #15007 and #15202, this can
390 cause bewildering error messages. The solution here is simple: if a candidate
391 would cause the type checker to error, it is not a valid hole fit, and thus it
392 is discarded.
393
394 Note [Speeding up valid hole-fits]
395 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
396 To fix #16875 we noted that a lot of time was being spent on uneccessary work.
397
398 When we'd call `tcCheckHoleFit hole hole_ty ty`, we would end up by generating
399 a constraint to show that `hole_ty ~ ty`, including any constraints in `ty`. For
400 example, if `hole_ty = Int` and `ty = Foldable t => (a -> Bool) -> t a -> Bool`,
401 we'd have `(a_a1pa[sk:1] -> Bool) -> t_t2jk[sk:1] a_a1pa[sk:1] -> Bool ~# Int`
402 from the coercion, as well as `Foldable t_t2jk[sk:1]`. By adding a flag to
403 `TcSEnv` and adding a `runTcSDerivedsEarlyAbort`, we can fail as soon as we hit
404 an insoluble constraint. Since we don't need the result in the case that it
405 fails, a boolean `False` (i.e. "it didn't work" from `runTcSDerivedsEarlyAbort`)
406 is sufficient.
407
408 We also check whether the type of the hole is an immutable type variable (i.e.
409 a skolem). In that case, the only possible fits are fits of exactly that type,
410 which can only come from the locals. This speeds things up quite a bit when we
411 don't know anything about the type of the hole. This also helps with degenerate
412 fits like (`id (_ :: a)` and `head (_ :: [a])`) when looking for fits of type
413 `a`, where `a` is a skolem.
414 -}
415
416 data HoleFitDispConfig = HFDC { showWrap :: Bool
417 , showWrapVars :: Bool
418 , showType :: Bool
419 , showProv :: Bool
420 , showMatches :: Bool }
421
422 -- We read the various -no-show-*-of-hole-fits flags
423 -- and set the display config accordingly.
424 getHoleFitDispConfig :: TcM HoleFitDispConfig
425 getHoleFitDispConfig
426 = do { sWrap <- goptM Opt_ShowTypeAppOfHoleFits
427 ; sWrapVars <- goptM Opt_ShowTypeAppVarsOfHoleFits
428 ; sType <- goptM Opt_ShowTypeOfHoleFits
429 ; sProv <- goptM Opt_ShowProvOfHoleFits
430 ; sMatc <- goptM Opt_ShowMatchesOfHoleFits
431 ; return HFDC{ showWrap = sWrap, showWrapVars = sWrapVars
432 , showProv = sProv, showType = sType
433 , showMatches = sMatc } }
434
435 -- Which sorting algorithm to use
436 data HoleFitSortingAlg = HFSNoSorting -- Do not sort the fits at all
437 | HFSBySize -- Sort them by the size of the match
438 | HFSBySubsumption -- Sort by full subsumption
439 deriving (Eq, Ord)
440
441 getHoleFitSortingAlg :: TcM HoleFitSortingAlg
442 getHoleFitSortingAlg =
443 do { shouldSort <- goptM Opt_SortValidHoleFits
444 ; subsumSort <- goptM Opt_SortBySubsumHoleFits
445 ; sizeSort <- goptM Opt_SortBySizeHoleFits
446 -- We default to sizeSort unless it has been explicitly turned off
447 -- or subsumption sorting has been turned on.
448 ; return $ if not shouldSort
449 then HFSNoSorting
450 else if subsumSort
451 then HFSBySubsumption
452 else if sizeSort
453 then HFSBySize
454 else HFSNoSorting }
455
456 -- If enabled, we go through the fits and add any associated documentation,
457 -- by looking it up in the module or the environment (for local fits)
458 addHoleFitDocs :: [HoleFit] -> TcM [HoleFit]
459 addHoleFitDocs fits =
460 do { showDocs <- goptM Opt_ShowDocsOfHoleFits
461 ; if showDocs
462 then do { (_, DeclDocMap lclDocs, _) <- getGblEnv >>= extractDocs
463 ; mapM (upd lclDocs) fits }
464 else return fits }
465 where
466 msg = text "GHC.Tc.Errors.Hole addHoleFitDocs"
467 lookupInIface name (ModIface { mi_decl_docs = DeclDocMap dmap })
468 = Map.lookup name dmap
469 upd lclDocs fit@(HoleFit {hfCand = cand}) =
470 do { let name = getName cand
471 ; doc <- if hfIsLcl fit
472 then pure (Map.lookup name lclDocs)
473 else do { mbIface <- loadInterfaceForNameMaybe msg name
474 ; return $ mbIface >>= lookupInIface name }
475 ; return $ fit {hfDoc = doc} }
476 upd _ fit = return fit
477
478 -- For pretty printing hole fits, we display the name and type of the fit,
479 -- with added '_' to represent any extra arguments in case of a non-zero
480 -- refinement level.
481 pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc
482 pprHoleFit _ (RawHoleFit sd) = sd
483 pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) =
484 hang display 2 provenance
485 where tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars hfWrap
486 where pprArg b arg = case binderArgFlag b of
487 -- See Note [Explicit Case Statement for Specificity]
488 (Invisible spec) -> case spec of
489 SpecifiedSpec -> text "@" <> pprParendType arg
490 -- Do not print type application for inferred
491 -- variables (#16456)
492 InferredSpec -> empty
493 Required -> pprPanic "pprHoleFit: bad Required"
494 (ppr b <+> ppr arg)
495 tyAppVars = sep $ punctuate comma $
496 zipWithEqual "pprHoleFit" (\v t -> ppr (binderVar v) <+>
497 text "~" <+> pprParendType t)
498 vars hfWrap
499
500 vars = unwrapTypeVars hfType
501 where
502 -- Attempts to get all the quantified type variables in a type,
503 -- e.g.
504 -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a)
505 -- into [m, a]
506 unwrapTypeVars :: Type -> [TyCoVarBinder]
507 unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of
508 Just (_, _, unfunned) -> unwrapTypeVars unfunned
509 _ -> []
510 where (vars, unforalled) = splitForAllTyCoVarBinders t
511 holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches
512 holeDisp = if sMs then holeVs
513 else sep $ replicate (length hfMatches) $ text "_"
514 occDisp = case hfCand of
515 GreHFCand gre -> pprPrefixOcc (grePrintableName gre)
516 NameHFCand name -> pprPrefixOcc name
517 IdHFCand id_ -> pprPrefixOcc id_
518 tyDisp = ppWhen sTy $ dcolon <+> ppr hfType
519 has = not . null
520 wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars))
521 $ text "with" <+> if sWrp || not sTy
522 then occDisp <+> tyApp
523 else tyAppVars
524 docs = case hfDoc of
525 Just d -> text "{-^" <>
526 (vcat . map text . lines . unpackHDS) d
527 <> text "-}"
528 _ -> empty
529 funcInfo = ppWhen (has hfMatches && sTy) $
530 text "where" <+> occDisp <+> tyDisp
531 subDisp = occDisp <+> if has hfMatches then holeDisp else tyDisp
532 display = subDisp $$ nest 2 (funcInfo $+$ docs $+$ wrapDisp)
533 provenance = ppWhen sProv $ parens $
534 case hfCand of
535 GreHFCand gre -> pprNameProvenance gre
536 NameHFCand name -> text "bound at" <+> ppr (getSrcLoc name)
537 IdHFCand id_ -> text "bound at" <+> ppr (getSrcLoc id_)
538
539 getLocalBindings :: TidyEnv -> CtLoc -> TcM [Id]
540 getLocalBindings tidy_orig ct_loc
541 = do { (env1, _) <- zonkTidyOrigin tidy_orig (ctLocOrigin ct_loc)
542 ; go env1 [] (removeBindingShadowing $ tcl_bndrs lcl_env) }
543 where
544 lcl_env = ctLocEnv ct_loc
545
546 go :: TidyEnv -> [Id] -> [TcBinder] -> TcM [Id]
547 go _ sofar [] = return (reverse sofar)
548 go env sofar (tc_bndr : tc_bndrs) =
549 case tc_bndr of
550 TcIdBndr id _ -> keep_it id
551 _ -> discard_it
552 where
553 discard_it = go env sofar tc_bndrs
554 keep_it id = go env (id:sofar) tc_bndrs
555
556
557
558 -- See Note [Valid hole fits include ...]
559 findValidHoleFits :: TidyEnv -- ^ The tidy_env for zonking
560 -> [Implication] -- ^ Enclosing implications for givens
561 -> [Ct]
562 -- ^ The unsolved simple constraints in the implication for
563 -- the hole.
564 -> Hole
565 -> TcM (TidyEnv, SDoc)
566 findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
567 , hole_loc = ct_loc
568 , hole_ty = hole_ty }) =
569 do { rdr_env <- getGlobalRdrEnv
570 ; lclBinds <- getLocalBindings tidy_env ct_loc
571 ; maxVSubs <- maxValidHoleFits <$> getDynFlags
572 ; hfdc <- getHoleFitDispConfig
573 ; sortingAlg <- getHoleFitSortingAlg
574 ; dflags <- getDynFlags
575 ; hfPlugs <- tcg_hf_plugins <$> getGblEnv
576 ; let findVLimit = if sortingAlg > HFSNoSorting then Nothing else maxVSubs
577 refLevel = refLevelHoleFits dflags
578 hole = TypedHole { th_relevant_cts =
579 listToBag (relevantCts hole_ty simples)
580 , th_implics = implics
581 , th_hole = Just h }
582 (candidatePlugins, fitPlugins) =
583 unzip $ map (\p-> ((candPlugin p) hole, (fitPlugin p) hole)) hfPlugs
584 ; traceTc "findingValidHoleFitsFor { " $ ppr hole
585 ; traceTc "hole_lvl is:" $ ppr hole_lvl
586 ; traceTc "simples are: " $ ppr simples
587 ; traceTc "locals are: " $ ppr lclBinds
588 ; let (lcl, gbl) = partition gre_lcl (globalRdrEnvElts rdr_env)
589 -- We remove binding shadowings here, but only for the local level.
590 -- this is so we e.g. suggest the global fmap from the Functor class
591 -- even though there is a local definition as well, such as in the
592 -- Free monad example.
593 locals = removeBindingShadowing $
594 map IdHFCand lclBinds ++ map GreHFCand lcl
595 globals = map GreHFCand gbl
596 syntax = map NameHFCand builtIns
597 -- If the hole is a rigid type-variable, then we only check the
598 -- locals, since only they can match the type (in a meaningful way).
599 only_locals = any isImmutableTyVar $ getTyVar_maybe hole_ty
600 to_check = if only_locals then locals
601 else locals ++ syntax ++ globals
602 ; cands <- foldM (flip ($)) to_check candidatePlugins
603 ; traceTc "numPlugins are:" $ ppr (length candidatePlugins)
604 ; (searchDiscards, subs) <-
605 tcFilterHoleFits findVLimit hole (hole_ty, []) cands
606 ; (tidy_env, tidy_subs) <- zonkSubs tidy_env subs
607 ; tidy_sorted_subs <- sortFits sortingAlg tidy_subs
608 ; plugin_handled_subs <- foldM (flip ($)) tidy_sorted_subs fitPlugins
609 ; let (pVDisc, limited_subs) = possiblyDiscard maxVSubs plugin_handled_subs
610 vDiscards = pVDisc || searchDiscards
611 ; subs_with_docs <- addHoleFitDocs limited_subs
612 ; let vMsg = ppUnless (null subs_with_docs) $
613 hang (text "Valid hole fits include") 2 $
614 vcat (map (pprHoleFit hfdc) subs_with_docs)
615 $$ ppWhen vDiscards subsDiscardMsg
616 -- Refinement hole fits. See Note [Valid refinement hole fits include ...]
617 ; (tidy_env, refMsg) <- if refLevel >= Just 0 then
618 do { maxRSubs <- maxRefHoleFits <$> getDynFlags
619 -- We can use from just, since we know that Nothing >= _ is False.
620 ; let refLvls = [1..(fromJust refLevel)]
621 -- We make a new refinement type for each level of refinement, where
622 -- the level of refinement indicates number of additional arguments
623 -- to allow.
624 ; ref_tys <- mapM mkRefTy refLvls
625 ; traceTc "ref_tys are" $ ppr ref_tys
626 ; let findRLimit = if sortingAlg > HFSNoSorting then Nothing
627 else maxRSubs
628 ; refDs <- mapM (flip (tcFilterHoleFits findRLimit hole)
629 cands) ref_tys
630 ; (tidy_env, tidy_rsubs) <- zonkSubs tidy_env $ concatMap snd refDs
631 ; tidy_sorted_rsubs <- sortFits sortingAlg tidy_rsubs
632 -- For refinement substitutions we want matches
633 -- like id (_ :: t), head (_ :: [t]), asTypeOf (_ :: t),
634 -- and others in that vein to appear last, since these are
635 -- unlikely to be the most relevant fits.
636 ; (tidy_env, tidy_hole_ty) <- zonkTidyTcType tidy_env hole_ty
637 ; let hasExactApp = any (tcEqType tidy_hole_ty) . hfWrap
638 (exact, not_exact) = partition hasExactApp tidy_sorted_rsubs
639 ; plugin_handled_rsubs <- foldM (flip ($))
640 (not_exact ++ exact) fitPlugins
641 ; let (pRDisc, exact_last_rfits) =
642 possiblyDiscard maxRSubs $ plugin_handled_rsubs
643 rDiscards = pRDisc || any fst refDs
644 ; rsubs_with_docs <- addHoleFitDocs exact_last_rfits
645 ; return (tidy_env,
646 ppUnless (null rsubs_with_docs) $
647 hang (text "Valid refinement hole fits include") 2 $
648 vcat (map (pprHoleFit hfdc) rsubs_with_docs)
649 $$ ppWhen rDiscards refSubsDiscardMsg) }
650 else return (tidy_env, empty)
651 ; traceTc "findingValidHoleFitsFor }" empty
652 ; return (tidy_env, vMsg $$ refMsg) }
653 where
654 -- We extract the TcLevel from the constraint.
655 hole_lvl = ctLocLevel ct_loc
656
657 -- BuiltInSyntax names like (:) and []
658 builtIns :: [Name]
659 builtIns = filter isBuiltInSyntax knownKeyNames
660
661 -- We make a refinement type by adding a new type variable in front
662 -- of the type of t h hole, going from e.g. [Integer] -> Integer
663 -- to t_a1/m[tau:1] -> [Integer] -> Integer. This allows the simplifier
664 -- to unify the new type variable with any type, allowing us
665 -- to suggest a "refinement hole fit", like `(foldl1 _)` instead
666 -- of only concrete hole fits like `sum`.
667 mkRefTy :: Int -> TcM (TcType, [TcTyVar])
668 mkRefTy refLvl = (wrapWithVars &&& id) <$> newTyVars
669 where newTyVars = replicateM refLvl $ setLvl <$>
670 (newOpenTypeKind >>= newFlexiTyVar)
671 setLvl = flip setMetaTyVarTcLevel hole_lvl
672 wrapWithVars vars = mkVisFunTysMany (map mkTyVarTy vars) hole_ty
673
674 sortFits :: HoleFitSortingAlg -- How we should sort the hole fits
675 -> [HoleFit] -- The subs to sort
676 -> TcM [HoleFit]
677 sortFits HFSNoSorting subs = return subs
678 sortFits HFSBySize subs
679 = (++) <$> sortHoleFitsBySize (sort lclFits)
680 <*> sortHoleFitsBySize (sort gblFits)
681 where (lclFits, gblFits) = span hfIsLcl subs
682 -- To sort by subsumption, we invoke the sortByGraph function, which
683 -- builds the subsumption graph for the fits and then sorts them using a
684 -- graph sort. Since we want locals to come first anyway, we can sort
685 -- them separately. The substitutions are already checked in local then
686 -- global order, so we can get away with using span here.
687 -- We use (<*>) to expose the parallelism, in case it becomes useful later.
688 sortFits HFSBySubsumption subs
689 = (++) <$> sortHoleFitsByGraph (sort lclFits)
690 <*> sortHoleFitsByGraph (sort gblFits)
691 where (lclFits, gblFits) = span hfIsLcl subs
692
693 subsDiscardMsg :: SDoc
694 subsDiscardMsg =
695 text "(Some hole fits suppressed;" <+>
696 text "use -fmax-valid-hole-fits=N" <+>
697 text "or -fno-max-valid-hole-fits)"
698
699 refSubsDiscardMsg :: SDoc
700 refSubsDiscardMsg =
701 text "(Some refinement hole fits suppressed;" <+>
702 text "use -fmax-refinement-hole-fits=N" <+>
703 text "or -fno-max-refinement-hole-fits)"
704
705
706 -- Based on the flags, we might possibly discard some or all the
707 -- fits we've found.
708 possiblyDiscard :: Maybe Int -> [HoleFit] -> (Bool, [HoleFit])
709 possiblyDiscard (Just max) fits = (fits `lengthExceeds` max, take max fits)
710 possiblyDiscard Nothing fits = (False, fits)
711
712
713 -- We don't (as of yet) handle holes in types, only in expressions.
714 findValidHoleFits env _ _ _ = return (env, empty)
715
716 -- See Note [Relevant constraints]
717 relevantCts :: Type -> [Ct] -> [Ct]
718 relevantCts hole_ty simples = if isEmptyVarSet (fvVarSet hole_fvs) then []
719 else filter isRelevant simples
720 where ctFreeVarSet :: Ct -> VarSet
721 ctFreeVarSet = fvVarSet . tyCoFVsOfType . ctPred
722 hole_fvs = tyCoFVsOfType hole_ty
723 hole_fv_set = fvVarSet hole_fvs
724 anyFVMentioned :: Ct -> Bool
725 anyFVMentioned ct = ctFreeVarSet ct `intersectsVarSet` hole_fv_set
726 -- We filter out those constraints that have no variables (since
727 -- they won't be solved by finding a type for the type variable
728 -- representing the hole) and also other holes, since we're not
729 -- trying to find hole fits for many holes at once.
730 isRelevant ct = not (isEmptyVarSet (ctFreeVarSet ct))
731 && anyFVMentioned ct
732
733 -- We zonk the hole fits so that the output aligns with the rest
734 -- of the typed hole error message output.
735 zonkSubs :: TidyEnv -> [HoleFit] -> TcM (TidyEnv, [HoleFit])
736 zonkSubs = zonkSubs' []
737 where zonkSubs' zs env [] = return (env, reverse zs)
738 zonkSubs' zs env (hf:hfs) = do { (env', z) <- zonkSub env hf
739 ; zonkSubs' (z:zs) env' hfs }
740
741 zonkSub :: TidyEnv -> HoleFit -> TcM (TidyEnv, HoleFit)
742 zonkSub env hf@RawHoleFit{} = return (env, hf)
743 zonkSub env hf@HoleFit{hfType = ty, hfMatches = m, hfWrap = wrp}
744 = do { (env, ty') <- zonkTidyTcType env ty
745 ; (env, m') <- zonkTidyTcTypes env m
746 ; (env, wrp') <- zonkTidyTcTypes env wrp
747 ; let zFit = hf {hfType = ty', hfMatches = m', hfWrap = wrp'}
748 ; return (env, zFit ) }
749
750 -- | Sort by size uses as a measure for relevance the sizes of the different
751 -- types needed to instantiate the fit to the type of the hole.
752 -- This is much quicker than sorting by subsumption, and gives reasonable
753 -- results in most cases.
754 sortHoleFitsBySize :: [HoleFit] -> TcM [HoleFit]
755 sortHoleFitsBySize = return . sortOn sizeOfFit
756 where sizeOfFit :: HoleFit -> TypeSize
757 sizeOfFit = sizeTypes . nubBy tcEqType . hfWrap
758
759 -- Based on a suggestion by phadej on #ghc, we can sort the found fits
760 -- by constructing a subsumption graph, and then do a topological sort of
761 -- the graph. This makes the most specific types appear first, which are
762 -- probably those most relevant. This takes a lot of work (but results in
763 -- much more useful output), and can be disabled by
764 -- '-fno-sort-valid-hole-fits'.
765 sortHoleFitsByGraph :: [HoleFit] -> TcM [HoleFit]
766 sortHoleFitsByGraph fits = go [] fits
767 where tcSubsumesWCloning :: TcType -> TcType -> TcM Bool
768 tcSubsumesWCloning ht ty = withoutUnification fvs (tcSubsumes ht ty)
769 where fvs = tyCoFVsOfTypes [ht,ty]
770 go :: [(HoleFit, [HoleFit])] -> [HoleFit] -> TcM [HoleFit]
771 go sofar [] = do { traceTc "subsumptionGraph was" $ ppr sofar
772 ; return $ uncurry (++) $ partition hfIsLcl topSorted }
773 where toV (hf, adjs) = (hf, hfId hf, map hfId adjs)
774 (graph, fromV, _) = graphFromEdges $ map toV sofar
775 topSorted = map ((\(h,_,_) -> h) . fromV) $ topSort graph
776 go sofar (hf:hfs) =
777 do { adjs <- filterM (tcSubsumesWCloning (hfType hf) . hfType) fits
778 ; go ((hf, adjs):sofar) hfs }
779
780 -- | tcFilterHoleFits filters the candidates by whether, given the implications
781 -- and the relevant constraints, they can be made to match the type by
782 -- running the type checker. Stops after finding limit matches.
783 tcFilterHoleFits :: Maybe Int
784 -- ^ How many we should output, if limited
785 -> TypedHole -- ^ The hole to filter against
786 -> (TcType, [TcTyVar])
787 -- ^ The type to check for fits and a list of refinement
788 -- variables (free type variables in the type) for emulating
789 -- additional holes.
790 -> [HoleFitCandidate]
791 -- ^ The candidates to check whether fit.
792 -> TcM (Bool, [HoleFit])
793 -- ^ We return whether or not we stopped due to hitting the limit
794 -- and the fits we found.
795 tcFilterHoleFits (Just 0) _ _ _ = return (False, []) -- Stop right away on 0
796 tcFilterHoleFits limit typed_hole ht@(hole_ty, _) candidates =
797 do { traceTc "checkingFitsFor {" $ ppr hole_ty
798 ; (discards, subs) <- go [] emptyVarSet limit ht candidates
799 ; traceTc "checkingFitsFor }" empty
800 ; return (discards, subs) }
801 where
802 hole_fvs :: FV
803 hole_fvs = tyCoFVsOfType hole_ty
804 -- Kickoff the checking of the elements.
805 -- We iterate over the elements, checking each one in turn for whether
806 -- it fits, and adding it to the results if it does.
807 go :: [HoleFit] -- What we've found so far.
808 -> VarSet -- Ids we've already checked
809 -> Maybe Int -- How many we're allowed to find, if limited
810 -> (TcType, [TcTyVar]) -- The type, and its refinement variables.
811 -> [HoleFitCandidate] -- The elements we've yet to check.
812 -> TcM (Bool, [HoleFit])
813 go subs _ _ _ [] = return (False, reverse subs)
814 go subs _ (Just 0) _ _ = return (True, reverse subs)
815 go subs seen maxleft ty (el:elts) =
816 -- See Note [Leaking errors]
817 tryTcDiscardingErrs discard_it $
818 do { traceTc "lookingUp" $ ppr el
819 ; maybeThing <- lookup el
820 ; case maybeThing of
821 Just (id, id_ty) | not_trivial id ->
822 do { fits <- fitsHole ty id_ty
823 ; case fits of
824 Just (wrp, matches) -> keep_it id id_ty wrp matches
825 _ -> discard_it }
826 _ -> discard_it }
827 where
828 -- We want to filter out undefined and the likes from GHC.Err
829 not_trivial id = nameModule_maybe (idName id) /= Just gHC_ERR
830
831 lookup :: HoleFitCandidate -> TcM (Maybe (Id, Type))
832 lookup (IdHFCand id) = return (Just (id, idType id))
833 lookup hfc = do { thing <- tcLookup name
834 ; return $ case thing of
835 ATcId {tct_id = id} -> Just (id, idType id)
836 AGlobal (AnId id) -> Just (id, idType id)
837 AGlobal (AConLike (RealDataCon con)) ->
838 Just (dataConWrapId con, dataConNonlinearType con)
839 _ -> Nothing }
840 where name = case hfc of
841 #if __GLASGOW_HASKELL__ < 901
842 IdHFCand id -> idName id
843 #endif
844 GreHFCand gre -> greMangledName gre
845 NameHFCand name -> name
846 discard_it = go subs seen maxleft ty elts
847 keep_it eid eid_ty wrp ms = go (fit:subs) (extendVarSet seen eid)
848 ((\n -> n - 1) <$> maxleft) ty elts
849 where
850 fit = HoleFit { hfId = eid, hfCand = el, hfType = eid_ty
851 , hfRefLvl = length (snd ty)
852 , hfWrap = wrp, hfMatches = ms
853 , hfDoc = Nothing }
854
855
856
857
858 unfoldWrapper :: HsWrapper -> [Type]
859 unfoldWrapper = reverse . unfWrp'
860 where unfWrp' (WpTyApp ty) = [ty]
861 unfWrp' (WpCompose w1 w2) = unfWrp' w1 ++ unfWrp' w2
862 unfWrp' _ = []
863
864
865 -- The real work happens here, where we invoke the type checker using
866 -- tcCheckHoleFit to see whether the given type fits the hole.
867 fitsHole :: (TcType, [TcTyVar]) -- The type of the hole wrapped with the
868 -- refinement variables created to simulate
869 -- additional holes (if any), and the list
870 -- of those variables (possibly empty).
871 -- As an example: If the actual type of the
872 -- hole (as specified by the hole
873 -- constraint CHoleExpr passed to
874 -- findValidHoleFits) is t and we want to
875 -- simulate N additional holes, h_ty will
876 -- be r_1 -> ... -> r_N -> t, and
877 -- ref_vars will be [r_1, ... , r_N].
878 -- In the base case with no additional
879 -- holes, h_ty will just be t and ref_vars
880 -- will be [].
881 -> TcType -- The type we're checking to whether it can be
882 -- instantiated to the type h_ty.
883 -> TcM (Maybe ([TcType], [TcType])) -- If it is not a match, we
884 -- return Nothing. Otherwise,
885 -- we Just return the list of
886 -- types that quantified type
887 -- variables in ty would take
888 -- if used in place of h_ty,
889 -- and the list types of any
890 -- additional holes simulated
891 -- with the refinement
892 -- variables in ref_vars.
893 fitsHole (h_ty, ref_vars) ty =
894 -- We wrap this with the withoutUnification to avoid having side-effects
895 -- beyond the check, but we rely on the side-effects when looking for
896 -- refinement hole fits, so we can't wrap the side-effects deeper than this.
897 withoutUnification fvs $
898 do { traceTc "checkingFitOf {" $ ppr ty
899 ; (fits, wrp) <- tcCheckHoleFit hole h_ty ty
900 ; traceTc "Did it fit?" $ ppr fits
901 ; traceTc "wrap is: " $ ppr wrp
902 ; traceTc "checkingFitOf }" empty
903 -- We'd like to avoid refinement suggestions like `id _ _` or
904 -- `head _ _`, and only suggest refinements where our all phantom
905 -- variables got unified during the checking. This can be disabled
906 -- with the `-fabstract-refinement-hole-fits` flag.
907 -- Here we do the additional handling when there are refinement
908 -- variables, i.e. zonk them to read their final value to check for
909 -- abstract refinements, and to report what the type of the simulated
910 -- holes must be for this to be a match.
911 ; if fits then do {
912 -- Zonking is expensive, so we only do it if required.
913 z_wrp_tys <- zonkTcTypes (unfoldWrapper wrp)
914 ; if null ref_vars
915 then return (Just (z_wrp_tys, []))
916 else do { let -- To be concrete matches, matches have to
917 -- be more than just an invented type variable.
918 fvSet = fvVarSet fvs
919 notAbstract :: TcType -> Bool
920 notAbstract t = case getTyVar_maybe t of
921 Just tv -> tv `elemVarSet` fvSet
922 _ -> True
923 allConcrete = all notAbstract z_wrp_tys
924 ; z_vars <- zonkTcTyVars ref_vars
925 ; let z_mtvs = mapMaybe tcGetTyVar_maybe z_vars
926 ; allFilled <- not <$> anyM isFlexiTyVar z_mtvs
927 ; allowAbstract <- goptM Opt_AbstractRefHoleFits
928 ; if allowAbstract || (allFilled && allConcrete )
929 then return $ Just (z_wrp_tys, z_vars)
930 else return Nothing }}
931 else return Nothing }
932 where fvs = mkFVs ref_vars `unionFV` hole_fvs `unionFV` tyCoFVsOfType ty
933 hole = typed_hole { th_hole = Nothing }
934
935
936
937 -- | Checks whether a MetaTyVar is flexible or not.
938 isFlexiTyVar :: TcTyVar -> TcM Bool
939 isFlexiTyVar tv | isMetaTyVar tv = isFlexi <$> readMetaTyVar tv
940 isFlexiTyVar _ = return False
941
942 -- | Takes a list of free variables and restores any Flexi type variables in
943 -- free_vars after the action is run.
944 withoutUnification :: FV -> TcM a -> TcM a
945 withoutUnification free_vars action =
946 do { flexis <- filterM isFlexiTyVar fuvs
947 ; result <- action
948 -- Reset any mutated free variables
949 ; mapM_ restore flexis
950 ; return result }
951 where restore tv = do { traceTc "withoutUnification: restore flexi" (ppr tv)
952 ; writeTcRef (metaTyVarRef tv) Flexi }
953 fuvs = fvVarList free_vars
954
955 -- | Reports whether first type (ty_a) subsumes the second type (ty_b),
956 -- discarding any errors. Subsumption here means that the ty_b can fit into the
957 -- ty_a, i.e. `tcSubsumes a b == True` if b is a subtype of a.
958 tcSubsumes :: TcSigmaType -> TcSigmaType -> TcM Bool
959 tcSubsumes ty_a ty_b = fst <$> tcCheckHoleFit dummyHole ty_a ty_b
960 where dummyHole = TypedHole { th_relevant_cts = emptyBag
961 , th_implics = []
962 , th_hole = Nothing }
963
964 -- | A tcSubsumes which takes into account relevant constraints, to fix trac
965 -- #14273. This makes sure that when checking whether a type fits the hole,
966 -- the type has to be subsumed by type of the hole as well as fulfill all
967 -- constraints on the type of the hole.
968 tcCheckHoleFit :: TypedHole -- ^ The hole to check against
969 -> TcSigmaType
970 -- ^ The type of the hole to check against (possibly modified,
971 -- e.g. refined with additional holes for refinement hole-fits.)
972 -> TcSigmaType -- ^ The type to check whether fits.
973 -> TcM (Bool, HsWrapper)
974 -- ^ Whether it was a match, and the wrapper from hole_ty to ty.
975 tcCheckHoleFit _ hole_ty ty | hole_ty `eqType` ty
976 = return (True, idHsWrapper)
977 tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $
978 do { -- We wrap the subtype constraint in the implications to pass along the
979 -- givens, and so we must ensure that any nested implications and skolems
980 -- end up with the correct level. The implications are ordered so that
981 -- the innermost (the one with the highest level) is first, so it
982 -- suffices to get the level of the first one (or the current level, if
983 -- there are no implications involved).
984 innermost_lvl <- case th_implics of
985 [] -> getTcLevel
986 -- imp is the innermost implication
987 (imp:_) -> return (ic_tclvl imp)
988 ; (wrap, wanted) <- setTcLevel innermost_lvl $ captureConstraints $
989 tcSubTypeSigma (ExprSigCtxt NoRRC) ty hole_ty
990 ; traceTc "Checking hole fit {" empty
991 ; traceTc "wanteds are: " $ ppr wanted
992 ; if isEmptyWC wanted && isEmptyBag th_relevant_cts
993 then do { traceTc "}" empty
994 ; return (True, wrap) }
995 else do { fresh_binds <- newTcEvBinds
996 -- The relevant constraints may contain HoleDests, so we must
997 -- take care to clone them as well (to avoid #15370).
998 ; cloned_relevants <- mapBagM cloneWanted th_relevant_cts
999 -- We wrap the WC in the nested implications, for details, see
1000 -- Note [Checking hole fits]
1001 ; let wrapInImpls cts = foldl (flip (setWCAndBinds fresh_binds)) cts th_implics
1002 final_wc = wrapInImpls $ addSimples wanted cloned_relevants
1003 -- We add the cloned relevants to the wanteds generated
1004 -- by the call to tcSubType_NC, for details, see
1005 -- Note [Relevant constraints]. There's no need to clone
1006 -- the wanteds, because they are freshly generated by the
1007 -- call to`tcSubtype_NC`.
1008 ; traceTc "final_wc is: " $ ppr final_wc
1009 -- See Note [Speeding up valid-hole fits]
1010 ; (rem, _) <- tryTc $ runTcSDerivedsEarlyAbort $ simplifyTopWanteds final_wc
1011 ; traceTc "}" empty
1012 ; return (any isSolvedWC rem, wrap)
1013 } }
1014 where
1015 setWCAndBinds :: EvBindsVar -- Fresh ev binds var.
1016 -> Implication -- The implication to put WC in.
1017 -> WantedConstraints -- The WC constraints to put implic.
1018 -> WantedConstraints -- The new constraints.
1019 setWCAndBinds binds imp wc
1020 = mkImplicWC $ unitBag $ imp { ic_wanted = wc , ic_binds = binds }