    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE MultiWayIf          #-}
    {-# LANGUAGE TypeApplications    #-}
    {-# LANGUAGE AllowAmbiguousTypes #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

    Pattern-matching literal patterns
    -}

    module GHC.HsToCore.Match.Literal
       ( dsLit, dsOverLit, hsLitKey
       , tidyLitPat, tidyNPat
       , matchLiterals, matchNPlusKPats, matchNPats
       , warnAboutIdentities
       , warnAboutOverflowedOverLit, warnAboutOverflowedLit
       , warnAboutEmptyEnumerations
       )
    where

    import GHC.Prelude
    import GHC.Platform

    import {-# SOURCE #-} GHC.HsToCore.Match ( match )
    import {-# SOURCE #-} GHC.HsToCore.Expr  ( dsExpr, dsSyntaxExpr )

    import GHC.HsToCore.Errors.Types
    import GHC.HsToCore.Monad
    import GHC.HsToCore.Utils

    import GHC.Hs

    import GHC.Tc.Utils.TcMType ( shortCutLit )
    import GHC.Tc.Utils.TcType

    import GHC.Core
    import GHC.Core.Make
    import GHC.Core.TyCon
    import GHC.Core.Reduction ( Reduction(..) )
    import GHC.Core.DataCon
    import GHC.Core.Type
    import GHC.Core.FamInstEnv ( FamInstEnvs, normaliseType )

    import GHC.Types.Name
    import GHC.Types.Literal
    import GHC.Types.SrcLoc

    import GHC.Builtin.Names
    import GHC.Builtin.Types
    import GHC.Builtin.Types.Prim

    import GHC.Types.Id
    import GHC.Types.SourceText

    import GHC.Driver.DynFlags

    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Unique (sameUnique)

    import GHC.Data.FastString

    import Control.Monad
    import Data.Int
    import Data.List.NonEmpty (NonEmpty(..))
    import qualified Data.List.NonEmpty as NEL
    import Data.Word
    import GHC.Real ( Ratio(..), numerator, denominator )

    {-
    ************************************************************************
    *                                                                      *
                    Desugaring literals
     [used to be in GHC.HsToCore.Expr, but GHC.HsToCore.Quote needs it,
      and it's nice to avoid a loop]
    *                                                                      *
    ************************************************************************

    We give int/float literals type @Integer@ and @Rational@, respectively.
    The typechecker will (presumably) have put \tr{from{Integer,Rational}s}
    around them.

    ToDo: put in range checks for when converting ``@i@''
    (or should that be in the typechecker?)

    For numeric literals, we try to detect there use at a standard type
    (@Int@, @Float@, etc.) are directly put in the right constructor.
    [NB: down with the @App@ conversion.]

    See also below where we look for @DictApps@ for \tr{plusInt}, etc.
    -}

    dsLit :: HsLit GhcRn -> DsM CoreExpr
    dsLit :: HsLit GhcRn -> DsM CoreExpr
    dsLit HsLit GhcRn
    l = do
      dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      let platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
      case l of
        HsStringPrim XHsStringPrim GhcRn
    _ ByteString
    s -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (ByteString -> Literal
    LitString ByteString
    s))
        HsCharPrim   XHsCharPrim GhcRn
    _ Char
    c -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Char -> Literal
    LitChar Char
    c))
        HsIntPrim    XHsIntPrim GhcRn
    _ Integer
    i -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Platform -> Integer -> Literal
    mkLitIntWrap Platform
    platform Integer
    i))
        HsWordPrim   XHsWordPrim GhcRn
    _ Integer
    w -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Platform -> Integer -> Literal
    mkLitWordWrap Platform
    platform Integer
    w))
        HsInt8Prim   XHsInt8Prim GhcRn
    _ Integer
    i -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitInt8Wrap Integer
    i))
        HsInt16Prim  XHsInt16Prim GhcRn
    _ Integer
    i -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitInt16Wrap Integer
    i))
        HsInt32Prim  XHsInt32Prim GhcRn
    _ Integer
    i -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitInt32Wrap Integer
    i))
        HsInt64Prim  XHsInt64Prim GhcRn
    _ Integer
    i -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitInt64Wrap Integer
    i))
        HsWord8Prim  XHsWord8Prim GhcRn
    _ Integer
    w -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitWord8Wrap Integer
    w))
        HsWord16Prim XHsWord16Prim GhcRn
    _ Integer
    w -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitWord16Wrap Integer
    w))
        HsWord32Prim XHsWord32Prim GhcRn
    _ Integer
    w -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitWord32Wrap Integer
    w))
        HsWord64Prim XHsWord64Prim GhcRn
    _ Integer
    w -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Integer -> Literal
    mkLitWord64Wrap Integer
    w))

        -- This can be slow for very large literals. See Note [FractionalLit representation]
        -- and #15646
        HsFloatPrim  XHsFloatPrim GhcRn
    _ FractionalLit
    fl -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Rational -> Literal
    LitFloat (FractionalLit -> Rational
    rationalFromFractionalLit FractionalLit
    fl)))
        HsDoublePrim XHsDoublePrim GhcRn
    _ FractionalLit
    fl -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Rational -> Literal
    LitDouble (FractionalLit -> Rational
    rationalFromFractionalLit FractionalLit
    fl)))
        HsChar XHsChar GhcRn
    _ Char
    c       -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> CoreExpr
    mkCharExpr Char
    c)
        HsString XHsString GhcRn
    _ FastString
    str   -> FastString -> DsM CoreExpr
    forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
    mkStringExprFS FastString
    str
        HsInteger XHsInteger GhcRn
    _ Integer
    i Type
    _  -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Platform -> Integer -> CoreExpr
    mkIntegerExpr Platform
    platform Integer
    i)
        HsInt XHsInt GhcRn
    _ IntegralLit
    i        -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Platform -> Integer -> CoreExpr
    mkIntExpr Platform
    platform (IntegralLit -> Integer
    il_value IntegralLit
    i))
        HsRat XHsRat GhcRn
    _ FractionalLit
    fl Type
    ty    -> FractionalLit -> Type -> DsM CoreExpr
    dsFractionalLitToRational FractionalLit
    fl Type
    ty

    {-
    Note [FractionalLit representation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    There is a fun wrinkle to this, we used to simply compute the value
    for these literals and store it as `Rational`. While this might seem
    reasonable it meant typechecking literals of extremely large numbers
    wasn't possible. This happened for example in #15646.

    There a user would write in GHCi e.g. `:t 1e1234111111111111111111111`
    which would trip up the compiler. The reason being we would parse it as
    <Literal of value n>. Try to compute n, which would run out of memory
    for truly large numbers, or take far too long for merely large ones.

    To fix this we instead now store the significand and exponent of the
    literal instead. Depending on the size of the exponent we then defer
    the computation of the Rational value, potentially up to runtime of the
    program! There are still cases left were we might compute large rationals
    but it's a lot rarer then.

    The current state of affairs for large literals is:
    * Typechecking: Will produce a FractionalLit
    * Desugaring a large overloaded literal to Float/Double *is* done
      at compile time. So can still fail. But this only matters for values too large
      to be represented as float anyway.
    * Converting overloaded literals to a value of *Rational* is done at *runtime*.
      If such a value is then demanded at runtime the program might hang or run out of
      memory. But that is perhaps expected and acceptable.
    * TH might also evaluate the literal even when overloaded.
      But there a user should be able to work around #15646 by
      generating a call to `mkRationalBase10/2` for large literals instead.

    Note [FractionalLit representation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For fractional literals, like 1.3 or 0.79e22, we do /not/ represent
    them within the compiler as a Rational.  Doing so would force the
    compiler to compute a huge Rational for 2.3e300000000000, at compile
    time (#15646)!

    So instead we represent fractional literals as a FractionalLit,
    in which we record the significand and exponent separately.  Then
    we can compute the huge Rational at /runtime/, by emitting code
    for
           mkRationalBase10 2.3 300000000000

    where mkRationalBase10 is defined in the library GHC.Real

    The moving parts are here:

    * Parsing, renaming, typechecking: use FractionalLit, in which the
      significand and exponent are represented separately.

    * Desugaring.  Remember that a fractional literal like 54.4e20 has type
         Fractional a => a

      - For fractional literals whose type turns out to be Float/Double,
        we desugar to a Float/Double literal at /compile time/.
        This conversion can still fail. But this only matters for values
        too large to be represented as float anyway.  See dsLit in
        GHC.HsToCore.Match.Literal

      - For fractional literals whose type turns out to be Rational, we
        desugar the literal to a call of `mkRationalBase10` (etc for hex
        literals), so that we only compute the Rational at /run time/.  If
        this value is then demanded at runtime the program might hang or
        run out of memory. But that is perhaps expected and acceptable.
        See dsFractionalLitToRational in GHC.HsToCore.Match.Literal

      - For fractional literals whose type isn't one of the above, we just
        call the typeclass method `fromRational`.  But to do that we need
        the rational to give to it, and we compute that at runtime, as
        above.

    * Template Haskell definitions are also problematic. While the TH code
      works as expected once it's spliced into a program it will compute the
      value of the large literal.
      But there a user should be able to work around #15646
      by having their TH code generating a call to `mkRationalBase[10/2]` for
      large literals  instead.

    -}

    -- | See Note [FractionalLit representation]
    dsFractionalLitToRational :: FractionalLit -> Type -> DsM CoreExpr
    dsFractionalLitToRational :: FractionalLit -> Type -> DsM CoreExpr
    dsFractionalLitToRational fl :: FractionalLit
    fl@FL{ fl_signi :: FractionalLit -> Rational
    fl_signi = Rational
    signi, fl_exp :: FractionalLit -> Integer
    fl_exp = Integer
    exp, fl_exp_base :: FractionalLit -> FractionalExponentBase
    fl_exp_base = FractionalExponentBase
    base } Type
    ty
      -- We compute "small" rationals here and now
      | Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    exp Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    100
      = do
        platform <- DynFlags -> Platform
    targetPlatform (DynFlags -> Platform)
    -> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    -> IOEnv (Env DsGblEnv DsLclEnv) Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let !val   = FractionalLit -> Rational
    rationalFromFractionalLit FractionalLit
    fl
            !num   = Platform -> Integer -> CoreExpr
    mkIntegerExpr Platform
    platform (Rational -> Integer
    forall a. Ratio a -> a
    numerator Rational
    val)
            !denom = Platform -> Integer -> CoreExpr
    mkIntegerExpr Platform
    platform (Rational -> Integer
    forall a. Ratio a -> a
    denominator Rational
    val)
            (ratio_data_con, integer_ty)
                = case tcSplitTyConApp ty of
                        (TyCon
    tycon, [Type
    i_ty]) -> Bool -> (DataCon, Type) -> (DataCon, Type)
    forall a. HasCallStack => Bool -> a -> a
    assert (Type -> Bool
    isIntegerTy Type
    i_ty Bool -> Bool -> Bool
    && TyCon
    tycon TyCon -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    ratioTyConKey)
                                           ([DataCon] -> DataCon
    forall a. HasCallStack => [a] -> a
    head (TyCon -> [DataCon]
    tyConDataCons TyCon
    tycon), Type
    i_ty)
                        (TyCon, [Type])
    x -> String -> SDoc -> (DataCon, Type)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "dsLit" ((TyCon, [Type]) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon, [Type])
    x)
        return $! (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])
      -- Large rationals will be computed at runtime.
      | Bool
    otherwise
      = do
          let mkRationalName :: Name
    mkRationalName = case FractionalExponentBase
    base of
                                 FractionalExponentBase
    Base2 -> Name
    mkRationalBase2Name
                                 FractionalExponentBase
    Base10 -> Name
    mkRationalBase10Name
          mkRational <- Name -> DsM Id
    dsLookupGlobalId Name
    mkRationalName
          litR <- dsRational signi
          platform <- targetPlatform <$> getDynFlags
          let litE = Platform -> Integer -> CoreExpr
    mkIntegerExpr Platform
    platform Integer
    exp
          return (mkCoreApps (Var mkRational) [litR, litE])

    dsRational :: Rational -> DsM CoreExpr
    dsRational :: Rational -> DsM CoreExpr
    dsRational (Integer
    n :% Integer
    d) = do
      platform <- DynFlags -> Platform
    targetPlatform (DynFlags -> Platform)
    -> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    -> IOEnv (Env DsGblEnv DsLclEnv) Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      dcn <- dsLookupDataCon ratioDataConName
      let cn = Platform -> Integer -> CoreExpr
    mkIntegerExpr Platform
    platform Integer
    n
      let dn = Platform -> Integer -> CoreExpr
    mkIntegerExpr Platform
    platform Integer
    d
      return $ mkCoreConApps dcn [Type integerTy, cn, dn]

    dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr
    -- ^ Post-typechecker, the 'HsExpr' field of an 'OverLit' contains
    -- (an expression for) the literal value itself.
    dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr
    dsOverLit (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 HsExpr GhcTc
    witness Type
    ty }) = do
      dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      let platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
      case shortCutLit platform val ty of
        Just HsExpr GhcTc
    expr | Bool -> Bool
    not Bool
    rebindable -> HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    expr        -- Note [Literal short cut]
        Maybe (HsExpr GhcTc)
    _                          -> HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    witness

    {-
    Note [Literal short cut]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    The type checker tries to do this short-cutting as early as possible, but
    because of unification etc, more information is available to the desugarer.
    And where it's possible to generate the correct literal right away, it's
    much better to do so.

    ************************************************************************
    *                                                                      *
                     Warnings about overflowed literals
    *                                                                      *
    ************************************************************************

    Warn about functions like toInteger, fromIntegral, that convert
    between one type and another when the to- and from- types are the
    same.  Then it's probably (albeit not definitely) the identity
    -}

    warnAboutIdentities :: DynFlags -> Id -> Type -> DsM ()
    warnAboutIdentities :: DynFlags -> Id -> Type -> DsM ()
    warnAboutIdentities DynFlags
    dflags Id
    conv_fn Type
    type_of_conv
      | WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnIdentities DynFlags
    dflags
      , Id -> Name
    idName Id
    conv_fn Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    conversionNames
      , Just (FunTyFlag
    _, Type
    _, Type
    arg_ty, Type
    res_ty) <- Type -> Maybe (FunTyFlag, Type, Type, Type)
    splitFunTy_maybe Type
    type_of_conv
      , Type
    arg_ty Type -> Type -> Bool
    `eqType` Type
    res_ty  -- So we are converting  ty -> ty
      = DsMessage -> DsM ()
    diagnosticDs (Id -> Type -> DsMessage
    DsIdentitiesFound Id
    conv_fn Type
    type_of_conv)
    warnAboutIdentities DynFlags
    _ Id
    _ Type
    _ = () -> DsM ()
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    conversionNames :: [Name]
    conversionNames :: [Name]
    conversionNames
      = [ Name
    toIntegerName, Name
    toRationalName
        , Name
    fromIntegralName, Name
    realToFracName ]
     -- We can't easily add fromIntegerName, fromRationalName,
     -- because they are generated by literals

    -- | Emit warnings on overloaded integral literals which overflow the bounds
    -- implied by their type.
    warnAboutOverflowedOverLit :: HsOverLit GhcTc -> DsM ()
    warnAboutOverflowedOverLit :: HsOverLit GhcTc -> DsM ()
    warnAboutOverflowedOverLit HsOverLit GhcTc
    hsOverLit = do
      dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      fam_envs <- dsGetFamInstEnvs
      warnAboutOverflowedLiterals dflags $
          getIntegralLit hsOverLit >>= getNormalisedTyconName fam_envs

    -- | Emit warnings on integral literals which overflow the bounds implied by
    -- their type.
    warnAboutOverflowedLit :: HsLit GhcTc -> DsM ()
    warnAboutOverflowedLit :: HsLit GhcTc -> DsM ()
    warnAboutOverflowedLit HsLit GhcTc
    hsLit = do
      dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      warnAboutOverflowedLiterals dflags $
          getSimpleIntegralLit hsLit >>= getTyconName

    -- | Emit warnings on integral literals which overflow the bounds implied by
    -- their type.
    warnAboutOverflowedLiterals
      :: DynFlags
      -> Maybe (Integer, Name)  -- ^ the literal value and name of its tycon
      -> DsM ()
    warnAboutOverflowedLiterals :: DynFlags -> Maybe (Integer, Name) -> DsM ()
    warnAboutOverflowedLiterals DynFlags
    dflags Maybe (Integer, Name)
    lit
     | WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnOverflowedLiterals DynFlags
    dflags
     , Just (Integer
    i, Name
    tc) <- Maybe (Integer, Name)
    lit
     = if
        -- These only show up via the 'HsOverLit' route
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    intTyConName        -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc Integer
    minInt         Integer
    maxInt
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    wordTyConName       -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc Integer
    minWord        Integer
    maxWord
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int8TyConName       -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int8)   (forall a. (Integral a, Bounded a) => Integer
    max' @Int8)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int16TyConName      -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int16)  (forall a. (Integral a, Bounded a) => Integer
    max' @Int16)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int32TyConName      -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int32)  (forall a. (Integral a, Bounded a) => Integer
    max' @Int32)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int64TyConName      -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int64)  (forall a. (Integral a, Bounded a) => Integer
    max' @Int64)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word8TyConName      -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word8)  (forall a. (Integral a, Bounded a) => Integer
    max' @Word8)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word16TyConName     -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word16) (forall a. (Integral a, Bounded a) => Integer
    max' @Word16)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word32TyConName     -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word32) (forall a. (Integral a, Bounded a) => Integer
    max' @Word32)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word64TyConName     -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word64) (forall a. (Integral a, Bounded a) => Integer
    max' @Word64)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    naturalTyConName    -> Integer -> Name -> DsM ()
    checkPositive Integer
    i Name
    tc

        -- These only show up via the 'HsLit' route
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    intPrimTyConName    -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc Integer
    minInt         Integer
    maxInt
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    wordPrimTyConName   -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc Integer
    minWord        Integer
    maxWord
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int8PrimTyConName   -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int8)   (forall a. (Integral a, Bounded a) => Integer
    max' @Int8)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int16PrimTyConName  -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int16)  (forall a. (Integral a, Bounded a) => Integer
    max' @Int16)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int32PrimTyConName  -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int32)  (forall a. (Integral a, Bounded a) => Integer
    max' @Int32)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    int64PrimTyConName  -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Int64)  (forall a. (Integral a, Bounded a) => Integer
    max' @Int64)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word8PrimTyConName  -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word8)  (forall a. (Integral a, Bounded a) => Integer
    max' @Word8)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word16PrimTyConName -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word16) (forall a. (Integral a, Bounded a) => Integer
    max' @Word16)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word32PrimTyConName -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word32) (forall a. (Integral a, Bounded a) => Integer
    max' @Word32)
        | Name -> Name -> Bool
    forall a. Uniquable a => a -> a -> Bool
    sameUnique Name
    tc Name
    word64PrimTyConName -> Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc (forall a. (Integral a, Bounded a) => Integer
    min' @Word64) (forall a. (Integral a, Bounded a) => Integer
    max' @Word64)

        | Bool
    otherwise -> () -> DsM ()
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      | Bool
    otherwise = () -> DsM ()
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        -- use target Int/Word sizes! See #17336
        platform :: Platform
    platform          = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
        (Integer
    minInt,Integer
    maxInt)   = (Platform -> Integer
    platformMinInt Platform
    platform, Platform -> Integer
    platformMaxInt Platform
    platform)
        (Integer
    minWord,Integer
    maxWord) = (Integer
    0,                       Platform -> Integer
    platformMaxWord Platform
    platform)

        min' :: forall a. (Integral a, Bounded a) => Integer
        min' :: forall a. (Integral a, Bounded a) => Integer
    min' = a -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a
    forall a. Bounded a => a
    minBound :: a)

        max' :: forall a. (Integral a, Bounded a) => Integer
        max' :: forall a. (Integral a, Bounded a) => Integer
    max' = a -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a
    forall a. Bounded a => a
    maxBound :: a)

        checkPositive :: Integer -> Name -> DsM ()
        checkPositive :: Integer -> Name -> DsM ()
    checkPositive Integer
    i Name
    tc
          = Bool -> DsM () -> DsM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0) (DsM () -> DsM ()) -> DsM () -> DsM ()
    forall a b. (a -> b) -> a -> b
    $
            DsMessage -> DsM ()
    diagnosticDs (Integer
    -> Name
    -> Maybe (MinBound, MaxBound)
    -> NegLiteralExtEnabled
    -> DsMessage
    DsOverflowedLiterals Integer
    i Name
    tc Maybe (MinBound, MaxBound)
    forall a. Maybe a
    Nothing (DynFlags -> NegLiteralExtEnabled
    negLiteralExtEnabled DynFlags
    dflags))

        check :: Integer -> Name -> Integer -> Integer -> DsM ()
    check Integer
    i Name
    tc Integer
    minB Integer
    maxB
          = Bool -> DsM () -> DsM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    minB Bool -> Bool -> Bool
    || Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    maxB) (DsM () -> DsM ()) -> DsM () -> DsM ()
    forall a b. (a -> b) -> a -> b
    $
            DsMessage -> DsM ()
    diagnosticDs (Integer
    -> Name
    -> Maybe (MinBound, MaxBound)
    -> NegLiteralExtEnabled
    -> DsMessage
    DsOverflowedLiterals Integer
    i Name
    tc Maybe (MinBound, MaxBound)
    bounds (DynFlags -> NegLiteralExtEnabled
    negLiteralExtEnabled DynFlags
    dflags))
          where
            bounds :: Maybe (MinBound, MaxBound)
    bounds = (MinBound, MaxBound) -> Maybe (MinBound, MaxBound)
    forall a. a -> Maybe a
    Just (Integer -> MinBound
    MinBound Integer
    minB, Integer -> MaxBound
    MaxBound Integer
    maxB)

    warnAboutEmptyEnumerations :: FamInstEnvs -> DynFlags -> LHsExpr GhcTc
                               -> Maybe (LHsExpr GhcTc)
                               -> LHsExpr GhcTc -> DsM ()
    -- ^ Warns about @[2,3 .. 1]@ or @['b' .. 'a']@ which return the empty list.
    -- For numeric literals, only works for integral types, not floating point.
    warnAboutEmptyEnumerations :: FamInstEnvs
    -> DynFlags
    -> LHsExpr GhcTc
    -> Maybe (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> DsM ()
    warnAboutEmptyEnumerations FamInstEnvs
    fam_envs DynFlags
    dflags LHsExpr GhcTc
    fromExpr Maybe (LHsExpr GhcTc)
    mThnExpr LHsExpr GhcTc
    toExpr
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnEmptyEnumerations DynFlags
    dflags
      = () -> DsM ()
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      -- Numeric Literals
      | Just from_ty :: (Integer, Type)
    from_ty@(Integer
    from',Type
    _) <- LHsExpr GhcTc -> Maybe (Integer, Type)
    getLHsIntegralLit LHsExpr GhcTc
    fromExpr
      , Just (Integer
    _, Name
    tc)           <- FamInstEnvs -> (Integer, Type) -> Maybe (Integer, Name)
    getNormalisedTyconName FamInstEnvs
    fam_envs (Integer, Type)
    from_ty
      , Just Maybe (Integer, Type)
    mThn'             <- (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> Maybe (Integer, Type))
    -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> Maybe (Maybe (Integer, Type))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse LHsExpr GhcTc -> Maybe (Integer, Type)
    GenLocated SrcSpanAnnA (HsExpr GhcTc) -> Maybe (Integer, Type)
    getLHsIntegralLit Maybe (LHsExpr GhcTc)
    Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mThnExpr
      , Just (Integer
    to',Type
    _)           <- LHsExpr GhcTc -> Maybe (Integer, Type)
    getLHsIntegralLit LHsExpr GhcTc
    toExpr
      = do
          let
            check :: forall a. (Integral a, Num a) => DsM ()
            check :: forall a. (Integral a, Num a) => DsM ()
    check = Bool -> DsM () -> DsM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Integer] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Integer]
    enumeration) DsM ()
    raiseWarning
              where
                enumeration :: [Integer]
    enumeration = case Maybe Integer
    mThn of
                  Maybe Integer
    Nothing  -> [Integer
    from      .. Integer
    to]
                  Just Integer
    thn -> [Integer
    from, Integer
    thn .. Integer
    to]
                wrap :: forall a. (Integral a, Num a) => Integer -> Integer
                wrap :: forall a. (Integral a, Num a) => Integer -> Integer
    wrap Integer
    i = a -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Integer -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i :: a)
                from :: Integer
    from = forall a. (Integral a, Num a) => Integer -> Integer
    wrap @a Integer
    from'
                to :: Integer
    to   = forall a. (Integral a, Num a) => Integer -> Integer
    wrap @a Integer
    to'
                mThn :: Maybe Integer
    mThn = ((Integer, Type) -> Integer)
    -> Maybe (Integer, Type) -> Maybe Integer
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (forall a. (Integral a, Num a) => Integer -> Integer
    wrap @a (Integer -> Integer)
    -> ((Integer, Type) -> Integer) -> (Integer, Type) -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer, Type) -> Integer
    forall a b. (a, b) -> a
    fst) Maybe (Integer, Type)
    mThn'

          platform <- DynFlags -> Platform
    targetPlatform (DynFlags -> Platform)
    -> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    -> IOEnv (Env DsGblEnv DsLclEnv) Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
             -- Be careful to use target Int/Word sizes! cf #17336
          if | sameUnique tc intTyConName     -> case platformWordSize platform of
                                                   PlatformWordSize
    PW4 -> forall a. (Integral a, Num a) => DsM ()
    check @Int32
                                                   PlatformWordSize
    PW8 -> forall a. (Integral a, Num a) => DsM ()
    check @Int64
             | sameUnique tc wordTyConName    -> case platformWordSize platform of
                                                   PlatformWordSize
    PW4 -> forall a. (Integral a, Num a) => DsM ()
    check @Word32
                                                   PlatformWordSize
    PW8 -> forall a. (Integral a, Num a) => DsM ()
    check @Word64
             | sameUnique tc int8TyConName    -> check @Int8
             | sameUnique tc int16TyConName   -> check @Int16
             | sameUnique tc int32TyConName   -> check @Int32
             | sameUnique tc int64TyConName   -> check @Int64
             | sameUnique tc word8TyConName   -> check @Word8
             | sameUnique tc word16TyConName  -> check @Word16
             | sameUnique tc word32TyConName  -> check @Word32
             | sameUnique tc word64TyConName  -> check @Word64
             | sameUnique tc integerTyConName -> check @Integer
             | sameUnique tc naturalTyConName -> check @Integer
                -- We use 'Integer' because otherwise a negative 'Natural' literal
                -- could cause a compile time crash (instead of a runtime one).
                -- See the T10930b test case for an example of where this matters.
             | otherwise -> return ()

      -- Char literals (#18402)
      | Just Char
    fromChar <- LHsExpr GhcTc -> Maybe Char
    getLHsCharLit LHsExpr GhcTc
    fromExpr
      , Just Maybe Char
    mThnChar <- (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> Maybe Char)
    -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> Maybe (Maybe Char)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse LHsExpr GhcTc -> Maybe Char
    GenLocated SrcSpanAnnA (HsExpr GhcTc) -> Maybe Char
    getLHsCharLit Maybe (LHsExpr GhcTc)
    Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mThnExpr
      , Just Char
    toChar   <- LHsExpr GhcTc -> Maybe Char
    getLHsCharLit LHsExpr GhcTc
    toExpr
      , let enumeration :: String
    enumeration = case Maybe Char
    mThnChar of
                            Maybe Char
    Nothing      -> [Char
    fromChar          .. Char
    toChar]
                            Just Char
    thnChar -> [Char
    fromChar, Char
    thnChar .. Char
    toChar]
      = Bool -> DsM () -> DsM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    enumeration) DsM ()
    raiseWarning

      | Bool
    otherwise = () -> DsM ()
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        raiseWarning :: DsM ()
    raiseWarning =
          DsMessage -> DsM ()
    diagnosticDs DsMessage
    DsEmptyEnumeration

    getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Type)
    -- ^ See if the expression is an 'Integral' literal.
    getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Type)
    getLHsIntegralLit (L SrcSpanAnnA
    _ HsExpr GhcTc
    e) = HsExpr GhcTc -> Maybe (Integer, Type)
    go HsExpr GhcTc
    e
      where
        go :: HsExpr GhcTc -> Maybe (Integer, Type)
    go (HsPar XPar GhcTc
    _ LHsExpr GhcTc
    e)            = LHsExpr GhcTc -> Maybe (Integer, Type)
    getLHsIntegralLit LHsExpr GhcTc
    e
        go (HsOverLit XOverLitE GhcTc
    _ HsOverLit GhcTc
    over_lit) = HsOverLit GhcTc -> Maybe (Integer, Type)
    getIntegralLit HsOverLit GhcTc
    over_lit
        go (HsLit XLitE GhcTc
    _ HsLit GhcTc
    lit)          = HsLit GhcTc -> Maybe (Integer, Type)
    getSimpleIntegralLit HsLit GhcTc
    lit

        -- Remember to look through automatically-added tick-boxes! (#8384)
        go (XExpr (HsTick CoreTickish
    _ LHsExpr GhcTc
    e))       = LHsExpr GhcTc -> Maybe (Integer, Type)
    getLHsIntegralLit LHsExpr GhcTc
    e
        go (XExpr (HsBinTick Int
    _ Int
    _ LHsExpr GhcTc
    e))  = LHsExpr GhcTc -> Maybe (Integer, Type)
    getLHsIntegralLit LHsExpr GhcTc
    e

        -- The literal might be wrapped in a case with -XOverloadedLists
        go (XExpr (WrapExpr (HsWrap HsWrapper
    _ HsExpr GhcTc
    e))) = HsExpr GhcTc -> Maybe (Integer, Type)
    go HsExpr GhcTc
    e
        go HsExpr GhcTc
    _ = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing

    -- | If 'Integral', extract the value and type of the overloaded literal.
    -- See Note [Literals and the OverloadedLists extension]
    getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Type)
    getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Type)
    getIntegralLit (OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
    ol_val = HsIntegral IntegralLit
    i, ol_ext :: forall p. HsOverLit p -> XOverLit p
    ol_ext = OverLitTc { ol_type :: OverLitTc -> Type
    ol_type = Type
    ty } })
      = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (IntegralLit -> Integer
    il_value IntegralLit
    i, Type
    ty)
    getIntegralLit HsOverLit GhcTc
    _ = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing

    -- | If 'Integral', extract the value and type of the non-overloaded literal.
    getSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Type)
    getSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Type)
    getSimpleIntegralLit (HsInt XHsInt GhcTc
    _ IL{ il_value :: IntegralLit -> Integer
    il_value = Integer
    i }) = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    intTy)
    getSimpleIntegralLit (HsIntPrim XHsIntPrim GhcTc
    _ Integer
    i)    = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    intPrimTy)
    getSimpleIntegralLit (HsWordPrim XHsWordPrim GhcTc
    _ Integer
    i)   = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    wordPrimTy)
    getSimpleIntegralLit (HsInt8Prim XHsInt8Prim GhcTc
    _ Integer
    i)   = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    int8PrimTy)
    getSimpleIntegralLit (HsInt16Prim XHsInt16Prim GhcTc
    _ Integer
    i)  = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    int16PrimTy)
    getSimpleIntegralLit (HsInt32Prim XHsInt32Prim GhcTc
    _ Integer
    i)  = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    int32PrimTy)
    getSimpleIntegralLit (HsInt64Prim XHsInt64Prim GhcTc
    _ Integer
    i)  = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    int64PrimTy)
    getSimpleIntegralLit (HsWord8Prim XHsWord8Prim GhcTc
    _ Integer
    i)  = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    word8PrimTy)
    getSimpleIntegralLit (HsWord16Prim XHsWord16Prim GhcTc
    _ Integer
    i) = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    word16PrimTy)
    getSimpleIntegralLit (HsWord32Prim XHsWord32Prim GhcTc
    _ Integer
    i) = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    word32PrimTy)
    getSimpleIntegralLit (HsWord64Prim XHsWord64Prim GhcTc
    _ Integer
    i) = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    word64PrimTy)
    getSimpleIntegralLit (HsInteger XHsInteger GhcTc
    _ Integer
    i Type
    ty) = (Integer, Type) -> Maybe (Integer, Type)
    forall a. a -> Maybe a
    Just (Integer
    i, Type
    ty)

    getSimpleIntegralLit HsChar{}           = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing
    getSimpleIntegralLit HsCharPrim{}       = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing
    getSimpleIntegralLit HsString{}         = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing
    getSimpleIntegralLit HsStringPrim{}     = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing
    getSimpleIntegralLit HsRat{}            = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing
    getSimpleIntegralLit HsFloatPrim{}      = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing
    getSimpleIntegralLit HsDoublePrim{}     = Maybe (Integer, Type)
    forall a. Maybe a
    Nothing

    -- | Extract the Char if the expression is a Char literal.
    getLHsCharLit :: LHsExpr GhcTc -> Maybe Char
    getLHsCharLit :: LHsExpr GhcTc -> Maybe Char
    getLHsCharLit (L SrcSpanAnnA
    _ (HsPar XPar GhcTc
    _ LHsExpr GhcTc
    e))            = LHsExpr GhcTc -> Maybe Char
    getLHsCharLit LHsExpr GhcTc
    e
    getLHsCharLit (L SrcSpanAnnA
    _ (HsLit XLitE GhcTc
    _ (HsChar XHsChar GhcTc
    _ Char
    c))) = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    c
    getLHsCharLit (L SrcSpanAnnA
    _ (XExpr (HsTick CoreTickish
    _ LHsExpr GhcTc
    e)))         = LHsExpr GhcTc -> Maybe Char
    getLHsCharLit LHsExpr GhcTc
    e
    getLHsCharLit (L SrcSpanAnnA
    _ (XExpr (HsBinTick Int
    _ Int
    _ LHsExpr GhcTc
    e)))    = LHsExpr GhcTc -> Maybe Char
    getLHsCharLit LHsExpr GhcTc
    e
    getLHsCharLit LHsExpr GhcTc
    _ = Maybe Char
    forall a. Maybe a
    Nothing

    -- | Convert a pair (Integer, Type) to (Integer, Name) after eventually
    -- normalising the type
    getNormalisedTyconName :: FamInstEnvs -> (Integer, Type) -> Maybe (Integer, Name)
    getNormalisedTyconName :: FamInstEnvs -> (Integer, Type) -> Maybe (Integer, Name)
    getNormalisedTyconName FamInstEnvs
    fam_envs (Integer
    i,Type
    ty)
        | Just TyCon
    tc <- Type -> Maybe TyCon
    tyConAppTyCon_maybe (FamInstEnvs -> Type -> Type
    normaliseNominal FamInstEnvs
    fam_envs Type
    ty)
        = (Integer, Name) -> Maybe (Integer, Name)
    forall a. a -> Maybe a
    Just (Integer
    i, TyCon -> Name
    tyConName TyCon
    tc)
        | Bool
    otherwise = Maybe (Integer, Name)
    forall a. Maybe a
    Nothing
      where
        normaliseNominal :: FamInstEnvs -> Type -> Type
        normaliseNominal :: FamInstEnvs -> Type -> Type
    normaliseNominal FamInstEnvs
    fam_envs Type
    ty
          = Reduction -> Type
    reductionReducedType
          (Reduction -> Type) -> Reduction -> Type
    forall a b. (a -> b) -> a -> b
    $ FamInstEnvs -> Role -> Type -> Reduction
    normaliseType FamInstEnvs
    fam_envs Role
    Nominal Type
    ty

    -- | Convert a pair (Integer, Type) to (Integer, Name) without normalising
    -- the type
    getTyconName :: (Integer, Type) -> Maybe (Integer, Name)
    getTyconName :: (Integer, Type) -> Maybe (Integer, Name)
    getTyconName (Integer
    i,Type
    ty)
      | Just TyCon
    tc <- Type -> Maybe TyCon
    tyConAppTyCon_maybe Type
    ty = (Integer, Name) -> Maybe (Integer, Name)
    forall a. a -> Maybe a
    Just (Integer
    i, TyCon -> Name
    tyConName TyCon
    tc)
      | Bool
    otherwise = Maybe (Integer, Name)
    forall a. Maybe a
    Nothing

    {-
    Note [Literals and the OverloadedLists extension]
    ~~~~
    Consider the Literal `[256] :: [Data.Word.Word8]`

    When the `OverloadedLists` extension is not active, then the `ol_ext` field
    in the `OverLitTc` record that is passed to the function `getIntegralLit`
    contains the type `Word8`. This is a simple type, and we can use its
    type constructor immediately for the `warnAboutOverflowedLiterals` function.

    When the `OverloadedLists` extension is active, then the `ol_ext` field
    contains the type family `Item [Word8]`. The function `nomaliseType` is used
    to convert it to the needed type `Word8`.
    -}

    {-
    ************************************************************************
    *                                                                      *
            Tidying lit pats
    *                                                                      *
    ************************************************************************
    -}

    tidyLitPat :: HsLit GhcTc -> Pat GhcTc
    -- Result has only the following HsLits:
    --      HsIntPrim, HsWordPrim, HsCharPrim, HsString
    --  * HsInteger, HsRat, HsInt, as well as HsStringPrim,
    --    HsFloatPrim and HsDoublePrim can't show up in LitPats
    --  * We get rid of HsChar right here
    tidyLitPat :: HsLit GhcTc -> Pat GhcTc
    tidyLitPat (HsChar XHsChar GhcTc
    src Char
    c) = GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc (SourceText -> Char -> LPat GhcTc
    mkCharLitPat XHsChar GhcTc
    SourceText
    src Char
    c)
    tidyLitPat (HsString XHsString GhcTc
    src FastString
    s)
      | FastString -> Int
    lengthFS FastString
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1     -- Short string literals only
      = GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc)
    -> GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall a b. (a -> b) -> a -> b
    $ (Char
     -> GenLocated SrcSpanAnnA (Pat GhcTc)
     -> GenLocated SrcSpanAnnA (Pat GhcTc))
    -> GenLocated SrcSpanAnnA (Pat GhcTc)
    -> String
    -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Char
    c GenLocated SrcSpanAnnA (Pat GhcTc)
    pat -> DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
    mkPrefixConPat DataCon
    consDataCon
                                                 [SourceText -> Char -> LPat GhcTc
    mkCharLitPat XHsString GhcTc
    SourceText
    src Char
    c, LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    pat] [Type
    charTy])
                      (Type -> LPat GhcTc
    mkNilPat Type
    charTy) (FastString -> String
    unpackFS FastString
    s)
            -- The stringTy is the type of the whole pattern, not
            -- the type to instantiate (:) or [] with!
    tidyLitPat HsLit GhcTc
    lit = XLitPat GhcTc -> HsLit GhcTc -> Pat GhcTc
    forall p. XLitPat p -> HsLit p -> Pat p
    LitPat XLitPat GhcTc
    NoExtField
    noExtField HsLit GhcTc
    lit

    ----------------
    tidyNPat :: HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc
             -> Type
             -> Pat GhcTc
    tidyNPat :: HsOverLit GhcTc
    -> Maybe (SyntaxExpr GhcTc)
    -> SyntaxExpr GhcTc
    -> Type
    -> Pat GhcTc
    tidyNPat (OverLit (OverLitTc Bool
    False HsExpr GhcTc
    _ Type
    ty) OverLitVal
    val) Maybe (SyntaxExpr GhcTc)
    mb_neg SyntaxExpr GhcTc
    _eq Type
    outer_ty
            -- False: Take short cuts only if the literal is not using rebindable syntax
            --
            -- Once that is settled, look for cases where the type of the
            -- entire overloaded literal matches the type of the underlying literal,
            -- and in that case take the short cut
            -- NB: Watch out for weird cases like #3382
            --        f :: Int -> Int
            --        f "blah" = 4
            --     which might be ok if we have 'instance IsString Int'
            --
      | Bool -> Bool
    not Bool
    type_change, Type -> Bool
    isIntTy Type
    ty,    Just Integer
    int_lit <- Maybe Integer
    mb_int_lit
                     = DataCon -> HsLit GhcTc -> Pat GhcTc
    mk_con_pat DataCon
    intDataCon    (XHsIntPrim GhcTc -> Integer -> HsLit GhcTc
    forall x. XHsIntPrim x -> Integer -> HsLit x
    HsIntPrim    XHsIntPrim GhcTc
    SourceText
    NoSourceText Integer
    int_lit)
      | Bool -> Bool
    not Bool
    type_change, Type -> Bool
    isWordTy Type
    ty,   Just Integer
    int_lit <- Maybe Integer
    mb_int_lit
                     = DataCon -> HsLit GhcTc -> Pat GhcTc
    mk_con_pat DataCon
    wordDataCon   (XHsWordPrim GhcTc -> Integer -> HsLit GhcTc
    forall x. XHsWordPrim x -> Integer -> HsLit x
    HsWordPrim   XHsWordPrim GhcTc
    SourceText
    NoSourceText Integer
    int_lit)
      | Bool -> Bool
    not Bool
    type_change, Type -> Bool
    isStringTy Type
    ty, Just FastString
    str_lit <- Maybe FastString
    mb_str_lit
                     = HsLit GhcTc -> Pat GhcTc
    tidyLitPat (XHsString GhcTc -> FastString -> HsLit GhcTc
    forall x. XHsString x -> FastString -> HsLit x
    HsString XHsString GhcTc
    SourceText
    NoSourceText FastString
    str_lit)
         -- NB: do /not/ convert Float or Double literals to F# 3.8 or D# 5.3
         -- If we do convert to the constructor form, we'll generate a case
         -- expression on a Float# or Double# and that's not allowed in Core; see
         -- #9238 and Note [Rules for floating-point comparisons] in GHC.Core.Opt.ConstantFold
      where
        -- Sometimes (like in test case
        -- overloadedlists/should_run/overloadedlistsrun04), the SyntaxExprs include
        -- type-changing wrappers (for example, from Id Int to Int, for the identity
        -- type family Id). In these cases, we can't do the short-cut.
        type_change :: Bool
    type_change = Bool -> Bool
    not (Type
    outer_ty Type -> Type -> Bool
    `eqType` Type
    ty)

        mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc
        mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc
    mk_con_pat DataCon
    con HsLit GhcTc
    lit
          = GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc (DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
    mkPrefixConPat DataCon
    con [Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc))
    -> Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XLitPat GhcTc -> HsLit GhcTc -> Pat GhcTc
    forall p. XLitPat p -> HsLit p -> Pat p
    LitPat XLitPat GhcTc
    NoExtField
    noExtField HsLit GhcTc
    lit] [])

        mb_int_lit :: Maybe Integer
        mb_int_lit :: Maybe Integer
    mb_int_lit = case (Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    mb_neg, OverLitVal
    val) of
                       (Maybe SyntaxExprTc
    Nothing, HsIntegral IntegralLit
    i) -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (IntegralLit -> Integer
    il_value IntegralLit
    i)
                       (Just SyntaxExprTc
    _,  HsIntegral IntegralLit
    i) -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (-(IntegralLit -> Integer
    il_value IntegralLit
    i))
                       (Maybe SyntaxExprTc, OverLitVal)
    _ -> Maybe Integer
    forall a. Maybe a
    Nothing

        mb_str_lit :: Maybe FastString
        mb_str_lit :: Maybe FastString
    mb_str_lit = case (Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    mb_neg, OverLitVal
    val) of
                       (Maybe SyntaxExprTc
    Nothing, HsIsString SourceText
    _ FastString
    s) -> FastString -> Maybe FastString
    forall a. a -> Maybe a
    Just FastString
    s
                       (Maybe SyntaxExprTc, OverLitVal)
    _ -> Maybe FastString
    forall a. Maybe a
    Nothing

    tidyNPat HsOverLit GhcTc
    over_lit Maybe (SyntaxExpr GhcTc)
    mb_neg SyntaxExpr GhcTc
    eq Type
    outer_ty
      = XNPat GhcTc
    -> XRec GhcTc (HsOverLit GhcTc)
    -> Maybe (SyntaxExpr GhcTc)
    -> SyntaxExpr GhcTc
    -> Pat GhcTc
    forall p.
    XNPat p
    -> XRec p (HsOverLit p)
    -> Maybe (SyntaxExpr p)
    -> SyntaxExpr p
    -> Pat p
    NPat XNPat GhcTc
    Type
    outer_ty (HsOverLit GhcTc -> GenLocated EpAnnCO (HsOverLit GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA HsOverLit GhcTc
    over_lit) Maybe (SyntaxExpr GhcTc)
    mb_neg SyntaxExpr GhcTc
    eq

    {-
    ************************************************************************
    *                                                                      *
                    Pattern matching on LitPat
    *                                                                      *
    ************************************************************************
    -}

    matchLiterals :: NonEmpty Id
                  -> Type -- ^ Type of the whole case expression
                  -> NonEmpty (NonEmpty EquationInfoNE) -- ^ All PgLits
                  -> DsM (MatchResult CoreExpr)

    matchLiterals :: NonEmpty Id
    -> Type
    -> NonEmpty (NonEmpty EquationInfoNE)
    -> DsM (MatchResult CoreExpr)
    matchLiterals (Id
    var :| [Id]
    vars) Type
    ty NonEmpty (NonEmpty EquationInfoNE)
    sub_groups
      = do  {       -- Deal with each group
            ; alts <- (NonEmpty EquationInfoNE
     -> IOEnv (Env DsGblEnv DsLclEnv) (Literal, MatchResult CoreExpr))
    -> NonEmpty (NonEmpty EquationInfoNE)
    -> IOEnv
         (Env DsGblEnv DsLclEnv) (NonEmpty (Literal, MatchResult CoreExpr))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonEmpty a -> m (NonEmpty b)
    mapM NonEmpty EquationInfoNE
    -> IOEnv (Env DsGblEnv DsLclEnv) (Literal, MatchResult CoreExpr)
    match_group NonEmpty (NonEmpty EquationInfoNE)
    sub_groups

                    -- Combine results.  For everything except String
                    -- we can use a case expression; for String we need
                    -- a chain of if-then-else
            ; if isStringTy (idType var) then
                do  { eq_str <- dsLookupGlobalId eqStringName
                    ; mrs <- mapM (wrap_str_guard eq_str) alts
                    ; return (foldr1 combineMatchResults mrs) }
              else
                return (mkCoPrimCaseMatchResult var ty $ NEL.toList alts)
            }
      where
        match_group :: NonEmpty EquationInfoNE -> DsM (Literal, MatchResult CoreExpr)
        match_group :: NonEmpty EquationInfoNE
    -> IOEnv (Env DsGblEnv DsLclEnv) (Literal, MatchResult CoreExpr)
    match_group NonEmpty EquationInfoNE
    eqns
            = do { dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                 ; let platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
                 ; let EqnMatch { eqn_pat = L _ (LitPat _ hs_lit) } = NEL.head eqns
                 ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns)
                 ; return (hsLitKey platform hs_lit, match_result) }

        wrap_str_guard :: Id -> (Literal,MatchResult CoreExpr) -> DsM (MatchResult CoreExpr)
            -- Equality check for string literals
        wrap_str_guard :: Id -> (Literal, MatchResult CoreExpr) -> DsM (MatchResult CoreExpr)
    wrap_str_guard Id
    eq_str (LitString ByteString
    s, MatchResult CoreExpr
    mr)
            = do { -- We now have to convert back to FastString. Perhaps there
                   -- should be separate LitBytes and LitString constructors?
                   let s' :: FastString
    s'  = ByteString -> FastString
    mkFastStringByteString ByteString
    s
                 ; lit    <- FastString -> DsM CoreExpr
    forall (m :: * -> *). MonadThings m => FastString -> m CoreExpr
    mkStringExprFS FastString
    s'
                 ; let pred = CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    eq_str) [Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    var, CoreExpr
    lit]
                 ; return (mkGuardedMatchResult pred mr) }
        wrap_str_guard Id
    _ (Literal
    l, MatchResult CoreExpr
    _) = String -> SDoc -> DsM (MatchResult CoreExpr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "matchLiterals/wrap_str_guard" (Literal -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Literal
    l)

    ---------------------------
    hsLitKey :: Platform -> HsLit GhcTc -> Literal
    -- Get the Core literal corresponding to a HsLit.
    -- It only works for primitive types and strings;
    -- others have been removed by tidy
    -- For HsString, it produces a LitString, which really represents an _unboxed_
    -- string literal; and we deal with it in matchLiterals above. Otherwise, it
    -- produces a primitive Literal of type matching the original HsLit.
    -- In the case of the fixed-width numeric types, we need to wrap here
    -- because Literal has an invariant that the literal is in range, while
    -- HsLit does not.
    hsLitKey :: Platform -> HsLit GhcTc -> Literal
    hsLitKey Platform
    platform (HsIntPrim    XHsIntPrim GhcTc
    _ Integer
    i)  = Platform -> Integer -> Literal
    mkLitIntWrap  Platform
    platform Integer
    i
    hsLitKey Platform
    platform (HsWordPrim   XHsWordPrim GhcTc
    _ Integer
    w)  = Platform -> Integer -> Literal
    mkLitWordWrap Platform
    platform Integer
    w
    hsLitKey Platform
    _        (HsInt8Prim   XHsInt8Prim GhcTc
    _ Integer
    i)  = Integer -> Literal
    mkLitInt8Wrap   Integer
    i
    hsLitKey Platform
    _        (HsInt16Prim  XHsInt16Prim GhcTc
    _ Integer
    i)  = Integer -> Literal
    mkLitInt16Wrap  Integer
    i
    hsLitKey Platform
    _        (HsInt32Prim  XHsInt32Prim GhcTc
    _ Integer
    i)  = Integer -> Literal
    mkLitInt32Wrap  Integer
    i
    hsLitKey Platform
    _        (HsInt64Prim  XHsInt64Prim GhcTc
    _ Integer
    i)  = Integer -> Literal
    mkLitInt64Wrap  Integer
    i
    hsLitKey Platform
    _        (HsWord8Prim  XHsWord8Prim GhcTc
    _ Integer
    w)  = Integer -> Literal
    mkLitWord8Wrap  Integer
    w
    hsLitKey Platform
    _        (HsWord16Prim XHsWord16Prim GhcTc
    _ Integer
    w)  = Integer -> Literal
    mkLitWord16Wrap Integer
    w
    hsLitKey Platform
    _        (HsWord32Prim XHsWord32Prim GhcTc
    _ Integer
    w)  = Integer -> Literal
    mkLitWord32Wrap Integer
    w
    hsLitKey Platform
    _        (HsWord64Prim XHsWord64Prim GhcTc
    _ Integer
    w)  = Integer -> Literal
    mkLitWord64Wrap Integer
    w
    hsLitKey Platform
    _        (HsCharPrim   XHsCharPrim GhcTc
    _ Char
    c)  = Char -> Literal
    mkLitChar            Char
    c
    -- This following two can be slow. See Note [FractionalLit representation]
    hsLitKey Platform
    _        (HsFloatPrim  XHsFloatPrim GhcTc
    _ FractionalLit
    fl) = Rational -> Literal
    mkLitFloat (FractionalLit -> Rational
    rationalFromFractionalLit FractionalLit
    fl)
    hsLitKey Platform
    _        (HsDoublePrim XHsDoublePrim GhcTc
    _ FractionalLit
    fl) = Rational -> Literal
    mkLitDouble (FractionalLit -> Rational
    rationalFromFractionalLit FractionalLit
    fl)

    hsLitKey Platform
    _        (HsString XHsString GhcTc
    _ FastString
    s)      = ByteString -> Literal
    LitString (FastString -> ByteString
    bytesFS FastString
    s)
    hsLitKey Platform
    _        HsLit GhcTc
    l                   = String -> SDoc -> Literal
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "hsLitKey" (HsLit GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsLit GhcTc
    l)

    {-
    ************************************************************************
    *                                                                      *
                    Pattern matching on NPat
    *                                                                      *
    ************************************************************************
    -}

    matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr)
    matchNPats :: NonEmpty Id
    -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr)
    matchNPats (Id
    var :| [Id]
    vars) Type
    ty (EquationInfoNE
    eqn1 :| [EquationInfoNE]
    eqns)    -- All for the same literal
      = do  { let NPat XNPat GhcTc
    _ (L EpAnnCO
    _ HsOverLit GhcTc
    lit) Maybe (SyntaxExpr GhcTc)
    mb_neg SyntaxExpr GhcTc
    eq_chk = EquationInfoNE -> Pat GhcTc
    firstPat EquationInfoNE
    eqn1
            ; lit_expr <- HsOverLit GhcTc -> DsM CoreExpr
    dsOverLit HsOverLit GhcTc
    lit
            ; neg_lit <- case mb_neg of
                                Maybe (SyntaxExpr GhcTc)
    Nothing  -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    lit_expr
                                Just SyntaxExpr GhcTc
    neg -> SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    neg [CoreExpr
    lit_expr]
            ; pred_expr <- dsSyntaxExpr eq_chk [Var var, neg_lit]
            ; match_result <- match vars ty (shiftEqns (eqn1:eqns))
            ; return (mkGuardedMatchResult pred_expr match_result) }

    {-
    ************************************************************************
    *                                                                      *
                    Pattern matching on n+k patterns
    *                                                                      *
    ************************************************************************

    For an n+k pattern, we use the various magic expressions we've been given.
    We generate:
    \begin{verbatim}
        if ge var lit then
            let n = sub var lit
            in  <expr-for-a-successful-match>
        else
            <try-next-pattern-or-whatever>
    \end{verbatim}
    -}

    matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr)
    -- All NPlusKPats, for the *same* literal k
    matchNPlusKPats :: NonEmpty Id
    -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr)
    matchNPlusKPats (Id
    var :| [Id]
    vars) Type
    ty (EquationInfoNE
    eqn1 :| [EquationInfoNE]
    eqns)
      = do  { let NPlusKPat XNPlusKPat GhcTc
    _ (L SrcSpanAnnN
    _ Id
    n1) (L EpAnnCO
    _ HsOverLit GhcTc
    lit1) HsOverLit GhcTc
    lit2 SyntaxExpr GhcTc
    ge SyntaxExpr GhcTc
    minus
                    = EquationInfoNE -> Pat GhcTc
    firstPat EquationInfoNE
    eqn1
            ; lit1_expr   <- HsOverLit GhcTc -> DsM CoreExpr
    dsOverLit HsOverLit GhcTc
    lit1
            ; lit2_expr   <- dsOverLit lit2
            ; pred_expr   <- dsSyntaxExpr ge    [Var var, lit1_expr]
            ; minusk_expr <- dsSyntaxExpr minus [Var var, lit2_expr]
            ; let (wraps, eqns') = mapAndUnzip (shift n1) (eqn1:eqns)
            ; match_result <- match vars ty eqns'
            ; return  (mkGuardedMatchResult pred_expr               $
                       mkCoLetMatchResult (NonRec n1 minusk_expr)   $
                       fmap (foldr1 (.) wraps)                      $
                       match_result) }
      where
        shift :: Id -> EquationInfoNE -> (CoreExpr -> CoreExpr, EquationInfoNE)
    shift Id
    n1 (EqnMatch { eqn_pat :: EquationInfoNE -> LPat GhcTc
    eqn_pat = L SrcSpanAnnA
    _ (NPlusKPat XNPlusKPat GhcTc
    _ (L SrcSpanAnnN
    _ Id
    n) XRec GhcTc (HsOverLit GhcTc)
    _ HsOverLit GhcTc
    _ SyntaxExpr GhcTc
    _ SyntaxExpr GhcTc
    _), eqn_rest :: EquationInfoNE -> EquationInfoNE
    eqn_rest = EquationInfoNE
    rest })
            = (Id -> Id -> CoreExpr -> CoreExpr
    wrapBind Id
    n Id
    n1, EquationInfoNE
    rest)
            -- The wrapBind is a no-op for the first equation
        shift Id
    _ EquationInfoNE
    e = String -> SDoc -> (CoreExpr -> CoreExpr, EquationInfoNE)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "matchNPlusKPats/shift" (EquationInfoNE -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EquationInfoNE
    e)