GHC/HsToCore/Pmc/Desugar.hs

    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GADTs             #-}
    {-# LANGUAGE LambdaCase        #-}

    -- | Desugaring step of the
    -- [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989).
    --
    -- Desugars Haskell source syntax into guard tree variants Pm*.
    -- In terms of the paper, this module is concerned with Sections 3.1, Figure 4,
    -- in particular.
    module GHC.HsToCore.Pmc.Desugar (
          desugarPatBind, desugarGRHSs, desugarMatches, desugarEmptyCase
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.HsToCore.Pmc.Types
    import GHC.HsToCore.Pmc.Utils
    import GHC.Core (Expr(Var,App))
    import GHC.Data.FastString (unpackFS, lengthFS)
    import GHC.Data.Bag (bagToList)
    import GHC.Driver.Session
    import GHC.Hs
    import GHC.Tc.Utils.Zonk (shortCutLit)
    import GHC.Types.Id
    import GHC.Core.ConLike
    import GHC.Types.Name
    import GHC.Builtin.Types
    import GHC.Builtin.Names (rationalTyConName)
    import GHC.Types.SrcLoc
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Core.DataCon
    import GHC.Types.Var (EvVar)
    import GHC.Core.Coercion
    import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper)
    import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr)
    import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper)
    import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar)
    import GHC.HsToCore.Match.Literal (dsLit, dsOverLit)
    import GHC.HsToCore.Monad
    import GHC.Core.TyCo.Rep
    import GHC.Core.Type
    import GHC.Data.Maybe
    import qualified GHC.LanguageExtensions as LangExt
    import GHC.Utils.Monad (concatMapM)
    import GHC.Types.SourceText (FractionalLit(..))
    import Control.Monad (zipWithM)
    import Data.List (elemIndex)
    import Data.List.NonEmpty ( NonEmpty(..) )
    import qualified Data.List.NonEmpty as NE

    -- import GHC.Driver.Ppr

    -- | Smart constructor that eliminates trivial lets
    mkPmLetVar :: Id -> Id -> [PmGrd]
    mkPmLetVar x y | x == y = []
    mkPmLetVar x y          = [PmLet x (Var y)]

    -- | ADT constructor pattern => no existentials, no local constraints
    vanillaConGrd :: Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd scrut con arg_ids =
      PmCon { pm_id = scrut, pm_con_con = PmAltConLike (RealDataCon con)
            , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = arg_ids }

    -- | Creates a '[PmGrd]' refining a match var of list type to a list,
    -- where list fields are matched against the incoming tagged '[PmGrd]'s.
    -- For example:
    --   @mkListGrds "a" "[(x, True <- x),(y, !y)]"@
    -- to
    --   @"[(x:b) <- a, True <- x, (y:c) <- b, !y, [] <- c]"@
    -- where @b@ and @c@ are freshly allocated in @mkListGrds@ and @a@ is the match
    -- variable.
    mkListGrds :: Id -> [(Id, [PmGrd])] -> DsM [PmGrd]
    -- See Note [Order of guards matter] for why we need to intertwine guards
    -- on list elements.
    mkListGrds a []                  = pure [vanillaConGrd a nilDataCon []]
    mkListGrds a ((x, head_grds):xs) = do
      b <- mkPmId (idType a)
      tail_grds <- mkListGrds b xs
      pure $ vanillaConGrd a consDataCon [x, b] : head_grds ++ tail_grds

    -- | Create a '[PmGrd]' refining a match variable to a 'PmLit'.
    mkPmLitGrds :: Id -> PmLit -> DsM [PmGrd]
    mkPmLitGrds x (PmLit _ (PmLitString s)) = do
      -- We desugar String literals to list literals for better overlap reasoning.
      -- It's a little unfortunate we do this here rather than in
      -- 'GHC.HsToCore.Pmc.Solver.trySolve' and
      -- 'GHC.HsToCore.Pmc.Solver.addRefutableAltCon', but it's so much simpler
      -- here. See Note [Representation of Strings in TmState] in
      -- GHC.HsToCore.Pmc.Solver
      vars <- traverse mkPmId (take (lengthFS s) (repeat charTy))
      let mk_char_lit y c = mkPmLitGrds y (PmLit charTy (PmLitChar c))
      char_grdss <- zipWithM mk_char_lit vars (unpackFS s)
      mkListGrds x (zip vars char_grdss)
    mkPmLitGrds x lit = do
      let grd = PmCon { pm_id = x
                      , pm_con_con = PmAltLit lit
                      , pm_con_tvs = []
                      , pm_con_dicts = []
                      , pm_con_args = [] }
      pure [grd]

    -- | @desugarPat _ x pat@ transforms @pat@ into a '[PmGrd]', where
    -- the variable representing the match is @x@.
    desugarPat :: Id -> Pat GhcTc -> DsM [PmGrd]
    desugarPat x pat = case pat of
      WildPat  _ty -> pure []
      VarPat _ y   -> pure (mkPmLetVar (unLoc y) x)
      ParPat _ p   -> desugarLPat x p
      LazyPat _ _  -> pure [] -- like a wildcard
      BangPat _ p@(L l p') ->
        -- Add the bang in front of the list, because it will happen before any
        -- nested stuff.
        (PmBang x pm_loc :) <$> desugarLPat x p
          where pm_loc = Just (SrcInfo (L (locA l) (ppr p')))

      -- (x@pat)   ==>   Desugar pat with x as match var and handle impedance
      --                 mismatch with incoming match var
      AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> desugarLPat y p

      SigPat _ p _ty -> desugarLPat x p

      -- See Note [Desugar CoPats]
      -- Generally the translation is
      -- pat |> co   ===>   let y = x |> co, pat <- y  where y is a match var of pat
      XPat (CoPat wrapper p _ty)
        | isIdHsWrapper wrapper                   -> desugarPat x p
        | WpCast co <-  wrapper, isReflexiveCo co -> desugarPat x p
        | otherwise -> do
            (y, grds) <- desugarPatV p
            wrap_rhs_y <- dsHsWrapper wrapper
            pure (PmLet y (wrap_rhs_y (Var x)) : grds)

      -- (n + k)  ===>   let b = x >= k, True <- b, let n = x-k
      NPlusKPat _pat_ty (L _ n) k1 k2 ge minus -> do
        b <- mkPmId boolTy
        let grd_b = vanillaConGrd b trueDataCon []
        [ke1, ke2] <- traverse dsOverLit [unLoc k1, k2]
        rhs_b <- dsSyntaxExpr ge    [Var x, ke1]
        rhs_n <- dsSyntaxExpr minus [Var x, ke2]
        pure [PmLet b rhs_b, grd_b, PmLet n rhs_n]

      -- (fun -> pat)   ===>   let y = fun x, pat <- y where y is a match var of pat
      ViewPat _arg_ty lexpr pat -> do
        (y, grds) <- desugarLPatV pat
        fun <- dsLExpr lexpr
        pure $ PmLet y (App fun (Var x)) : grds

      -- list
      ListPat (ListPatTc _elem_ty Nothing) ps ->
        desugarListPat x ps

      -- overloaded list
      ListPat (ListPatTc elem_ty (Just (pat_ty, to_list))) pats -> do
        dflags <- getDynFlags
        case splitListTyConApp_maybe pat_ty of
          Just _e_ty
            | not (xopt LangExt.RebindableSyntax dflags)
            -- Just desugar it as a regular ListPat
            -> desugarListPat x pats
          _ -> do
            y <- mkPmId (mkListTy elem_ty)
            grds <- desugarListPat y pats
            rhs_y <- dsSyntaxExpr to_list [Var x]
            pure $ PmLet y rhs_y : grds

        -- (a) In the presence of RebindableSyntax, we don't know anything about
        --     `toList`, we should treat `ListPat` as any other view pattern.
        --
        -- (b) In the absence of RebindableSyntax,
        --     - If the pat_ty is `[a]`, then we treat the overloaded list pattern
        --       as ordinary list pattern. Although we can give an instance
        --       `IsList [Int]` (more specific than the default `IsList [a]`), in
        --       practice, we almost never do that. We assume the `to_list` is
        --       the `toList` from `instance IsList [a]`.
        --
        --     - Otherwise, we treat the `ListPat` as ordinary view pattern.
        --
        -- See #14547, especially comment#9 and comment#10.

      ConPat { pat_con     = L _ con
             , pat_args    = ps
             , pat_con_ext = ConPatTc
               { cpt_arg_tys = arg_tys
               , cpt_tvs     = ex_tvs
               , cpt_dicts   = dicts
               }
             } ->
        desugarConPatOut x con arg_tys ex_tvs dicts ps

      NPat ty (L _ olit) mb_neg _ -> do
        -- See Note [Literal short cut] in "GHC.HsToCore.Match.Literal"
        -- We inline the Literal short cut for @ty@ here, because @ty@ is more
        -- precise than the field of OverLitTc, which is all that dsOverLit (which
        -- normally does the literal short cut) can look at. Also @ty@ matches the
        -- type of the scrutinee, so info on both pattern and scrutinee (for which
        -- short cutting in dsOverLit works properly) is overloaded iff either is.
        dflags <- getDynFlags
        let platform = targetPlatform dflags
        pm_lit <- case olit of
          OverLit{ ol_val = val, ol_ext = OverLitTc rebindable _ }
            | not rebindable
            , Just expr <- shortCutLit platform val ty
            -> coreExprAsPmLit <$> dsExpr expr
            | not rebindable
            , (HsFractional f) <- val
            , negates <- if fl_neg f then 1 else 0
            -> do
                rat_tc <- dsLookupTyCon rationalTyConName
                let rat_ty = mkTyConTy rat_tc
                return $ Just $ PmLit rat_ty (PmLitOverRat negates f)
            | otherwise
            -> do
               dsLit <- dsOverLit olit
               let !pmLit = coreExprAsPmLit dsLit :: Maybe PmLit
              --  pprTraceM "desugarPat"
              --     (
              --       text "val" <+> ppr val $$
              --       text "witness" <+> ppr (ol_witness olit) $$
              --       text "dsLit" <+> ppr dsLit $$
              --       text "asPmLit" <+> ppr pmLit
              --     )
               return pmLit

        let lit = case pm_lit of
              Just l -> l
              Nothing -> pprPanic "failed to detect OverLit" (ppr olit)
        let lit' = case mb_neg of
              Just _  -> expectJust "failed to negate lit" (negatePmLit lit)
              Nothing -> lit
        mkPmLitGrds x lit'

      LitPat _ lit -> do
        core_expr <- dsLit (convertLit lit)
        let lit = expectJust "failed to detect Lit" (coreExprAsPmLit core_expr)
        mkPmLitGrds x lit

      TuplePat _tys pats boxity -> do
        (vars, grdss) <- mapAndUnzipM desugarLPatV pats
        let tuple_con = tupleDataCon boxity (length vars)
        pure $ vanillaConGrd x tuple_con vars : concat grdss

      SumPat _ty p alt arity -> do
        (y, grds) <- desugarLPatV p
        let sum_con = sumDataCon alt arity
        -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
        pure $ vanillaConGrd x sum_con [y] : grds

      SplicePat {} -> panic "Check.desugarPat: SplicePat"

    -- | 'desugarPat', but also select and return a new match var.
    desugarPatV :: Pat GhcTc -> DsM (Id, [PmGrd])
    desugarPatV pat = do
      x <- selectMatchVar Many pat
      grds <- desugarPat x pat
      pure (x, grds)

    desugarLPat :: Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat x = desugarPat x . unLoc

    -- | 'desugarLPat', but also select and return a new match var.
    desugarLPatV :: LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV = desugarPatV . unLoc

    -- | @desugarListPat _ x [p1, ..., pn]@ is basically
    --   @desugarConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever
    -- constructing the 'ConPatOut's.
    desugarListPat :: Id -> [LPat GhcTc] -> DsM [PmGrd]
    desugarListPat x pats = do
      vars_and_grdss <- traverse desugarLPatV pats
      mkListGrds x vars_and_grdss

    -- | Desugar a constructor pattern
    desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar]
                     -> [EvVar] -> HsConPatDetails GhcTc -> DsM [PmGrd]
    desugarConPatOut x con univ_tys ex_tvs dicts = \case
        PrefixCon _ ps               -> go_field_pats (zip [0..] ps)
        InfixCon  p1 p2              -> go_field_pats (zip [0..] [p1,p2])
        RecCon    (HsRecFields fs _) -> go_field_pats (rec_field_ps fs)
      where
        -- The actual argument types (instantiated)
        arg_tys     = map scaledThing $ conLikeInstOrigArgTys con (univ_tys ++ mkTyVarTys ex_tvs)

        -- Extract record field patterns tagged by field index from a list of
        -- LHsRecField
        rec_field_ps fs = map (tagged_pat . unLoc) fs
          where
            tagged_pat f = (lbl_to_index (getName (hsRecFieldId f)), hsRecFieldArg f)
            -- Unfortunately the label info is empty when the DataCon wasn't defined
            -- with record field labels, hence we desugar to field index.
            orig_lbls        = map flSelector $ conLikeFieldLabels con
            lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls

        go_field_pats tagged_pats = do
          -- The fields that appear might not be in the correct order. So
          --   1. Do the PmCon match
          --   2. Then pattern match on the fields in the order given by the first
          --      field of @tagged_pats@.
          -- See Note [Field match order for RecCon]

          -- Desugar the mentioned field patterns. We're doing this first to get
          -- the Ids for pm_con_args and bring them in order afterwards.
          let trans_pat (n, pat) = do
                (var, pvec) <- desugarLPatV pat
                pure ((n, var), pvec)
          (tagged_vars, arg_grdss) <- mapAndUnzipM trans_pat tagged_pats

          let get_pat_id n ty = case lookup n tagged_vars of
                Just var -> pure var
                Nothing  -> mkPmId ty

          -- 1. the constructor pattern match itself
          arg_ids <- zipWithM get_pat_id [0..] arg_tys
          let con_grd = PmCon x (PmAltConLike con) ex_tvs dicts arg_ids

          -- 2. guards from field selector patterns
          let arg_grds = concat arg_grdss

          -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids)
          pure (con_grd : arg_grds)

    desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre)
    -- See 'GrdPatBind' for how this simply repurposes GrdGRHS.
    desugarPatBind loc var pat =
      PmPatBind . flip PmGRHS (SrcInfo (L loc (ppr pat))) . GrdVec <$> desugarPat var pat

    desugarEmptyCase :: Id -> DsM PmEmptyCase
    desugarEmptyCase var = pure PmEmptyCase { pe_var = var }

    -- | Desugar the non-empty 'Match'es of a 'MatchGroup'.
    desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc))
                   -> DsM (PmMatchGroup Pre)
    desugarMatches vars matches =
      PmMatchGroup <$> traverse (desugarMatch vars) matches

    -- Desugar a single match
    desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre)
    desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do
      pats'  <- concat <$> zipWithM desugarLPat vars pats
      grhss' <- desugarGRHSs (locA match_loc) (sep (map ppr pats)) grhss
      -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss'])
      return PmMatch { pm_pats = GrdVec pats', pm_grhss = grhss' }

    desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre)
    desugarGRHSs match_loc pp_pats grhss = do
      lcls <- desugarLocalBinds (grhssLocalBinds grhss)
      grhss' <- traverse (desugarLGRHS match_loc pp_pats)
                  . expectJust "desugarGRHSs"
                  . NE.nonEmpty
                  $ grhssGRHSs grhss
      return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' }

    -- | Desugar a guarded right-hand side to a single 'GrdTree'
    desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre)
    desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do
      -- _loc points to the match separator (ie =, ->) that comes after the guards.
      -- Hence we have to pass in the match_loc, which we use in case that the RHS
      -- is unguarded.
      -- pp_pats is the space-separated pattern of the current Match this
      -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x@.
      let rhs_info = case gs of
            []              -> L match_loc      pp_pats
            (L grd_loc _):_ -> L (locA grd_loc) (pp_pats <+> vbar <+> interpp'SP gs)
      grds <- concatMapM (desugarGuard . unLoc) gs
      pure PmGRHS { pg_grds = GrdVec grds, pg_rhs = SrcInfo rhs_info }

    -- | Desugar a guard statement to a '[PmGrd]'
    desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd]
    desugarGuard guard = case guard of
      BodyStmt _   e _ _ -> desugarBoolGuard e
      LetStmt  _   binds -> desugarLocalBinds binds
      BindStmt _ p e     -> desugarBind p e
      LastStmt        {} -> panic "desugarGuard LastStmt"
      ParStmt         {} -> panic "desugarGuard ParStmt"
      TransStmt       {} -> panic "desugarGuard TransStmt"
      RecStmt         {} -> panic "desugarGuard RecStmt"
      ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt"

    -- | Desugar local bindings to a bunch of 'PmLet' guards.
    -- Deals only with simple @let@ or @where@ bindings without any polymorphism,
    -- recursion, pattern bindings etc.
    -- See Note [Long-distance information for HsLocalBinds].
    desugarLocalBinds :: HsLocalBinds GhcTc -> DsM [PmGrd]
    desugarLocalBinds (HsValBinds _ (XValBindsLR (NValBinds binds _))) =
      concatMapM (concatMapM go . bagToList) (map snd binds)
      where
        go :: LHsBind GhcTc -> DsM [PmGrd]
        go (L _ FunBind{fun_id = L _ x, fun_matches = mg})
          -- See Note [Long-distance information for HsLocalBinds] for why this
          -- pattern match is so very specific.
          | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg
          , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do
              core_rhs <- dsLExpr rhs
              return [PmLet x core_rhs]
        go (L _ AbsBinds{ abs_tvs = [], abs_ev_vars = []
                        , abs_exports=exports, abs_binds = binds }) = do
          -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry
          -- renamings. See Note [Long-distance information for HsLocalBinds]
          -- for the details.
          let go_export :: ABExport GhcTc -> Maybe PmGrd
              go_export ABE{abe_poly = x, abe_mono = y, abe_wrap = wrap}
                | isIdHsWrapper wrap
                = ASSERT2(idType x `eqType` idType y, ppr x $$ ppr (idType x) $$ ppr y $$ ppr (idType y))
                  Just $ PmLet x (Var y)
                | otherwise
                = Nothing
          let exps = mapMaybe go_export exports
          bs <- concatMapM go (bagToList binds)
          return (exps ++ bs)
        go _ = return []
    desugarLocalBinds _binds = return []

    -- | Desugar a pattern guard
    --   @pat <- e ==>  let x = e;  <guards for pat <- x>@
    desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM [PmGrd]
    desugarBind p e = dsLExpr e >>= \case
      Var y
        | Nothing <- isDataConId_maybe y
        -- RHS is a variable, so that will allow us to omit the let
        -> desugarLPat y p
      rhs -> do
        (x, grds) <- desugarLPatV p
        pure (PmLet x rhs : grds)

    -- | Desugar a boolean guard
    --   @e ==>  let x = e; True <- x@
    desugarBoolGuard :: LHsExpr GhcTc -> DsM [PmGrd]
    desugarBoolGuard e
      | isJust (isTrueLHsExpr e) = return []
        -- The formal thing to do would be to generate (True <- True)
        -- but it is trivial to solve so instead we give back an empty
        -- [PmGrd] for efficiency
      | otherwise = dsLExpr e >>= \case
          Var y
            | Nothing <- isDataConId_maybe y
            -- Omit the let by matching on y
            -> pure [vanillaConGrd y trueDataCon []]
          rhs -> do
            x <- mkPmId boolTy
            pure [PmLet x rhs, vanillaConGrd x trueDataCon []]

    {- Note [Field match order for RecCon]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The order for RecCon field patterns actually determines evaluation order of
    the pattern match. For example:

      data T = T { a :: Char, b :: Int }
      f :: T -> ()
      f T{ b = 42, a = 'a' } = ()

    Then @f (T (error "a") (error "b"))@ errors out with "b" because it is mentioned
    first in the pattern match.

    This means we can't just desugar the pattern match to
    @[T a b <- x, 'a' <- a, 42 <- b]@. Instead we have to force them in the
    right order: @[T a b <- x, 42 <- b, 'a' <- a]@.

    Note [Order of guards matters]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Similar to Note [Field match order for RecCon], the order in which the guards
    for a pattern match appear matter. Consider a situation similar to T5117:

      f (0:_)  = ()
      f (0:[]) = ()

    The latter clause is clearly redundant. Yet if we desugar the second clause as

      [x:xs' <- xs, [] <- xs', 0 <- x]

    We will say that the second clause only has an inaccessible RHS. That's because
    we force the tail of the list before comparing its head! So the correct
    translation would have been

      [x:xs' <- xs, 0 <- x, [] <- xs']

    And we have to take in the guards on list cells into @mkListGrds@.

    Note [Desugar CoPats]
    ~~~~~~~~~~~~~~~~~~~~~~~
    The pattern match checker did not know how to handle coerced patterns
    `CoPat` efficiently, which gave rise to #11276. The original approach
    desugared `CoPat`s:

        pat |> co    ===>    x (pat <- (x |> co))

    Why did we do this seemingly unnecessary expansion in the first place?
    The reason is that the type of @pat |> co@ (which is the type of the value
    abstraction we match against) might be different than that of @pat@. Data
    instances such as @Sing (a :: Bool)@ are a good example of this: If we would
    just drop the coercion, we'd get a type error when matching @pat@ against its
    value abstraction, with the result being that pmIsSatisfiable decides that every
    possible data constructor fitting @pat@ is rejected as uninhabitated, leading to
    a lot of false warnings.

    But we can check whether the coercion is a hole or if it is just refl, in
    which case we can drop it.

    Note [Long-distance information for HsLocalBinds]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (#18626)

      f :: Int -> ()
      f x | y = ()
        where
          y = True

      x :: ()
      x | let y = True, y = ()

    Both definitions are exhaustive, but to make the necessary long-distance
    connection from @y@'s binding to its use site in a guard, we have to collect
    'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions.

    In principle, we are only interested in desugaring local binds that are
    'FunBind's, that

      * Have no pattern matches. If @y@ above had any patterns, it would be a
        function and we can't reason about them anyway.
      * Have singleton match group with a single GRHS.
        Otherwise, what expression to pick in the generated guard @let y = <rhs>@?

    It turns out that desugaring type-checked local binds in this way is a bit
    more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds'
    Nfter type-checking. See Note [AbsBinds] in "GHC.Hs.Binds".

    We make sure that there is no polymorphism in the way by checking that there
    are no 'abs_tvs' or 'abs_ev_vars' (we don't reason about
    @y :: forall a. Eq a => ...@) and that the exports carry no 'HsWrapper's. In
    this case, the exports are a simple renaming substitution that we can capture
    with 'PmLet'. Ultimately we'll hit those renamed 'FunBind's, though, which is
    the whole point.

    The place to store the 'PmLet' guards for @where@ clauses (which are per
    'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of
    @x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'.
    -}