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