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 -}