never executed always true always false
1
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE GADTs #-}
4 {-# LANGUAGE LambdaCase #-}
5 {-# LANGUAGE DisambiguateRecordFields #-}
6
7 -- | Desugaring step of the
8 -- [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989).
9 --
10 -- Desugars Haskell source syntax into guard tree variants Pm*.
11 -- In terms of the paper, this module is concerned with Sections 3.1, Figure 4,
12 -- in particular.
13 module GHC.HsToCore.Pmc.Desugar (
14 desugarPatBind, desugarGRHSs, desugarMatches, desugarEmptyCase
15 ) where
16
17 import GHC.Prelude
18
19 import GHC.HsToCore.Pmc.Types
20 import GHC.HsToCore.Pmc.Utils
21 import GHC.Core (Expr(Var,App))
22 import GHC.Data.FastString (unpackFS, lengthFS)
23 import GHC.Data.Bag (bagToList)
24 import GHC.Driver.Session
25 import GHC.Hs
26 import GHC.Tc.Utils.Zonk (shortCutLit)
27 import GHC.Types.Id
28 import GHC.Core.ConLike
29 import GHC.Types.Name
30 import GHC.Builtin.Types
31 import GHC.Builtin.Names (rationalTyConName)
32 import GHC.Types.SrcLoc
33 import GHC.Utils.Outputable
34 import GHC.Utils.Panic
35 import GHC.Core.DataCon
36 import GHC.Types.Var (EvVar)
37 import GHC.Core.Coercion
38 import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper)
39 import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr)
40 import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper)
41 import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar)
42 import GHC.HsToCore.Match.Literal (dsLit, dsOverLit)
43 import GHC.HsToCore.Monad
44 import GHC.Core.TyCo.Rep
45 import GHC.Core.Type
46 import GHC.Data.Maybe
47 import qualified GHC.LanguageExtensions as LangExt
48 import GHC.Utils.Monad (concatMapM)
49 import GHC.Types.SourceText (FractionalLit(..))
50 import Control.Monad (zipWithM)
51 import Data.List (elemIndex)
52 import Data.List.NonEmpty ( NonEmpty(..) )
53 import qualified Data.List.NonEmpty as NE
54
55 -- import GHC.Driver.Ppr
56
57 -- | Smart constructor that eliminates trivial lets
58 mkPmLetVar :: Id -> Id -> [PmGrd]
59 mkPmLetVar x y | x == y = []
60 mkPmLetVar x y = [PmLet x (Var y)]
61
62 -- | ADT constructor pattern => no existentials, no local constraints
63 vanillaConGrd :: Id -> DataCon -> [Id] -> PmGrd
64 vanillaConGrd scrut con arg_ids =
65 PmCon { pm_id = scrut, pm_con_con = PmAltConLike (RealDataCon con)
66 , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = arg_ids }
67
68 -- | Creates a '[PmGrd]' refining a match var of list type to a list,
69 -- where list fields are matched against the incoming tagged '[PmGrd]'s.
70 -- For example:
71 -- @mkListGrds "a" "[(x, True <- x),(y, !y)]"@
72 -- to
73 -- @"[(x:b) <- a, True <- x, (y:c) <- b, !y, [] <- c]"@
74 -- where @b@ and @c@ are freshly allocated in @mkListGrds@ and @a@ is the match
75 -- variable.
76 mkListGrds :: Id -> [(Id, [PmGrd])] -> DsM [PmGrd]
77 -- See Note [Order of guards matter] for why we need to intertwine guards
78 -- on list elements.
79 mkListGrds a [] = pure [vanillaConGrd a nilDataCon []]
80 mkListGrds a ((x, head_grds):xs) = do
81 b <- mkPmId (idType a)
82 tail_grds <- mkListGrds b xs
83 pure $ vanillaConGrd a consDataCon [x, b] : head_grds ++ tail_grds
84
85 -- | Create a '[PmGrd]' refining a match variable to a 'PmLit'.
86 mkPmLitGrds :: Id -> PmLit -> DsM [PmGrd]
87 mkPmLitGrds x (PmLit _ (PmLitString s)) = do
88 -- We desugar String literals to list literals for better overlap reasoning.
89 -- It's a little unfortunate we do this here rather than in
90 -- 'GHC.HsToCore.Pmc.Solver.trySolve' and
91 -- 'GHC.HsToCore.Pmc.Solver.addRefutableAltCon', but it's so much simpler
92 -- here. See Note [Representation of Strings in TmState] in
93 -- GHC.HsToCore.Pmc.Solver
94 vars <- traverse mkPmId (take (lengthFS s) (repeat charTy))
95 let mk_char_lit y c = mkPmLitGrds y (PmLit charTy (PmLitChar c))
96 char_grdss <- zipWithM mk_char_lit vars (unpackFS s)
97 mkListGrds x (zip vars char_grdss)
98 mkPmLitGrds x lit = do
99 let grd = PmCon { pm_id = x
100 , pm_con_con = PmAltLit lit
101 , pm_con_tvs = []
102 , pm_con_dicts = []
103 , pm_con_args = [] }
104 pure [grd]
105
106 -- | @desugarPat _ x pat@ transforms @pat@ into a '[PmGrd]', where
107 -- the variable representing the match is @x@.
108 desugarPat :: Id -> Pat GhcTc -> DsM [PmGrd]
109 desugarPat x pat = case pat of
110 WildPat _ty -> pure []
111 VarPat _ y -> pure (mkPmLetVar (unLoc y) x)
112 ParPat _ _ p _ -> desugarLPat x p
113 LazyPat _ _ -> pure [] -- like a wildcard
114 BangPat _ p@(L l p') ->
115 -- Add the bang in front of the list, because it will happen before any
116 -- nested stuff.
117 (PmBang x pm_loc :) <$> desugarLPat x p
118 where pm_loc = Just (SrcInfo (L (locA l) (ppr p')))
119
120 -- (x@pat) ==> Desugar pat with x as match var and handle impedance
121 -- mismatch with incoming match var
122 AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> desugarLPat y p
123
124 SigPat _ p _ty -> desugarLPat x p
125
126 XPat ext -> case ext of
127
128 ExpansionPat orig expansion -> do
129 dflags <- getDynFlags
130 case orig of
131 -- We add special logic for overloaded list patterns. When:
132 -- - a ViewPat is the expansion of a ListPat,
133 -- - RebindableSyntax is off,
134 -- - the type of the pattern is the built-in list type,
135 -- then we assume that the view function, 'toList', is the identity.
136 -- This improves pattern-match overload checks, as this will allow
137 -- the pattern match checker to directly inspect the inner pattern.
138 -- See #14547, and Note [Desugaring overloaded list patterns] (Wrinkle).
139 ListPat {}
140 | ViewPat arg_ty _lexpr pat <- expansion
141 , not (xopt LangExt.RebindableSyntax dflags)
142 , Just _ <- splitListTyConApp_maybe arg_ty
143 -> desugarLPat x pat
144
145 _ -> desugarPat x expansion
146
147 -- See Note [Desugar CoPats]
148 -- Generally the translation is
149 -- pat |> co ===> let y = x |> co, pat <- y where y is a match var of pat
150 CoPat wrapper p _ty
151 | isIdHsWrapper wrapper -> desugarPat x p
152 | WpCast co <- wrapper, isReflexiveCo co -> desugarPat x p
153 | otherwise -> do
154 (y, grds) <- desugarPatV p
155 wrap_rhs_y <- dsHsWrapper wrapper
156 pure (PmLet y (wrap_rhs_y (Var x)) : grds)
157
158 -- (n + k) ===> let b = x >= k, True <- b, let n = x-k
159 NPlusKPat _pat_ty (L _ n) k1 k2 ge minus -> do
160 b <- mkPmId boolTy
161 let grd_b = vanillaConGrd b trueDataCon []
162 [ke1, ke2] <- traverse dsOverLit [unLoc k1, k2]
163 rhs_b <- dsSyntaxExpr ge [Var x, ke1]
164 rhs_n <- dsSyntaxExpr minus [Var x, ke2]
165 pure [PmLet b rhs_b, grd_b, PmLet n rhs_n]
166
167 -- (fun -> pat) ===> let y = fun x, pat <- y where y is a match var of pat
168 ViewPat _arg_ty lexpr pat -> do
169 (y, grds) <- desugarLPatV pat
170 fun <- dsLExpr lexpr
171 pure $ PmLet y (App fun (Var x)) : grds
172
173 -- list
174 ListPat _ ps ->
175 desugarListPat x ps
176
177 ConPat { pat_con = L _ con
178 , pat_args = ps
179 , pat_con_ext = ConPatTc
180 { cpt_arg_tys = arg_tys
181 , cpt_tvs = ex_tvs
182 , cpt_dicts = dicts
183 }
184 } ->
185 desugarConPatOut x con arg_tys ex_tvs dicts ps
186
187 NPat ty (L _ olit) mb_neg _ -> do
188 -- See Note [Literal short cut] in "GHC.HsToCore.Match.Literal"
189 -- We inline the Literal short cut for @ty@ here, because @ty@ is more
190 -- precise than the field of OverLitTc, which is all that dsOverLit (which
191 -- normally does the literal short cut) can look at. Also @ty@ matches the
192 -- type of the scrutinee, so info on both pattern and scrutinee (for which
193 -- short cutting in dsOverLit works properly) is overloaded iff either is.
194 dflags <- getDynFlags
195 let platform = targetPlatform dflags
196 pm_lit <- case olit of
197 OverLit{ ol_val = val, ol_ext = OverLitTc { ol_rebindable = rebindable } }
198 | not rebindable
199 , Just expr <- shortCutLit platform val ty
200 -> coreExprAsPmLit <$> dsExpr expr
201 | not rebindable
202 , (HsFractional f) <- val
203 , negates <- if fl_neg f then 1 else 0
204 -> do
205 rat_tc <- dsLookupTyCon rationalTyConName
206 let rat_ty = mkTyConTy rat_tc
207 return $ Just $ PmLit rat_ty (PmLitOverRat negates f)
208 | otherwise
209 -> do
210 dsLit <- dsOverLit olit
211 let !pmLit = coreExprAsPmLit dsLit :: Maybe PmLit
212 -- pprTraceM "desugarPat"
213 -- (
214 -- text "val" <+> ppr val $$
215 -- text "witness" <+> ppr (ol_witness olit) $$
216 -- text "dsLit" <+> ppr dsLit $$
217 -- text "asPmLit" <+> ppr pmLit
218 -- )
219 return pmLit
220
221 let lit = case pm_lit of
222 Just l -> l
223 Nothing -> pprPanic "failed to detect OverLit" (ppr olit)
224 let lit' = case mb_neg of
225 Just _ -> expectJust "failed to negate lit" (negatePmLit lit)
226 Nothing -> lit
227 mkPmLitGrds x lit'
228
229 LitPat _ lit -> do
230 core_expr <- dsLit (convertLit lit)
231 let lit = expectJust "failed to detect Lit" (coreExprAsPmLit core_expr)
232 mkPmLitGrds x lit
233
234 TuplePat _tys pats boxity -> do
235 (vars, grdss) <- mapAndUnzipM desugarLPatV pats
236 let tuple_con = tupleDataCon boxity (length vars)
237 pure $ vanillaConGrd x tuple_con vars : concat grdss
238
239 SumPat _ty p alt arity -> do
240 (y, grds) <- desugarLPatV p
241 let sum_con = sumDataCon alt arity
242 -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
243 pure $ vanillaConGrd x sum_con [y] : grds
244
245 SplicePat {} -> panic "Check.desugarPat: SplicePat"
246
247 -- | 'desugarPat', but also select and return a new match var.
248 desugarPatV :: Pat GhcTc -> DsM (Id, [PmGrd])
249 desugarPatV pat = do
250 x <- selectMatchVar Many pat
251 grds <- desugarPat x pat
252 pure (x, grds)
253
254 desugarLPat :: Id -> LPat GhcTc -> DsM [PmGrd]
255 desugarLPat x = desugarPat x . unLoc
256
257 -- | 'desugarLPat', but also select and return a new match var.
258 desugarLPatV :: LPat GhcTc -> DsM (Id, [PmGrd])
259 desugarLPatV = desugarPatV . unLoc
260
261 -- | @desugarListPat _ x [p1, ..., pn]@ is basically
262 -- @desugarConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever
263 -- constructing the 'ConPatOut's.
264 desugarListPat :: Id -> [LPat GhcTc] -> DsM [PmGrd]
265 desugarListPat x pats = do
266 vars_and_grdss <- traverse desugarLPatV pats
267 mkListGrds x vars_and_grdss
268
269 -- | Desugar a constructor pattern
270 desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar]
271 -> [EvVar] -> HsConPatDetails GhcTc -> DsM [PmGrd]
272 desugarConPatOut x con univ_tys ex_tvs dicts = \case
273 PrefixCon _ ps -> go_field_pats (zip [0..] ps)
274 InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2])
275 RecCon (HsRecFields fs _) -> go_field_pats (rec_field_ps fs)
276 where
277 -- The actual argument types (instantiated)
278 arg_tys = map scaledThing $ conLikeInstOrigArgTys con (univ_tys ++ mkTyVarTys ex_tvs)
279
280 -- Extract record field patterns tagged by field index from a list of
281 -- LHsRecField
282 rec_field_ps fs = map (tagged_pat . unLoc) fs
283 where
284 tagged_pat f = (lbl_to_index (getName (hsRecFieldId f)), hfbRHS f)
285 -- Unfortunately the label info is empty when the DataCon wasn't defined
286 -- with record field labels, hence we desugar to field index.
287 orig_lbls = map flSelector $ conLikeFieldLabels con
288 lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls
289
290 go_field_pats tagged_pats = do
291 -- The fields that appear might not be in the correct order. So
292 -- 1. Do the PmCon match
293 -- 2. Then pattern match on the fields in the order given by the first
294 -- field of @tagged_pats@.
295 -- See Note [Field match order for RecCon]
296
297 -- Desugar the mentioned field patterns. We're doing this first to get
298 -- the Ids for pm_con_args and bring them in order afterwards.
299 let trans_pat (n, pat) = do
300 (var, pvec) <- desugarLPatV pat
301 pure ((n, var), pvec)
302 (tagged_vars, arg_grdss) <- mapAndUnzipM trans_pat tagged_pats
303
304 let get_pat_id n ty = case lookup n tagged_vars of
305 Just var -> pure var
306 Nothing -> mkPmId ty
307
308 -- 1. the constructor pattern match itself
309 arg_ids <- zipWithM get_pat_id [0..] arg_tys
310 let con_grd = PmCon x (PmAltConLike con) ex_tvs dicts arg_ids
311
312 -- 2. guards from field selector patterns
313 let arg_grds = concat arg_grdss
314
315 -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids)
316 pure (con_grd : arg_grds)
317
318 desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre)
319 -- See 'GrdPatBind' for how this simply repurposes GrdGRHS.
320 desugarPatBind loc var pat =
321 PmPatBind . flip PmGRHS (SrcInfo (L loc (ppr pat))) . GrdVec <$> desugarPat var pat
322
323 desugarEmptyCase :: Id -> DsM PmEmptyCase
324 desugarEmptyCase var = pure PmEmptyCase { pe_var = var }
325
326 -- | Desugar the non-empty 'Match'es of a 'MatchGroup'.
327 desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc))
328 -> DsM (PmMatchGroup Pre)
329 desugarMatches vars matches =
330 PmMatchGroup <$> traverse (desugarMatch vars) matches
331
332 -- Desugar a single match
333 desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre)
334 desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do
335 pats' <- concat <$> zipWithM desugarLPat vars pats
336 grhss' <- desugarGRHSs (locA match_loc) (sep (map ppr pats)) grhss
337 -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss'])
338 return PmMatch { pm_pats = GrdVec pats', pm_grhss = grhss' }
339
340 desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre)
341 desugarGRHSs match_loc pp_pats grhss = do
342 lcls <- desugarLocalBinds (grhssLocalBinds grhss)
343 grhss' <- traverse (desugarLGRHS match_loc pp_pats)
344 . expectJust "desugarGRHSs"
345 . NE.nonEmpty
346 $ grhssGRHSs grhss
347 return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' }
348
349 -- | Desugar a guarded right-hand side to a single 'GrdTree'
350 desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre)
351 desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do
352 -- _loc points to the match separator (ie =, ->) that comes after the guards.
353 -- Hence we have to pass in the match_loc, which we use in case that the RHS
354 -- is unguarded.
355 -- pp_pats is the space-separated pattern of the current Match this
356 -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x@.
357 let rhs_info = case gs of
358 [] -> L match_loc pp_pats
359 (L grd_loc _):_ -> L (locA grd_loc) (pp_pats <+> vbar <+> interpp'SP gs)
360 grds <- concatMapM (desugarGuard . unLoc) gs
361 pure PmGRHS { pg_grds = GrdVec grds, pg_rhs = SrcInfo rhs_info }
362
363 -- | Desugar a guard statement to a '[PmGrd]'
364 desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd]
365 desugarGuard guard = case guard of
366 BodyStmt _ e _ _ -> desugarBoolGuard e
367 LetStmt _ binds -> desugarLocalBinds binds
368 BindStmt _ p e -> desugarBind p e
369 LastStmt {} -> panic "desugarGuard LastStmt"
370 ParStmt {} -> panic "desugarGuard ParStmt"
371 TransStmt {} -> panic "desugarGuard TransStmt"
372 RecStmt {} -> panic "desugarGuard RecStmt"
373 ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt"
374
375 -- | Desugar local bindings to a bunch of 'PmLet' guards.
376 -- Deals only with simple @let@ or @where@ bindings without any polymorphism,
377 -- recursion, pattern bindings etc.
378 -- See Note [Long-distance information for HsLocalBinds].
379 desugarLocalBinds :: HsLocalBinds GhcTc -> DsM [PmGrd]
380 desugarLocalBinds (HsValBinds _ (XValBindsLR (NValBinds binds _))) =
381 concatMapM (concatMapM go . bagToList) (map snd binds)
382 where
383 go :: LHsBind GhcTc -> DsM [PmGrd]
384 go (L _ FunBind{fun_id = L _ x, fun_matches = mg})
385 -- See Note [Long-distance information for HsLocalBinds] for why this
386 -- pattern match is so very specific.
387 | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg
388 , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do
389 core_rhs <- dsLExpr rhs
390 return [PmLet x core_rhs]
391 go (L _ AbsBinds{ abs_tvs = [], abs_ev_vars = []
392 , abs_exports=exports, abs_binds = binds }) = do
393 -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry
394 -- renamings. See Note [Long-distance information for HsLocalBinds]
395 -- for the details.
396 let go_export :: ABExport GhcTc -> Maybe PmGrd
397 go_export ABE{abe_poly = x, abe_mono = y, abe_wrap = wrap}
398 | isIdHsWrapper wrap
399 = assertPpr (idType x `eqType` idType y)
400 (ppr x $$ ppr (idType x) $$ ppr y $$ ppr (idType y)) $
401 Just $ PmLet x (Var y)
402 | otherwise
403 = Nothing
404 let exps = mapMaybe go_export exports
405 bs <- concatMapM go (bagToList binds)
406 return (exps ++ bs)
407 go _ = return []
408 desugarLocalBinds _binds = return []
409
410 -- | Desugar a pattern guard
411 -- @pat <- e ==> let x = e; <guards for pat <- x>@
412 desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM [PmGrd]
413 desugarBind p e = dsLExpr e >>= \case
414 Var y
415 | Nothing <- isDataConId_maybe y
416 -- RHS is a variable, so that will allow us to omit the let
417 -> desugarLPat y p
418 rhs -> do
419 (x, grds) <- desugarLPatV p
420 pure (PmLet x rhs : grds)
421
422 -- | Desugar a boolean guard
423 -- @e ==> let x = e; True <- x@
424 desugarBoolGuard :: LHsExpr GhcTc -> DsM [PmGrd]
425 desugarBoolGuard e
426 | isJust (isTrueLHsExpr e) = return []
427 -- The formal thing to do would be to generate (True <- True)
428 -- but it is trivial to solve so instead we give back an empty
429 -- [PmGrd] for efficiency
430 | otherwise = dsLExpr e >>= \case
431 Var y
432 | Nothing <- isDataConId_maybe y
433 -- Omit the let by matching on y
434 -> pure [vanillaConGrd y trueDataCon []]
435 rhs -> do
436 x <- mkPmId boolTy
437 pure [PmLet x rhs, vanillaConGrd x trueDataCon []]
438
439 {- Note [Field match order for RecCon]
440 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
441 The order for RecCon field patterns actually determines evaluation order of
442 the pattern match. For example:
443
444 data T = T { a :: Char, b :: Int }
445 f :: T -> ()
446 f T{ b = 42, a = 'a' } = ()
447
448 Then @f (T (error "a") (error "b"))@ errors out with "b" because it is mentioned
449 first in the pattern match.
450
451 This means we can't just desugar the pattern match to
452 @[T a b <- x, 'a' <- a, 42 <- b]@. Instead we have to force them in the
453 right order: @[T a b <- x, 42 <- b, 'a' <- a]@.
454
455 Note [Order of guards matters]
456 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
457 Similar to Note [Field match order for RecCon], the order in which the guards
458 for a pattern match appear matter. Consider a situation similar to T5117:
459
460 f (0:_) = ()
461 f (0:[]) = ()
462
463 The latter clause is clearly redundant. Yet if we desugar the second clause as
464
465 [x:xs' <- xs, [] <- xs', 0 <- x]
466
467 We will say that the second clause only has an inaccessible RHS. That's because
468 we force the tail of the list before comparing its head! So the correct
469 translation would have been
470
471 [x:xs' <- xs, 0 <- x, [] <- xs']
472
473 And we have to take in the guards on list cells into @mkListGrds@.
474
475 Note [Desugar CoPats]
476 ~~~~~~~~~~~~~~~~~~~~~~~
477 The pattern match checker did not know how to handle coerced patterns
478 `CoPat` efficiently, which gave rise to #11276. The original approach
479 desugared `CoPat`s:
480
481 pat |> co ===> x (pat <- (x |> co))
482
483 Why did we do this seemingly unnecessary expansion in the first place?
484 The reason is that the type of @pat |> co@ (which is the type of the value
485 abstraction we match against) might be different than that of @pat@. Data
486 instances such as @Sing (a :: Bool)@ are a good example of this: If we would
487 just drop the coercion, we'd get a type error when matching @pat@ against its
488 value abstraction, with the result being that pmIsSatisfiable decides that every
489 possible data constructor fitting @pat@ is rejected as uninhabitated, leading to
490 a lot of false warnings.
491
492 But we can check whether the coercion is a hole or if it is just refl, in
493 which case we can drop it.
494
495 Note [Long-distance information for HsLocalBinds]
496 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
497 Consider (#18626)
498
499 f :: Int -> ()
500 f x | y = ()
501 where
502 y = True
503
504 x :: ()
505 x | let y = True, y = ()
506
507 Both definitions are exhaustive, but to make the necessary long-distance
508 connection from @y@'s binding to its use site in a guard, we have to collect
509 'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions.
510
511 In principle, we are only interested in desugaring local binds that are
512 'FunBind's, that
513
514 * Have no pattern matches. If @y@ above had any patterns, it would be a
515 function and we can't reason about them anyway.
516 * Have singleton match group with a single GRHS.
517 Otherwise, what expression to pick in the generated guard @let y = <rhs>@?
518
519 It turns out that desugaring type-checked local binds in this way is a bit
520 more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds'
521 Nfter type-checking. See Note [AbsBinds] in "GHC.Hs.Binds".
522
523 We make sure that there is no polymorphism in the way by checking that there
524 are no 'abs_tvs' or 'abs_ev_vars' (we don't reason about
525 @y :: forall a. Eq a => ...@) and that the exports carry no 'HsWrapper's. In
526 this case, the exports are a simple renaming substitution that we can capture
527 with 'PmLet'. Ultimately we'll hit those renamed 'FunBind's, though, which is
528 the whole point.
529
530 The place to store the 'PmLet' guards for @where@ clauses (which are per
531 'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of
532 @x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'.
533 -}