    {-# 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 :: Id -> Id -> [PmGrd]
    mkPmLetVar Id
    x Id
    y | Id
    x Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    y = []
    mkPmLetVar Id
    x Id
    y          = [Id -> CoreExpr -> PmGrd
    PmLet Id
    x (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    y)]

    -- | ADT constructor pattern => no existentials, no local constraints
    vanillaConGrd :: Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd :: Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    scrut DataCon
    con [Id]
    arg_ids =
      PmCon { pm_id :: Id
    pm_id = Id
    scrut, pm_con_con :: PmAltCon
    pm_con_con = ConLike -> PmAltCon
    PmAltConLike (DataCon -> ConLike
    RealDataCon DataCon
    con)
            , pm_con_tvs :: [Id]
    pm_con_tvs = [], pm_con_dicts :: [Id]
    pm_con_dicts = [], pm_con_args :: [Id]
    pm_con_args = [Id]
    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 :: Id -> [(Id, [PmGrd])] -> DsM [PmGrd]
    mkListGrds Id
    a []                  = [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    a DataCon
    nilDataCon []]
    mkListGrds Id
    a ((Id
    x, [PmGrd]
    head_grds):[(Id, [PmGrd])]
    xs) = do
      Id
    b <- Kind -> DsM Id
    mkPmId (Id -> Kind
    idType Id
    a)
      [PmGrd]
    tail_grds <- Id -> [(Id, [PmGrd])] -> DsM [PmGrd]
    mkListGrds Id
    b [(Id, [PmGrd])]
    xs
      [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PmGrd] -> DsM [PmGrd]) -> [PmGrd] -> DsM [PmGrd]
    forall a b. (a -> b) -> a -> b
    $ Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    a DataCon
    consDataCon [Id
    x, Id
    b] PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [PmGrd]
    head_grds [PmGrd] -> [PmGrd] -> [PmGrd]
    forall a. [a] -> [a] -> [a]
    ++ [PmGrd]
    tail_grds

    -- | Create a '[PmGrd]' refining a match variable to a 'PmLit'.
    mkPmLitGrds :: Id -> PmLit -> DsM [PmGrd]
    mkPmLitGrds :: Id -> PmLit -> DsM [PmGrd]
    mkPmLitGrds Id
    x (PmLit Kind
    _ (PmLitString FastString
    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
      [Id]
    vars <- (Kind -> DsM Id) -> [Kind] -> IOEnv (Env DsGblEnv DsLclEnv) [Id]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Kind -> DsM Id
    mkPmId (Int -> [Kind] -> [Kind]
    forall a. Int -> [a] -> [a]
    take (FastString -> Int
    lengthFS FastString
    s) (Kind -> [Kind]
    forall a. a -> [a]
    repeat Kind
    charTy))
      let mk_char_lit :: Id -> Char -> DsM [PmGrd]
    mk_char_lit Id
    y Char
    c = Id -> PmLit -> DsM [PmGrd]
    mkPmLitGrds Id
    y (Kind -> PmLitValue -> PmLit
    PmLit Kind
    charTy (Char -> PmLitValue
    PmLitChar Char
    c))
      [[PmGrd]]
    char_grdss <- (Id -> Char -> DsM [PmGrd])
    -> [Id] -> [Char] -> IOEnv (Env DsGblEnv DsLclEnv) [[PmGrd]]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Id -> Char -> DsM [PmGrd]
    mk_char_lit [Id]
    vars (FastString -> [Char]
    unpackFS FastString
    s)
      Id -> [(Id, [PmGrd])] -> DsM [PmGrd]
    mkListGrds Id
    x ([Id] -> [[PmGrd]] -> [(Id, [PmGrd])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Id]
    vars [[PmGrd]]
    char_grdss)
    mkPmLitGrds Id
    x PmLit
    lit = do
      let grd :: PmGrd
    grd = PmCon { pm_id :: Id
    pm_id = Id
    x
                      , pm_con_con :: PmAltCon
    pm_con_con = PmLit -> PmAltCon
    PmAltLit PmLit
    lit
                      , pm_con_tvs :: [Id]
    pm_con_tvs = []
                      , pm_con_dicts :: [Id]
    pm_con_dicts = []
                      , pm_con_args :: [Id]
    pm_con_args = [] }
      [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [PmGrd
    grd]

    -- | @desugarPat _ x pat@ transforms @pat@ into a '[PmGrd]', where
    -- the variable representing the match is @x@.
    desugarPat :: Id -> Pat GhcTc -> DsM [PmGrd]
    desugarPat :: Id -> Pat GhcTc -> DsM [PmGrd]
    desugarPat Id
    x Pat GhcTc
    pat = case Pat GhcTc
    pat of
      WildPat  XWildPat GhcTc
    _ty -> [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
      VarPat XVarPat GhcTc
    _ LIdP GhcTc
    y   -> [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Id -> Id -> [PmGrd]
    mkPmLetVar (GenLocated SrcSpanAnnN Id -> Id
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnN Id
    LIdP GhcTc
    y) Id
    x)
      ParPat XParPat GhcTc
    _ LPat GhcTc
    p   -> Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat Id
    x LPat GhcTc
    p
      LazyPat XLazyPat GhcTc
    _ LPat GhcTc
    _  -> [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [] -- like a wildcard
      BangPat XBangPat GhcTc
    _ p :: LPat GhcTc
    p@(L SrcSpanAnnA
    l Pat GhcTc
    p') ->
        -- Add the bang in front of the list, because it will happen before any
        -- nested stuff.
        (Id -> Maybe SrcInfo -> PmGrd
    PmBang Id
    x Maybe SrcInfo
    pm_loc PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    :) ([PmGrd] -> [PmGrd]) -> DsM [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat Id
    x LPat GhcTc
    p
          where pm_loc :: Maybe SrcInfo
    pm_loc = SrcInfo -> Maybe SrcInfo
    forall a. a -> Maybe a
    Just (Located SDoc -> SrcInfo
    SrcInfo (SrcSpan -> SDoc -> Located SDoc
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    l) (Pat GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcTc
    p')))

      -- (x@pat)   ==>   Desugar pat with x as match var and handle impedance
      --                 mismatch with incoming match var
      AsPat XAsPat GhcTc
    _ (L SrcSpanAnnN
    _ Id
    y) LPat GhcTc
    p -> (Id -> Id -> [PmGrd]
    mkPmLetVar Id
    y Id
    x [PmGrd] -> [PmGrd] -> [PmGrd]
    forall a. [a] -> [a] -> [a]
    ++) ([PmGrd] -> [PmGrd]) -> DsM [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat Id
    y LPat GhcTc
    p

      SigPat XSigPat GhcTc
    _ LPat GhcTc
    p HsPatSigType (NoGhcTc GhcTc)
    _ty -> Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat Id
    x LPat GhcTc
    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 HsWrapper
    wrapper Pat GhcTc
    p Kind
    _ty)
        | HsWrapper -> Bool
    isIdHsWrapper HsWrapper
    wrapper                   -> Id -> Pat GhcTc -> DsM [PmGrd]
    desugarPat Id
    x Pat GhcTc
    p
        | WpCast TcCoercionR
    co <-  HsWrapper
    wrapper, TcCoercionR -> Bool
    isReflexiveCo TcCoercionR
    co -> Id -> Pat GhcTc -> DsM [PmGrd]
    desugarPat Id
    x Pat GhcTc
    p
        | Bool
    otherwise -> do
            (Id
    y, [PmGrd]
    grds) <- Pat GhcTc -> DsM (Id, [PmGrd])
    desugarPatV Pat GhcTc
    p
            CoreExpr -> CoreExpr
    wrap_rhs_y <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    wrapper
            [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Id -> CoreExpr -> PmGrd
    PmLet Id
    y (CoreExpr -> CoreExpr
    wrap_rhs_y (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    x)) PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [PmGrd]
    grds)

      -- (n + k)  ===>   let b = x >= k, True <- b, let n = x-k
      NPlusKPat XNPlusKPat GhcTc
    _pat_ty (L SrcSpanAnnN
    _ Id
    n) XRec GhcTc (HsOverLit GhcTc)
    k1 HsOverLit GhcTc
    k2 SyntaxExpr GhcTc
    ge SyntaxExpr GhcTc
    minus -> do
        Id
    b <- Kind -> DsM Id
    mkPmId Kind
    boolTy
        let grd_b :: PmGrd
    grd_b = Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    b DataCon
    trueDataCon []
        [CoreExpr
    ke1, CoreExpr
    ke2] <- (HsOverLit GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr)
    -> [HsOverLit GhcTc] -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse HsOverLit GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsOverLit [GenLocated SrcSpan (HsOverLit GhcTc) -> HsOverLit GhcTc
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpan (HsOverLit GhcTc)
    XRec GhcTc (HsOverLit GhcTc)
    k1, HsOverLit GhcTc
    k2]
        CoreExpr
    rhs_b <- SyntaxExpr GhcTc
    -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    ge    [Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    x, CoreExpr
    ke1]
        CoreExpr
    rhs_n <- SyntaxExpr GhcTc
    -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    minus [Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    x, CoreExpr
    ke2]
        [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Id -> CoreExpr -> PmGrd
    PmLet Id
    b CoreExpr
    rhs_b, PmGrd
    grd_b, Id -> CoreExpr -> PmGrd
    PmLet Id
    n CoreExpr
    rhs_n]

      -- (fun -> pat)   ===>   let y = fun x, pat <- y where y is a match var of pat
      ViewPat XViewPat GhcTc
    _arg_ty LHsExpr GhcTc
    lexpr LPat GhcTc
    pat -> do
        (Id
    y, [PmGrd]
    grds) <- LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV LPat GhcTc
    pat
        CoreExpr
    fun <- LHsExpr GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsLExpr LHsExpr GhcTc
    lexpr
        [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PmGrd] -> DsM [PmGrd]) -> [PmGrd] -> DsM [PmGrd]
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr -> PmGrd
    PmLet Id
    y (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    fun (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    x)) PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [PmGrd]
    grds

      -- list
      ListPat (ListPatTc Kind
    _elem_ty Maybe (Kind, SyntaxExpr GhcTc)
    Nothing) [LPat GhcTc]
    ps ->
        Id -> [LPat GhcTc] -> DsM [PmGrd]
    desugarListPat Id
    x [LPat GhcTc]
    ps

      -- overloaded list
      ListPat (ListPatTc Kind
    elem_ty (Just (Kind
    pat_ty, SyntaxExpr GhcTc
    to_list))) [LPat GhcTc]
    pats -> do
        DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        case Kind -> Maybe Kind
    splitListTyConApp_maybe Kind
    pat_ty of
          Just Kind
    _e_ty
            | Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.RebindableSyntax DynFlags
    dflags)
            -- Just desugar it as a regular ListPat
            -> Id -> [LPat GhcTc] -> DsM [PmGrd]
    desugarListPat Id
    x [LPat GhcTc]
    pats
          Maybe Kind
    _ -> do
            Id
    y <- Kind -> DsM Id
    mkPmId (Kind -> Kind
    mkListTy Kind
    elem_ty)
            [PmGrd]
    grds <- Id -> [LPat GhcTc] -> DsM [PmGrd]
    desugarListPat Id
    y [LPat GhcTc]
    pats
            CoreExpr
    rhs_y <- SyntaxExpr GhcTc
    -> [CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    to_list [Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    x]
            [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PmGrd] -> DsM [PmGrd]) -> [PmGrd] -> DsM [PmGrd]
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr -> PmGrd
    PmLet Id
    y CoreExpr
    rhs_y PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [PmGrd]
    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 :: forall p. Pat p -> XRec p (ConLikeP p)
    pat_con     = L SrcSpanAnnN
    _ ConLike
    con
             , pat_args :: forall p. Pat p -> HsConPatDetails p
    pat_args    = HsConPatDetails GhcTc
    ps
             , pat_con_ext :: forall p. Pat p -> XConPat p
    pat_con_ext = ConPatTc
               { cpt_arg_tys :: ConPatTc -> [Kind]
    cpt_arg_tys = [Kind]
    arg_tys
               , cpt_tvs :: ConPatTc -> [Id]
    cpt_tvs     = [Id]
    ex_tvs
               , cpt_dicts :: ConPatTc -> [Id]
    cpt_dicts   = [Id]
    dicts
               }
             } ->
        Id
    -> ConLike
    -> [Kind]
    -> [Id]
    -> [Id]
    -> HsConPatDetails GhcTc
    -> DsM [PmGrd]
    desugarConPatOut Id
    x ConLike
    con [Kind]
    arg_tys [Id]
    ex_tvs [Id]
    dicts HsConPatDetails GhcTc
    ps

      NPat XNPat GhcTc
    ty (L SrcSpan
    _ HsOverLit GhcTc
    olit) Maybe (SyntaxExpr GhcTc)
    mb_neg SyntaxExpr GhcTc
    _ -> 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.
        DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
        Maybe PmLit
    pm_lit <- case HsOverLit GhcTc
    olit of
          OverLit{ ol_val :: forall p. HsOverLit p -> OverLitVal
    ol_val = OverLitVal
    val, ol_ext :: forall p. HsOverLit p -> XOverLit p
    ol_ext = OverLitTc Bool
    rebindable Kind
    _ }
            | Bool -> Bool
    not Bool
    rebindable
            , Just HsExpr GhcTc
    expr <- Platform -> OverLitVal -> Kind -> Maybe (HsExpr GhcTc)
    shortCutLit Platform
    platform OverLitVal
    val Kind
    XNPat GhcTc
    ty
            -> CoreExpr -> Maybe PmLit
    coreExprAsPmLit (CoreExpr -> Maybe PmLit)
    -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe PmLit)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsExpr GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsExpr HsExpr GhcTc
    expr
            | Bool -> Bool
    not Bool
    rebindable
            , (HsFractional FractionalLit
    f) <- OverLitVal
    val
            , Int
    negates <- if FractionalLit -> Bool
    fl_neg FractionalLit
    f then Int
    1 else Int
    0
            -> do
                TyCon
    rat_tc <- Name -> DsM TyCon
    dsLookupTyCon Name
    rationalTyConName
                let rat_ty :: Kind
    rat_ty = TyCon -> Kind
    mkTyConTy TyCon
    rat_tc
                Maybe PmLit -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe PmLit)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe PmLit -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe PmLit))
    -> Maybe PmLit -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe PmLit)
    forall a b. (a -> b) -> a -> b
    $ PmLit -> Maybe PmLit
    forall a. a -> Maybe a
    Just (PmLit -> Maybe PmLit) -> PmLit -> Maybe PmLit
    forall a b. (a -> b) -> a -> b
    $ Kind -> PmLitValue -> PmLit
    PmLit Kind
    rat_ty (Int -> FractionalLit -> PmLitValue
    PmLitOverRat Int
    negates FractionalLit
    f)
            | Bool
    otherwise
            -> do
               CoreExpr
    dsLit <- HsOverLit GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsOverLit HsOverLit GhcTc
    olit
               let !pmLit :: Maybe PmLit
    pmLit = CoreExpr -> Maybe PmLit
    coreExprAsPmLit CoreExpr
    dsLit :: Maybe PmLit
              --  pprTraceM "desugarPat"
              --     (
              --       text "val" <+> ppr val $$
              --       text "witness" <+> ppr (ol_witness olit) $$
              --       text "dsLit" <+> ppr dsLit $$
              --       text "asPmLit" <+> ppr pmLit
              --     )
               Maybe PmLit -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe PmLit)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe PmLit
    pmLit

        let lit :: PmLit
    lit = case Maybe PmLit
    pm_lit of
              Just PmLit
    l -> PmLit
    l
              Maybe PmLit
    Nothing -> [Char] -> SDoc -> PmLit
    forall a. HasCallStack => [Char] -> SDoc -> a
    pprPanic [Char]
    "failed to detect OverLit" (HsOverLit GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsOverLit GhcTc
    olit)
        let lit' :: PmLit
    lit' = case Maybe (SyntaxExpr GhcTc)
    mb_neg of
              Just SyntaxExpr GhcTc
    _  -> [Char] -> Maybe PmLit -> PmLit
    forall a. HasCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "failed to negate lit" (PmLit -> Maybe PmLit
    negatePmLit PmLit
    lit)
              Maybe (SyntaxExpr GhcTc)
    Nothing -> PmLit
    lit
        Id -> PmLit -> DsM [PmGrd]
    mkPmLitGrds Id
    x PmLit
    lit'

      LitPat XLitPat GhcTc
    _ HsLit GhcTc
    lit -> do
        CoreExpr
    core_expr <- HsLit GhcRn -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsLit (HsLit GhcTc -> HsLit GhcRn
    forall (p1 :: Pass) (p2 :: Pass).
    HsLit (GhcPass p1) -> HsLit (GhcPass p2)
    convertLit HsLit GhcTc
    lit)
        let lit :: PmLit
    lit = [Char] -> Maybe PmLit -> PmLit
    forall a. HasCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "failed to detect Lit" (CoreExpr -> Maybe PmLit
    coreExprAsPmLit CoreExpr
    core_expr)
        Id -> PmLit -> DsM [PmGrd]
    mkPmLitGrds Id
    x PmLit
    lit

      TuplePat XTuplePat GhcTc
    _tys [LPat GhcTc]
    pats Boxity
    boxity -> do
        ([Id]
    vars, [[PmGrd]]
    grdss) <- (GenLocated SrcSpanAnnA (Pat GhcTc) -> DsM (Id, [PmGrd]))
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)]
    -> IOEnv (Env DsGblEnv DsLclEnv) ([Id], [[PmGrd]])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM GenLocated SrcSpanAnnA (Pat GhcTc) -> DsM (Id, [PmGrd])
    LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV [GenLocated SrcSpanAnnA (Pat GhcTc)]
    [LPat GhcTc]
    pats
        let tuple_con :: DataCon
    tuple_con = Boxity -> Int -> DataCon
    tupleDataCon Boxity
    boxity ([Id] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    vars)
        [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PmGrd] -> DsM [PmGrd]) -> [PmGrd] -> DsM [PmGrd]
    forall a b. (a -> b) -> a -> b
    $ Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    x DataCon
    tuple_con [Id]
    vars PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [[PmGrd]] -> [PmGrd]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[PmGrd]]
    grdss

      SumPat XSumPat GhcTc
    _ty LPat GhcTc
    p Int
    alt Int
    arity -> do
        (Id
    y, [PmGrd]
    grds) <- LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV LPat GhcTc
    p
        let sum_con :: DataCon
    sum_con = Int -> Int -> DataCon
    sumDataCon Int
    alt Int
    arity
        -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
        [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PmGrd] -> DsM [PmGrd]) -> [PmGrd] -> DsM [PmGrd]
    forall a b. (a -> b) -> a -> b
    $ Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    x DataCon
    sum_con [Id
    y] PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [PmGrd]
    grds

      SplicePat {} -> [Char] -> DsM [PmGrd]
    forall a. [Char] -> a
    panic [Char]
    "Check.desugarPat: SplicePat"

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

    desugarLPat :: Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat :: Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat Id
    x = Id -> Pat GhcTc -> DsM [PmGrd]
    desugarPat Id
    x (Pat GhcTc -> DsM [PmGrd])
    -> (GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc)
    -> GenLocated SrcSpanAnnA (Pat GhcTc)
    -> DsM [PmGrd]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc

    -- | 'desugarLPat', but also select and return a new match var.
    desugarLPatV :: LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV :: LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV = Pat GhcTc -> DsM (Id, [PmGrd])
    desugarPatV (Pat GhcTc -> DsM (Id, [PmGrd]))
    -> (GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc)
    -> GenLocated SrcSpanAnnA (Pat GhcTc)
    -> DsM (Id, [PmGrd])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    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 :: Id -> [LPat GhcTc] -> DsM [PmGrd]
    desugarListPat Id
    x [LPat GhcTc]
    pats = do
      [(Id, [PmGrd])]
    vars_and_grdss <- (GenLocated SrcSpanAnnA (Pat GhcTc) -> DsM (Id, [PmGrd]))
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)]
    -> IOEnv (Env DsGblEnv DsLclEnv) [(Id, [PmGrd])]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse GenLocated SrcSpanAnnA (Pat GhcTc) -> DsM (Id, [PmGrd])
    LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV [GenLocated SrcSpanAnnA (Pat GhcTc)]
    [LPat GhcTc]
    pats
      Id -> [(Id, [PmGrd])] -> DsM [PmGrd]
    mkListGrds Id
    x [(Id, [PmGrd])]
    vars_and_grdss

    -- | Desugar a constructor pattern
    desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar]
                     -> [EvVar] -> HsConPatDetails GhcTc -> DsM [PmGrd]
    desugarConPatOut :: Id
    -> ConLike
    -> [Kind]
    -> [Id]
    -> [Id]
    -> HsConPatDetails GhcTc
    -> DsM [PmGrd]
    desugarConPatOut Id
    x ConLike
    con [Kind]
    univ_tys [Id]
    ex_tvs [Id]
    dicts = \case
        PrefixCon [HsPatSigType (NoGhcTc GhcTc)]
    _ [LPat GhcTc]
    ps               -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))] -> DsM [PmGrd]
    go_field_pats ([Int]
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)]
    -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [GenLocated SrcSpanAnnA (Pat GhcTc)]
    [LPat GhcTc]
    ps)
        InfixCon  LPat GhcTc
    p1 LPat GhcTc
    p2              -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))] -> DsM [PmGrd]
    go_field_pats ([Int]
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)]
    -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    p1,GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    p2])
        RecCon    (HsRecFields [LHsRecField GhcTc (LPat GhcTc)]
    fs Maybe (Located Int)
    _) -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))] -> DsM [PmGrd]
    go_field_pats ([GenLocated
       SrcSpanAnnA
       (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))]
    -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    rec_field_ps [GenLocated
       SrcSpanAnnA
       (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))]
    [LHsRecField GhcTc (LPat GhcTc)]
    fs)
      where
        -- The actual argument types (instantiated)
        arg_tys :: [Kind]
    arg_tys     = (Scaled Kind -> Kind) -> [Scaled Kind] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled Kind -> Kind
    forall a. Scaled a -> a
    scaledThing ([Scaled Kind] -> [Kind]) -> [Scaled Kind] -> [Kind]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [Kind] -> [Scaled Kind]
    conLikeInstOrigArgTys ConLike
    con ([Kind]
    univ_tys [Kind] -> [Kind] -> [Kind]
    forall a. [a] -> [a] -> [a]
    ++ [Id] -> [Kind]
    mkTyVarTys [Id]
    ex_tvs)

        -- Extract record field patterns tagged by field index from a list of
        -- LHsRecField
        rec_field_ps :: [GenLocated
       SrcSpanAnnA
       (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))]
    -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    rec_field_ps [GenLocated
       SrcSpanAnnA
       (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))]
    fs = (GenLocated
       SrcSpanAnnA (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
     -> (Int, GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))]
    -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    forall a b. (a -> b) -> [a] -> [b]
    map (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
    -> (Int, GenLocated SrcSpanAnnA (Pat GhcTc))
    tagged_pat (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
     -> (Int, GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> (GenLocated
          SrcSpanAnnA (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
        -> HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> GenLocated
         SrcSpanAnnA (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> (Int, GenLocated SrcSpanAnnA (Pat GhcTc))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
    forall l e. GenLocated l e -> e
    unLoc) [GenLocated
       SrcSpanAnnA
       (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))]
    fs
          where
            tagged_pat :: HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
    -> (Int, GenLocated SrcSpanAnnA (Pat GhcTc))
    tagged_pat HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
    f = (Name -> Int
    lbl_to_index (Located Id -> Name
    forall a. NamedThing a => a -> Name
    getName (HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)) -> Located Id
    forall arg. HsRecField GhcTc arg -> Located Id
    hsRecFieldId HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
    f)), HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
    -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall id arg. HsRecField' id arg -> arg
    hsRecFieldArg HsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
    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 :: [Name]
    orig_lbls        = (FieldLabel -> Name) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLabel -> Name
    flSelector ([FieldLabel] -> [Name]) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con
            lbl_to_index :: Name -> Int
    lbl_to_index Name
    lbl = [Char] -> Maybe Int -> Int
    forall a. HasCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "lbl_to_index" (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Name -> [Name] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Name
    lbl [Name]
    orig_lbls

        go_field_pats :: [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))] -> DsM [PmGrd]
    go_field_pats [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    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 :: (a, GenLocated SrcSpanAnnA (Pat GhcTc))
    -> IOEnv (Env DsGblEnv DsLclEnv) ((a, Id), [PmGrd])
    trans_pat (a
    n, GenLocated SrcSpanAnnA (Pat GhcTc)
    pat) = do
                (Id
    var, [PmGrd]
    pvec) <- LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat
                ((a, Id), [PmGrd])
    -> IOEnv (Env DsGblEnv DsLclEnv) ((a, Id), [PmGrd])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((a
    n, Id
    var), [PmGrd]
    pvec)
          ([(Int, Id)]
    tagged_vars, [[PmGrd]]
    arg_grdss) <- ((Int, GenLocated SrcSpanAnnA (Pat GhcTc))
     -> IOEnv (Env DsGblEnv DsLclEnv) ((Int, Id), [PmGrd]))
    -> [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    -> IOEnv (Env DsGblEnv DsLclEnv) ([(Int, Id)], [[PmGrd]])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM (Int, GenLocated SrcSpanAnnA (Pat GhcTc))
    -> IOEnv (Env DsGblEnv DsLclEnv) ((Int, Id), [PmGrd])
    forall {a}.
    (a, GenLocated SrcSpanAnnA (Pat GhcTc))
    -> IOEnv (Env DsGblEnv DsLclEnv) ((a, Id), [PmGrd])
    trans_pat [(Int, GenLocated SrcSpanAnnA (Pat GhcTc))]
    tagged_pats

          let get_pat_id :: Int -> Kind -> DsM Id
    get_pat_id Int
    n Kind
    ty = case Int -> [(Int, Id)] -> Maybe Id
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Int
    n [(Int, Id)]
    tagged_vars of
                Just Id
    var -> Id -> DsM Id
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Id
    var
                Maybe Id
    Nothing  -> Kind -> DsM Id
    mkPmId Kind
    ty

          -- 1. the constructor pattern match itself
          [Id]
    arg_ids <- (Int -> Kind -> DsM Id)
    -> [Int] -> [Kind] -> IOEnv (Env DsGblEnv DsLclEnv) [Id]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Int -> Kind -> DsM Id
    get_pat_id [Int
    0..] [Kind]
    arg_tys
          let con_grd :: PmGrd
    con_grd = Id -> PmAltCon -> [Id] -> [Id] -> [Id] -> PmGrd
    PmCon Id
    x (ConLike -> PmAltCon
    PmAltConLike ConLike
    con) [Id]
    ex_tvs [Id]
    dicts [Id]
    arg_ids

          -- 2. guards from field selector patterns
          let arg_grds :: [PmGrd]
    arg_grds = [[PmGrd]] -> [PmGrd]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[PmGrd]]
    arg_grdss

          -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids)
          [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PmGrd
    con_grd PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [PmGrd]
    arg_grds)

    desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre)
    -- See 'GrdPatBind' for how this simply repurposes GrdGRHS.
    desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre)
    desugarPatBind SrcSpan
    loc Id
    var Pat GhcTc
    pat =
      PmGRHS Pre -> PmPatBind Pre
    forall p. PmGRHS p -> PmPatBind p
    PmPatBind (PmGRHS Pre -> PmPatBind Pre)
    -> ([PmGrd] -> PmGRHS Pre) -> [PmGrd] -> PmPatBind Pre
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pre -> SrcInfo -> PmGRHS Pre) -> SrcInfo -> Pre -> PmGRHS Pre
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Pre -> SrcInfo -> PmGRHS Pre
    forall p. p -> SrcInfo -> PmGRHS p
    PmGRHS (Located SDoc -> SrcInfo
    SrcInfo (SrcSpan -> SDoc -> Located SDoc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (Pat GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcTc
    pat))) (Pre -> PmGRHS Pre) -> ([PmGrd] -> Pre) -> [PmGrd] -> PmGRHS Pre
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [PmGrd] -> Pre
    GrdVec ([PmGrd] -> PmPatBind Pre) -> DsM [PmGrd] -> DsM (PmPatBind Pre)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> Pat GhcTc -> DsM [PmGrd]
    desugarPat Id
    var Pat GhcTc
    pat

    desugarEmptyCase :: Id -> DsM PmEmptyCase
    desugarEmptyCase :: Id -> DsM PmEmptyCase
    desugarEmptyCase Id
    var = PmEmptyCase -> DsM PmEmptyCase
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PmEmptyCase { pe_var :: Id
    pe_var = Id
    var }

    -- | Desugar the non-empty 'Match'es of a 'MatchGroup'.
    desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc))
                   -> DsM (PmMatchGroup Pre)
    desugarMatches :: [Id]
    -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc))
    -> DsM (PmMatchGroup Pre)
    desugarMatches [Id]
    vars NonEmpty (LMatch GhcTc (LHsExpr GhcTc))
    matches =
      NonEmpty (PmMatch Pre) -> PmMatchGroup Pre
    forall p. NonEmpty (PmMatch p) -> PmMatchGroup p
    PmMatchGroup (NonEmpty (PmMatch Pre) -> PmMatchGroup Pre)
    -> IOEnv (Env DsGblEnv DsLclEnv) (NonEmpty (PmMatch Pre))
    -> DsM (PmMatchGroup Pre)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (GenLocated
       SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> IOEnv (Env DsGblEnv DsLclEnv) (PmMatch Pre))
    -> NonEmpty
         (GenLocated
            SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> IOEnv (Env DsGblEnv DsLclEnv) (NonEmpty (PmMatch Pre))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ([Id]
    -> LMatch GhcTc (LHsExpr GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) (PmMatch Pre)
    desugarMatch [Id]
    vars) NonEmpty
      (GenLocated
         SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    NonEmpty (LMatch GhcTc (LHsExpr GhcTc))
    matches

    -- Desugar a single match
    desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre)
    desugarMatch :: [Id]
    -> LMatch GhcTc (LHsExpr GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) (PmMatch Pre)
    desugarMatch [Id]
    vars (L SrcSpanAnnA
    match_loc (Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcTc]
    pats, m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss = GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    grhss })) = do
      [PmGrd]
    pats'  <- [[PmGrd]] -> [PmGrd]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[PmGrd]] -> [PmGrd])
    -> IOEnv (Env DsGblEnv DsLclEnv) [[PmGrd]] -> DsM [PmGrd]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Id -> GenLocated SrcSpanAnnA (Pat GhcTc) -> DsM [PmGrd])
    -> [Id]
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)]
    -> IOEnv (Env DsGblEnv DsLclEnv) [[PmGrd]]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Id -> GenLocated SrcSpanAnnA (Pat GhcTc) -> DsM [PmGrd]
    Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat [Id]
    vars [GenLocated SrcSpanAnnA (Pat GhcTc)]
    [LPat GhcTc]
    pats
      PmGRHSs Pre
    grhss' <- SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre)
    desugarGRHSs (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    match_loc) ([SDoc] -> SDoc
    sep ((GenLocated SrcSpanAnnA (Pat GhcTc) -> SDoc)
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (Pat GhcTc) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [GenLocated SrcSpanAnnA (Pat GhcTc)]
    [LPat GhcTc]
    pats)) GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    GRHSs GhcTc (LHsExpr GhcTc)
    grhss
      -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss'])
      PmMatch Pre -> IOEnv (Env DsGblEnv DsLclEnv) (PmMatch Pre)
    forall (m :: * -> *) a. Monad m => a -> m a
    return PmMatch { pm_pats :: Pre
    pm_pats = [PmGrd] -> Pre
    GrdVec [PmGrd]
    pats', pm_grhss :: PmGRHSs Pre
    pm_grhss = PmGRHSs Pre
    grhss' }

    desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre)
    desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre)
    desugarGRHSs SrcSpan
    match_loc SDoc
    pp_pats GRHSs GhcTc (LHsExpr GhcTc)
    grhss = do
      [PmGrd]
    lcls <- HsLocalBinds GhcTc -> DsM [PmGrd]
    desugarLocalBinds (GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> HsLocalBinds GhcTc
    forall p body. GRHSs p body -> HsLocalBinds p
    grhssLocalBinds GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    GRHSs GhcTc (LHsExpr GhcTc)
    grhss)
      NonEmpty (PmGRHS Pre)
    grhss' <- (GenLocated
       SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> IOEnv (Env DsGblEnv DsLclEnv) (PmGRHS Pre))
    -> NonEmpty
         (GenLocated
            SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> IOEnv (Env DsGblEnv DsLclEnv) (NonEmpty (PmGRHS Pre))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (SrcSpan
    -> SDoc
    -> LGRHS GhcTc (LHsExpr GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) (PmGRHS Pre)
    desugarLGRHS SrcSpan
    match_loc SDoc
    pp_pats)
                  (NonEmpty
       (GenLocated
          SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
     -> IOEnv (Env DsGblEnv DsLclEnv) (NonEmpty (PmGRHS Pre)))
    -> ([GenLocated
           SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
        -> NonEmpty
             (GenLocated
                SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    -> [GenLocated
          SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> IOEnv (Env DsGblEnv DsLclEnv) (NonEmpty (PmGRHS Pre))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char]
    -> Maybe
         (NonEmpty
            (GenLocated
               SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    -> NonEmpty
         (GenLocated
            SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    forall a. HasCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "desugarGRHSs"
                  (Maybe
       (NonEmpty
          (GenLocated
             SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
     -> NonEmpty
          (GenLocated
             SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    -> ([GenLocated
           SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
        -> Maybe
             (NonEmpty
                (GenLocated
                   SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))))
    -> [GenLocated
          SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> NonEmpty
         (GenLocated
            SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [GenLocated
       SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> Maybe
         (NonEmpty
            (GenLocated
               SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty
                  ([GenLocated
        SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
     -> IOEnv (Env DsGblEnv DsLclEnv) (NonEmpty (PmGRHS Pre)))
    -> [GenLocated
          SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> IOEnv (Env DsGblEnv DsLclEnv) (NonEmpty (PmGRHS Pre))
    forall a b. (a -> b) -> a -> b
    $ GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [LGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    forall p body. GRHSs p body -> [LGRHS p body]
    grhssGRHSs GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    GRHSs GhcTc (LHsExpr GhcTc)
    grhss
      PmGRHSs Pre -> DsM (PmGRHSs Pre)
    forall (m :: * -> *) a. Monad m => a -> m a
    return PmGRHSs { pgs_lcls :: Pre
    pgs_lcls = [PmGrd] -> Pre
    GrdVec [PmGrd]
    lcls, pgs_grhss :: NonEmpty (PmGRHS Pre)
    pgs_grhss = NonEmpty (PmGRHS Pre)
    grhss' }

    -- | Desugar a guarded right-hand side to a single 'GrdTree'
    desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre)
    desugarLGRHS :: SrcSpan
    -> SDoc
    -> LGRHS GhcTc (LHsExpr GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) (PmGRHS Pre)
    desugarLGRHS SrcSpan
    match_loc SDoc
    pp_pats (L SrcSpan
    _loc (GRHS XCGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    _ [GuardLStmt GhcTc]
    gs GenLocated SrcSpanAnnA (HsExpr GhcTc)
    _)) = 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 :: Located SDoc
    rhs_info = case [GuardLStmt GhcTc]
    gs of
            []              -> SrcSpan -> SDoc -> Located SDoc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    match_loc      SDoc
    pp_pats
            (L SrcSpanAnnA
    grd_loc StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    _):[GuardLStmt GhcTc]
    _ -> SrcSpan -> SDoc -> Located SDoc
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    grd_loc) (SDoc
    pp_pats SDoc -> SDoc -> SDoc
    <+> SDoc
    vbar SDoc -> SDoc -> SDoc
    <+> [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> SDoc
    forall a. Outputable a => [a] -> SDoc
    interpp'SP [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [GuardLStmt GhcTc]
    gs)
      [PmGrd]
    grds <- (GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> DsM [PmGrd])
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM [PmGrd]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> DsM [PmGrd]
    GuardStmt GhcTc -> DsM [PmGrd]
    desugarGuard (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> DsM [PmGrd])
    -> (GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
        -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> DsM [PmGrd]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall l e. GenLocated l e -> e
    unLoc) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [GuardLStmt GhcTc]
    gs
      PmGRHS Pre -> IOEnv (Env DsGblEnv DsLclEnv) (PmGRHS Pre)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PmGRHS { pg_grds :: Pre
    pg_grds = [PmGrd] -> Pre
    GrdVec [PmGrd]
    grds, pg_rhs :: SrcInfo
    pg_rhs = Located SDoc -> SrcInfo
    SrcInfo Located SDoc
    rhs_info }

    -- | Desugar a guard statement to a '[PmGrd]'
    desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd]
    desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd]
    desugarGuard GuardStmt GhcTc
    guard = case GuardStmt GhcTc
    guard of
      BodyStmt XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    _   LHsExpr GhcTc
    e SyntaxExpr GhcTc
    _ SyntaxExpr GhcTc
    _ -> LHsExpr GhcTc -> DsM [PmGrd]
    desugarBoolGuard LHsExpr GhcTc
    e
      LetStmt  XLetStmt GhcTc GhcTc (LHsExpr GhcTc)
    _   HsLocalBinds GhcTc
    binds -> HsLocalBinds GhcTc -> DsM [PmGrd]
    desugarLocalBinds HsLocalBinds GhcTc
    binds
      BindStmt XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    _ LPat GhcTc
    p LHsExpr GhcTc
    e     -> LPat GhcTc -> LHsExpr GhcTc -> DsM [PmGrd]
    desugarBind LPat GhcTc
    p LHsExpr GhcTc
    e
      LastStmt        {} -> [Char] -> DsM [PmGrd]
    forall a. [Char] -> a
    panic [Char]
    "desugarGuard LastStmt"
      ParStmt         {} -> [Char] -> DsM [PmGrd]
    forall a. [Char] -> a
    panic [Char]
    "desugarGuard ParStmt"
      TransStmt       {} -> [Char] -> DsM [PmGrd]
    forall a. [Char] -> a
    panic [Char]
    "desugarGuard TransStmt"
      RecStmt         {} -> [Char] -> DsM [PmGrd]
    forall a. [Char] -> a
    panic [Char]
    "desugarGuard RecStmt"
      ApplicativeStmt {} -> [Char] -> DsM [PmGrd]
    forall a. [Char] -> a
    panic [Char]
    "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 :: HsLocalBinds GhcTc -> DsM [PmGrd]
    desugarLocalBinds (HsValBinds XHsValBinds GhcTc GhcTc
    _ (XValBindsLR (NValBinds [(RecFlag, LHsBinds GhcTc)]
    binds [LSig GhcRn]
    _))) =
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
     -> DsM [PmGrd])
    -> [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
    -> DsM [PmGrd]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM ((GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> DsM [PmGrd])
    -> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)] -> DsM [PmGrd]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> DsM [PmGrd]
    LHsBind GhcTc -> DsM [PmGrd]
    go ([GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)] -> DsM [PmGrd])
    -> (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
        -> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)])
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> DsM [PmGrd]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
    forall a. Bag a -> [a]
    bagToList) (((RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
     -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
    -> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
    -> [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
    forall a b. (a -> b) -> [a] -> [b]
    map (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    forall a b. (a, b) -> b
    snd [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
    [(RecFlag, LHsBinds GhcTc)]
    binds)
      where
        go :: LHsBind GhcTc -> DsM [PmGrd]
        go :: LHsBind GhcTc -> DsM [PmGrd]
    go (L SrcSpanAnnA
    _ FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
    fun_id = L SrcSpanAnnN
    _ Id
    x, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
    mg})
          -- See Note [Long-distance information for HsLocalBinds] for why this
          -- pattern match is so very specific.
          | L SrcSpanAnnL
    _ [L SrcSpanAnnA
    _ Match{m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [], m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss = GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    grhss}] <- MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> XRec
         GhcTc [LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    forall p body. MatchGroup p body -> XRec p [LMatch p body]
    mg_alts MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    MatchGroup GhcTc (LHsExpr GhcTc)
    mg
          , GRHSs{grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
    grhssGRHSs = [L SrcSpan
    _ (GRHS XCGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    _ [GuardLStmt GhcTc]
    _grds GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs)]} <- GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    grhss = do
              CoreExpr
    core_rhs <- LHsExpr GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsLExpr GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs
              [PmGrd] -> DsM [PmGrd]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Id -> CoreExpr -> PmGrd
    PmLet Id
    x CoreExpr
    core_rhs]
        go (L SrcSpanAnnA
    _ AbsBinds{ abs_tvs :: forall idL idR. HsBindLR idL idR -> [Id]
    abs_tvs = [], abs_ev_vars :: forall idL idR. HsBindLR idL idR -> [Id]
    abs_ev_vars = []
                        , abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
    abs_exports=[ABExport GhcTc]
    exports, abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
    abs_binds = LHsBinds GhcTc
    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 :: ABExport GhcTc -> Maybe PmGrd
    go_export ABE{abe_poly :: forall p. ABExport p -> IdP p
    abe_poly = IdP GhcTc
    x, abe_mono :: forall p. ABExport p -> IdP p
    abe_mono = IdP GhcTc
    y, abe_wrap :: forall p. ABExport p -> HsWrapper
    abe_wrap = HsWrapper
    wrap}
                | HsWrapper -> Bool
    isIdHsWrapper HsWrapper
    wrap
                = ASSERT2(idType x `eqType` idType y, ppr x $$ ppr (idType x) $$ ppr y $$ ppr (idType y))
                  PmGrd -> Maybe PmGrd
    forall a. a -> Maybe a
    Just (PmGrd -> Maybe PmGrd) -> PmGrd -> Maybe PmGrd
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr -> PmGrd
    PmLet Id
    IdP GhcTc
    x (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    IdP GhcTc
    y)
                | Bool
    otherwise
                = Maybe PmGrd
    forall a. Maybe a
    Nothing
          let exps :: [PmGrd]
    exps = (ABExport GhcTc -> Maybe PmGrd) -> [ABExport GhcTc] -> [PmGrd]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ABExport GhcTc -> Maybe PmGrd
    go_export [ABExport GhcTc]
    exports
          [PmGrd]
    bs <- (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> DsM [PmGrd])
    -> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)] -> DsM [PmGrd]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> DsM [PmGrd]
    LHsBind GhcTc -> DsM [PmGrd]
    go (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> [GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)]
    forall a. Bag a -> [a]
    bagToList Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    LHsBinds GhcTc
    binds)
          [PmGrd] -> DsM [PmGrd]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([PmGrd]
    exps [PmGrd] -> [PmGrd] -> [PmGrd]
    forall a. [a] -> [a] -> [a]
    ++ [PmGrd]
    bs)
        go LHsBind GhcTc
    _ = [PmGrd] -> DsM [PmGrd]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    desugarLocalBinds HsLocalBinds GhcTc
    _binds = [PmGrd] -> DsM [PmGrd]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    -- | Desugar a pattern guard
    --   @pat <- e ==>  let x = e;  <guards for pat <- x>@
    desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM [PmGrd]
    desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM [PmGrd]
    desugarBind LPat GhcTc
    p LHsExpr GhcTc
    e = LHsExpr GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsLExpr LHsExpr GhcTc
    e IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    -> (CoreExpr -> DsM [PmGrd]) -> DsM [PmGrd]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      Var Id
    y
        | Maybe DataCon
    Nothing <- Id -> Maybe DataCon
    isDataConId_maybe Id
    y
        -- RHS is a variable, so that will allow us to omit the let
        -> Id -> LPat GhcTc -> DsM [PmGrd]
    desugarLPat Id
    y LPat GhcTc
    p
      CoreExpr
    rhs -> do
        (Id
    x, [PmGrd]
    grds) <- LPat GhcTc -> DsM (Id, [PmGrd])
    desugarLPatV LPat GhcTc
    p
        [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Id -> CoreExpr -> PmGrd
    PmLet Id
    x CoreExpr
    rhs PmGrd -> [PmGrd] -> [PmGrd]
    forall a. a -> [a] -> [a]
    : [PmGrd]
    grds)

    -- | Desugar a boolean guard
    --   @e ==>  let x = e; True <- x@
    desugarBoolGuard :: LHsExpr GhcTc -> DsM [PmGrd]
    desugarBoolGuard :: LHsExpr GhcTc -> DsM [PmGrd]
    desugarBoolGuard LHsExpr GhcTc
    e
      | Maybe (CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr) -> Bool
    forall a. Maybe a -> Bool
    isJust (LHsExpr GhcTc
    -> Maybe (CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr)
    isTrueLHsExpr LHsExpr GhcTc
    e) = [PmGrd] -> DsM [PmGrd]
    forall (m :: * -> *) a. Monad m => a -> m a
    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
      | Bool
    otherwise = LHsExpr GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    dsLExpr LHsExpr GhcTc
    e IOEnv (Env DsGblEnv DsLclEnv) CoreExpr
    -> (CoreExpr -> DsM [PmGrd]) -> DsM [PmGrd]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Var Id
    y
            | Maybe DataCon
    Nothing <- Id -> Maybe DataCon
    isDataConId_maybe Id
    y
            -- Omit the let by matching on y
            -> [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    y DataCon
    trueDataCon []]
          CoreExpr
    rhs -> do
            Id
    x <- Kind -> DsM Id
    mkPmId Kind
    boolTy
            [PmGrd] -> DsM [PmGrd]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Id -> CoreExpr -> PmGrd
    PmLet Id
    x CoreExpr
    rhs, Id -> DataCon -> [Id] -> PmGrd
    vanillaConGrd Id
    x DataCon
    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'.
    -}