{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                      -- in module Language.Haskell.Syntax.Extension

{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable

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

\section[PatSyntax]{Abstract Haskell syntax---patterns}
-}

module GHC.Hs.Pat (
        Pat(..), LPat,
        isInvisArgPat, isVisArgPat,
        EpAnnSumPat(..),
        ConPatTc (..),
        ConLikeP,
        HsPatExpansion(..),
        XXPatGhcTc(..),

        HsConPatDetails, hsConPatArgs, hsConPatTyArgs,
        HsConPatTyArg(..),
        HsRecFields(..), HsFieldBind(..), LHsFieldBind,
        HsRecField, LHsRecField,
        HsRecUpdField, LHsRecUpdField,
        RecFieldsDotDot(..),
        hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,

        mkPrefixConPat, mkCharLitPat, mkNilPat,

        isSimplePat, isPatSyn,
        looksLazyPatBind,
        isBangedLPat,
        gParPat, patNeedsParens, parenthesizePat,
        isIrrefutableHsPat,

        isBoringHsPat,

        collectEvVarsPat, collectEvVarsPats,

        pprParendLPat, pprConArgs,
        pprLPat
    ) where

import GHC.Prelude

import Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Expr ( HsExpr )

import {-# SOURCE #-} GHC.Hs.Expr (pprLExpr, pprUntypedSplice, HsUntypedSpliceResult(..))

-- friends:
import GHC.Hs.Binds
import GHC.Hs.Lit
import Language.Haskell.Syntax.Extension
import GHC.Parser.Annotation
import GHC.Hs.Extension
import GHC.Hs.Type
import GHC.Tc.Types.Evidence
import GHC.Types.Basic
import GHC.Types.SourceText
-- others:
import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
import GHC.Builtin.Types
import GHC.Types.Var
import GHC.Types.Name.Reader
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Utils.Outputable
import GHC.Core.Type
import GHC.Types.SrcLoc
import GHC.Data.Bag -- collect ev vars from pats
import GHC.Types.Name
import Data.Data

import qualified Data.List.NonEmpty as NE

type instance XWildPat GhcPs = NoExtField
type instance XWildPat GhcRn = NoExtField
type instance XWildPat GhcTc = Type

type instance XVarPat  (GhcPass _) = NoExtField

type instance XLazyPat GhcPs = EpToken "~"
type instance XLazyPat GhcRn = NoExtField
type instance XLazyPat GhcTc = NoExtField

type instance XAsPat   GhcPs = EpToken "@"
type instance XAsPat   GhcRn = NoExtField
type instance XAsPat   GhcTc = NoExtField

type instance XParPat  GhcPs = (EpToken "(", EpToken ")")
type instance XParPat  GhcRn = NoExtField
type instance XParPat  GhcTc = NoExtField

type instance XBangPat GhcPs = EpToken "!"
type instance XBangPat GhcRn = NoExtField
type instance XBangPat GhcTc = NoExtField

type instance XListPat GhcPs = AnnList ()
  -- After parsing, ListPat can refer to a built-in Haskell list pattern
  -- or an overloaded list pattern.
type instance XListPat GhcRn = NoExtField
  -- Built-in list patterns only.
  -- After renaming, overloaded list patterns are expanded to view patterns.
  -- See Note [Desugaring overloaded list patterns]
type instance XListPat GhcTc = Type
  -- List element type, for use in hsPatType.

type instance XTuplePat GhcPs = (EpaLocation, EpaLocation)
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]

type instance XOrPat GhcPs = NoExtField
type instance XOrPat GhcRn = NoExtField
type instance XOrPat GhcTc = Type

type instance XSumPat GhcPs = EpAnnSumPat
type instance XSumPat GhcRn = NoExtField
type instance XSumPat GhcTc = [Type]

type instance XConPat GhcPs = (Maybe (EpToken "{"), Maybe (EpToken "}"))
type instance XConPat GhcRn = NoExtField
type instance XConPat GhcTc = ConPatTc

type instance XViewPat GhcPs = TokRarrow
type instance XViewPat GhcRn = Maybe (HsExpr GhcRn)
  -- The @HsExpr GhcRn@ gives an inverse to the view function.
  -- This is used for overloaded lists in particular.
  -- See Note [Invertible view patterns] in GHC.Tc.TyCl.PatSyn.

type instance XViewPat GhcTc = Type
  -- Overall type of the pattern
  -- (= the argument type of the view function), for hsPatType.

type instance XSplicePat GhcPs = NoExtField
type instance XSplicePat GhcRn = HsUntypedSpliceResult (Pat GhcRn) -- See Note [Lifecycle of a splice] in GHC.Hs.Expr
type instance XSplicePat GhcTc = DataConCantHappen

type instance XLitPat    (GhcPass _) = NoExtField

type instance XNPat GhcPs = EpToken "-"
type instance XNPat GhcRn = EpToken "-"
type instance XNPat GhcTc = Type

type instance XNPlusKPat GhcPs = EpToken "+"
type instance XNPlusKPat GhcRn = NoExtField
type instance XNPlusKPat GhcTc = Type

type instance XSigPat GhcPs = TokDcolon
type instance XSigPat GhcRn = NoExtField
type instance XSigPat GhcTc = Type

type instance XEmbTyPat GhcPs = EpToken "type"
type instance XEmbTyPat GhcRn = NoExtField
type instance XEmbTyPat GhcTc = Type

type instance XXPat GhcPs = DataConCantHappen
type instance XXPat GhcRn = HsPatExpansion (Pat GhcRn) (Pat GhcRn)
  -- Original pattern and its desugaring/expansion.
  -- See Note [Rebindable syntax and XXExprGhcRn].
type instance XXPat GhcTc = XXPatGhcTc
  -- After typechecking, we add extra constructors: CoPat and XXExprGhcRn.
  -- XXExprGhcRn allows us to handle RebindableSyntax in pattern position:
  -- see "XXExpr GhcTc" for the counterpart in expressions.

type instance ConLikeP GhcPs = RdrName -- IdP GhcPs
type instance ConLikeP GhcRn = Name    -- IdP GhcRn
type instance ConLikeP GhcTc = ConLike

type instance XConPatTyArg GhcPs = EpToken "@"
type instance XConPatTyArg GhcRn = NoExtField
type instance XConPatTyArg GhcTc = NoExtField

type instance XHsRecFields GhcPs = NoExtField
type instance XHsRecFields GhcRn = NoExtField
type instance XHsRecFields GhcTc = MultiplicityCheckCoercions

type instance XHsFieldBind _ = Maybe (EpToken "=")

-- The specificity of an invisible pattern from the parser is always
-- SpecifiedSpec. The specificity field supports code generated when deriving
-- newtype or via; see Note [Inferred invisible patterns].
type instance XInvisPat GhcPs = (EpToken "@", Specificity)
type instance XInvisPat GhcRn = Specificity
type instance XInvisPat GhcTc = Type


{- Note [Invisible binders in functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC Proposal #448 (section 1.5 Type arguments in lambda patterns) introduces
binders for invisible type arguments (@a-binders) in function equations and
lambdas, e.g.

  1.  {-# LANGUAGE TypeAbstractions #-}
      id1 :: a -> a
      id1 @t x = x :: t     -- @t-binder on the LHS of a function equation

  2.  {-# LANGUAGE TypeAbstractions #-}
      ex :: (Int8, Int16)
      ex = higherRank (\ @a x -> maxBound @a - x )
                            -- @a-binder in a lambda pattern in an argument
                            -- to a higher-order function
      higherRank :: (forall a. (Num a, Bounded a) => a -> a) -> (Int8, Int16)
      higherRank f = (f 42, f 42)

In the AST, invisible patterns are represented as InvisPat constructor inside of Pat:
    data Pat p
      = ...
      | InvisPat (LHsType p)
      ...

Just like `BangPat`, the `Pat` data type allows `InvisPat` to appear in
nested positions. But this is often not allowed; e.g.

   f @a x = rhs    -- YES
   f (@a,x) = rhs  -- NO

   g = do { @a <- e1; e2 }         -- NO
   h x = case x of { @a -> rhs }   -- NO

Rather than excluding these things syntactically, we reject them in the renamer
(see `rn_pats_general`).  This actually gives a better error message than we
would get if they were rejected in the parser.

Each pattern is either visible (not prefixed with @) or invisible (prefixed with @):
    f :: forall a. forall b -> forall c. Int -> ...
    f @a b @c x  = ...

In this example, the arg-patterns are
    1. InvisPat @a     -- in the type sig: forall a.
    2. VarPat b        -- in the type sig: forall b ->
    3. InvisPat @c     -- in the type sig: forall c.
    4. VarPat x        -- in the type sig: Int ->

Invisible patterns are always type patterns, i.e. they are matched with
forall-bound type variables in the signature. Consequently, those variables (and
their binders) are erased during compilation, having no effect on program
execution at runtime.

Visible patterns, on the other hand, may be matched with ordinary function
arguments (Int ->) as well as required type arguments (forall b ->). This means
that a visible pattern may either be erased or retained, and we only find out in
the type checker, namely in tcMatchPats, where we match up all arg-patterns with
quantifiers from the type signature.

In other words, invisible patterns are always /erased/, while visible patterns
are sometimes /erased/ and sometimes /retained/.

The desugarer has no use for erased patterns, as the type checker generates
HsWrappers to bind the corresponding type variables. Erased patterns are simply
discarded inside tcMatchPats, where we know if visible pattern retained or erased.
-}

-- ---------------------------------------------------------------------

-- API Annotations types

data EpAnnSumPat = EpAnnSumPat
      { EpAnnSumPat -> (EpaLocation, EpaLocation)
sumPatParens      :: (EpaLocation, EpaLocation)
      , EpAnnSumPat -> [EpToken "|"]
sumPatVbarsBefore :: [EpToken "|"]
      , EpAnnSumPat -> [EpToken "|"]
sumPatVbarsAfter  :: [EpToken "|"]
      } deriving Typeable EpAnnSumPat
Typeable EpAnnSumPat =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> EpAnnSumPat -> c EpAnnSumPat)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EpAnnSumPat)
-> (EpAnnSumPat -> Constr)
-> (EpAnnSumPat -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EpAnnSumPat))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EpAnnSumPat))
-> ((forall b. Data b => b -> b) -> EpAnnSumPat -> EpAnnSumPat)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r)
-> (forall u. (forall d. Data d => d -> u) -> EpAnnSumPat -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EpAnnSumPat -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat)
-> Data EpAnnSumPat
EpAnnSumPat -> Constr
EpAnnSumPat -> DataType
(forall b. Data b => b -> b) -> EpAnnSumPat -> EpAnnSumPat
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EpAnnSumPat -> u
forall u. (forall d. Data d => d -> u) -> EpAnnSumPat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpAnnSumPat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpAnnSumPat -> c EpAnnSumPat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpAnnSumPat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpAnnSumPat)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpAnnSumPat -> c EpAnnSumPat
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpAnnSumPat -> c EpAnnSumPat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpAnnSumPat
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpAnnSumPat
$ctoConstr :: EpAnnSumPat -> Constr
toConstr :: EpAnnSumPat -> Constr
$cdataTypeOf :: EpAnnSumPat -> DataType
dataTypeOf :: EpAnnSumPat -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpAnnSumPat)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpAnnSumPat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpAnnSumPat)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpAnnSumPat)
$cgmapT :: (forall b. Data b => b -> b) -> EpAnnSumPat -> EpAnnSumPat
gmapT :: (forall b. Data b => b -> b) -> EpAnnSumPat -> EpAnnSumPat
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EpAnnSumPat -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EpAnnSumPat -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpAnnSumPat -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpAnnSumPat -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
Data

instance NoAnn EpAnnSumPat where
  noAnn :: EpAnnSumPat
noAnn = (EpaLocation, EpaLocation)
-> [EpToken "|"] -> [EpToken "|"] -> EpAnnSumPat
EpAnnSumPat (EpaLocation
forall a. NoAnn a => a
noAnn, EpaLocation
forall a. NoAnn a => a
noAnn) [] []

-- ---------------------------------------------------------------------

-- | Extension constructor for Pat, added after typechecking.
data XXPatGhcTc
  = -- | Coercion Pattern (translation only)
    --
    -- During desugaring a (CoPat co pat) turns into a cast with 'co' on the
    -- scrutinee, followed by a match on 'pat'.
    CoPat
      { -- | Coercion Pattern
        -- If co :: t1 ~ t2, p :: t2,
        -- then (CoPat co p) :: t1
        XXPatGhcTc -> HsWrapper
co_cpt_wrap :: HsWrapper

      , -- | Why not LPat?  Ans: existing locn will do
        XXPatGhcTc -> Pat GhcTc
co_pat_inner :: Pat GhcTc

      , -- | Type of whole pattern, t1
        XXPatGhcTc -> Type
co_pat_ty :: Type
      }
  -- | Pattern expansion: original pattern, and desugared pattern,
  -- for RebindableSyntax and other overloaded syntax such as OverloadedLists.
  -- See Note [Rebindable syntax and XXExprGhcRn].
  | ExpansionPat (Pat GhcRn) (Pat GhcTc)


-- See Note [Rebindable syntax and XXExprGhcRn].
data HsPatExpansion a b
  = HsPatExpanded a b
  deriving Typeable (HsPatExpansion a b)
Typeable (HsPatExpansion a b) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> HsPatExpansion a b
 -> c (HsPatExpansion a b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (HsPatExpansion a b))
-> (HsPatExpansion a b -> Constr)
-> (HsPatExpansion a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (HsPatExpansion a b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (HsPatExpansion a b)))
-> ((forall b. Data b => b -> b)
    -> HsPatExpansion a b -> HsPatExpansion a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> HsPatExpansion a b -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HsPatExpansion a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> HsPatExpansion a b -> m (HsPatExpansion a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HsPatExpansion a b -> m (HsPatExpansion a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HsPatExpansion a b -> m (HsPatExpansion a b))
-> Data (HsPatExpansion a b)
HsPatExpansion a b -> Constr
HsPatExpansion a b -> DataType
(forall b. Data b => b -> b)
-> HsPatExpansion a b -> HsPatExpansion a b
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HsPatExpansion a b -> u
forall u. (forall d. Data d => d -> u) -> HsPatExpansion a b -> [u]
forall a b. (Data a, Data b) => Typeable (HsPatExpansion a b)
forall a b. (Data a, Data b) => HsPatExpansion a b -> Constr
forall a b. (Data a, Data b) => HsPatExpansion a b -> DataType
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b)
-> HsPatExpansion a b -> HsPatExpansion a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> HsPatExpansion a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> HsPatExpansion a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsPatExpansion a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsPatExpansion a b
-> c (HsPatExpansion a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HsPatExpansion a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsPatExpansion a b))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsPatExpansion a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsPatExpansion a b
-> c (HsPatExpansion a b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HsPatExpansion a b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsPatExpansion a b))
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsPatExpansion a b
-> c (HsPatExpansion a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsPatExpansion a b
-> c (HsPatExpansion a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsPatExpansion a b)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsPatExpansion a b)
$ctoConstr :: forall a b. (Data a, Data b) => HsPatExpansion a b -> Constr
toConstr :: HsPatExpansion a b -> Constr
$cdataTypeOf :: forall a b. (Data a, Data b) => HsPatExpansion a b -> DataType
dataTypeOf :: HsPatExpansion a b -> DataType
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HsPatExpansion a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HsPatExpansion a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsPatExpansion a b))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsPatExpansion a b))
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b)
-> HsPatExpansion a b -> HsPatExpansion a b
gmapT :: (forall b. Data b => b -> b)
-> HsPatExpansion a b -> HsPatExpansion a b
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> HsPatExpansion a b -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsPatExpansion a b -> [u]
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> HsPatExpansion a b -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsPatExpansion a b -> u
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
Data

-- | This is the extension field for ConPat, added after typechecking
-- It adds quite a few extra fields, to support elaboration of pattern matching.
data ConPatTc
  = ConPatTc
    { -- | The universal arg types  1-1 with the universal
      -- tyvars of the constructor/pattern synonym
      -- Use (conLikeResTy pat_con cpt_arg_tys) to get
      -- the type of the pattern
      ConPatTc -> [Type]
cpt_arg_tys :: [Type]

    , -- | Existentially bound type variables
      -- in correctly-scoped order e.g. [k:*  x:k]
      ConPatTc -> [TyVar]
cpt_tvs   :: [TyVar]

    , -- | Ditto *coercion variables* and *dictionaries*
      -- One reason for putting coercion variable here  I think
      --      is to ensure their kinds are zonked
      ConPatTc -> [TyVar]
cpt_dicts :: [EvVar]

    , -- | Bindings involving those dictionaries
      ConPatTc -> TcEvBinds
cpt_binds :: TcEvBinds

    , -- | Extra wrapper to pass to the matcher
      -- Only relevant for pattern-synonyms;
      --   ignored for data cons
      ConPatTc -> HsWrapper
cpt_wrap  :: HsWrapper
    }

hsRecFieldId :: HsRecField GhcTc arg -> Id
hsRecFieldId :: forall arg. HsRecField GhcTc arg -> TyVar
hsRecFieldId = HsRecField GhcTc arg -> IdP GhcTc
HsRecField GhcTc arg -> TyVar
forall p arg. UnXRec p => HsRecField p arg -> IdP p
hsRecFieldSel

{-
************************************************************************
*                                                                      *
*              Printing patterns
*                                                                      *
************************************************************************
-}

instance Outputable (HsTyPat p) => Outputable (HsConPatTyArg p) where
  ppr :: HsConPatTyArg p -> SDoc
ppr (HsConPatTyArg XConPatTyArg p
_ HsTyPat p
ty) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> HsTyPat p -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyPat p
ty

instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot)
      => Outputable (HsRecFields p arg) where
  ppr :: HsRecFields p arg -> SDoc
ppr (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [XRec p (HsRecField p arg)]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot = Maybe (XRec p RecFieldsDotDot)
Nothing })
        = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((XRec p (HsRecField p arg) -> SDoc)
-> [XRec p (HsRecField p arg)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map XRec p (HsRecField p arg) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [XRec p (HsRecField p arg)]
flds)))
  ppr (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [XRec p (HsRecField p arg)]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot = Just (XRec p RecFieldsDotDot -> RecFieldsDotDot
LocatedE RecFieldsDotDot -> RecFieldsDotDot
forall l e. GenLocated l e -> e
unLoc -> RecFieldsDotDot Int
n) })
        = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((XRec p (HsRecField p arg) -> SDoc)
-> [XRec p (HsRecField p arg)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map XRec p (HsRecField p arg) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> [XRec p (HsRecField p arg)] -> [XRec p (HsRecField p arg)]
forall a. Int -> [a] -> [a]
take Int
n [XRec p (HsRecField p arg)]
flds) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc
dotdot])))
        where
          dotdot :: SDoc
dotdot = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
".." SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug ([XRec p (HsRecField p arg)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> [XRec p (HsRecField p arg)] -> [XRec p (HsRecField p arg)]
forall a. Int -> [a] -> [a]
drop Int
n [XRec p (HsRecField p arg)]
flds))

instance (Outputable p, OutputableBndr p, Outputable arg)
      => Outputable (HsFieldBind p arg) where
  ppr :: HsFieldBind p arg -> SDoc
ppr (HsFieldBind { hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS = p
f, hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS = arg
arg,
                     hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun = Bool
pun })
    = p -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc p
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
pun (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> arg -> SDoc
forall a. Outputable a => a -> SDoc
ppr arg
arg)

instance OutputableBndrId p => Outputable (Pat (GhcPass p)) where
    ppr :: Pat (GhcPass p) -> SDoc
ppr = Pat (GhcPass p) -> SDoc
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat

-- See Note [Rebindable syntax and XXExprGhcRn].
instance (Outputable a, Outputable b) => Outputable (HsPatExpansion a b) where
  ppr :: HsPatExpansion a b -> SDoc
ppr (HsPatExpanded a
a b
b) = SDoc -> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc -> doc
ifPprDebug ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a, b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
b]) (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a)

pprLPat :: (OutputableBndrId p) => LPat (GhcPass p) -> SDoc
pprLPat :: forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> SDoc
pprLPat (L SrcSpanAnnA
_ Pat (GhcPass p)
e) = Pat (GhcPass p) -> SDoc
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat (GhcPass p)
e

-- | Print with type info if -dppr-debug is on
pprPatBndr :: OutputableBndr name => name -> SDoc
pprPatBndr :: forall a. OutputableBndr a => a -> SDoc
pprPatBndr name
var
  = (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
      Bool
True -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (BindingSite -> name -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LambdaBind name
var) -- Could pass the site to pprPat
                                              -- but is it worth it?
      Bool
False -> name -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc name
var

pprParendLPat :: (OutputableBndrId p)
              => PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat :: forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
p = PprPrec -> Pat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
p (Pat (GhcPass p) -> SDoc)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p)
forall l e. GenLocated l e -> e
unLoc

pprParendPat :: forall p. OutputableBndrId p
             => PprPrec
             -> Pat (GhcPass p)
             -> SDoc
pprParendPat :: forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
p Pat (GhcPass p)
pat = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypecheckerElaboration ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ Bool
print_tc_elab ->
    if Bool -> Pat (GhcPass p) -> Bool
need_parens Bool
print_tc_elab Pat (GhcPass p)
pat
    then SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Pat (GhcPass p) -> SDoc
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat (GhcPass p)
pat)
    else Pat (GhcPass p) -> SDoc
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat (GhcPass p)
pat
  where
    need_parens :: Bool -> Pat (GhcPass p) -> Bool
need_parens Bool
print_tc_elab Pat (GhcPass p)
pat
      | GhcPass p
GhcTc <- forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p
      , XPat (CoPat {}) <- Pat (GhcPass p)
pat
      = Bool
print_tc_elab

      | Bool
otherwise
      = PprPrec -> Pat (GhcPass p) -> Bool
forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
p Pat (GhcPass p)
pat
      -- For a CoPat we need parens if we are going to show it, which
      -- we do if -fprint-typechecker-elaboration is on (c.f. pprHsWrapper)
      -- But otherwise the CoPat is discarded, so it
      -- is the pattern inside that matters.  Sigh.

pprPat :: forall p. (OutputableBndrId p) => Pat (GhcPass p) -> SDoc
pprPat :: forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat (VarPat XVarPat (GhcPass p)
_ LIdP (GhcPass p)
lvar)          = IdGhcP p -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPatBndr (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
lvar)
pprPat (WildPat XWildPat (GhcPass p)
_)              = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_'
pprPat (LazyPat XLazyPat (GhcPass p)
_ LPat (GhcPass p)
pat)          = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'~' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> LPat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat
pprPat (BangPat XBangPat (GhcPass p)
_ LPat (GhcPass p)
pat)          = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'!' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> LPat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat
pprPat (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
name LPat (GhcPass p)
pat)       = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [IdGhcP p -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
name), Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@',
                                        PprPrec -> LPat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat]
pprPat (ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
expr LPat (GhcPass p)
pat)     = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [LHsExpr (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsExpr (GhcPass p) -> SDoc
pprLExpr LHsExpr (GhcPass p)
expr, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" -> ", GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat]
pprPat (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
pat)           = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat)
pprPat (LitPat XLitPat (GhcPass p)
_ HsLit (GhcPass p)
s)             = HsLit (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsLit (GhcPass p)
s
pprPat (NPat XNPat (GhcPass p)
_ XRec (GhcPass p) (HsOverLit (GhcPass p))
l Maybe (SyntaxExpr (GhcPass p))
Nothing  SyntaxExpr (GhcPass p)
_)    = GenLocated EpAnnCO (HsOverLit (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (HsOverLit (GhcPass p))
GenLocated EpAnnCO (HsOverLit (GhcPass p))
l
pprPat (NPat XNPat (GhcPass p)
_ XRec (GhcPass p) (HsOverLit (GhcPass p))
l (Just SyntaxExpr (GhcPass p)
_) SyntaxExpr (GhcPass p)
_)    = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'-' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> GenLocated EpAnnCO (HsOverLit (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (HsOverLit (GhcPass p))
GenLocated EpAnnCO (HsOverLit (GhcPass p))
l
pprPat (NPlusKPat XNPlusKPat (GhcPass p)
_ LIdP (GhcPass p)
n XRec (GhcPass p) (HsOverLit (GhcPass p))
k HsOverLit (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ SyntaxExpr (GhcPass p)
_)  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [SDoc
ppr_n, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'+', GenLocated EpAnnCO (HsOverLit (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (HsOverLit (GhcPass p))
GenLocated EpAnnCO (HsOverLit (GhcPass p))
k]
  where ppr_n :: SDoc
ppr_n = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
                  GhcPass p
GhcPs -> GenLocated SrcSpanAnnN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated SrcSpanAnnN RdrName
n
                  GhcPass p
GhcRn -> GenLocated SrcSpanAnnN Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated SrcSpanAnnN Name
n
                  GhcPass p
GhcTc -> GenLocated SrcSpanAnnN TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
GenLocated SrcSpanAnnN TyVar
n
pprPat (SplicePat XSplicePat (GhcPass p)
ext HsUntypedSplice (GhcPass p)
splice)   =
    case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True Maybe Name
forall a. Maybe a
Nothing HsUntypedSplice (GhcPass p)
splice
      GhcPass p
GhcRn | HsUntypedSpliceNested Name
n <- XSplicePat (GhcPass p)
ext -> Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n) HsUntypedSplice (GhcPass p)
splice
      GhcPass p
GhcRn | HsUntypedSpliceTop ThModFinalizers
_ Pat GhcRn
p  <- XSplicePat (GhcPass p)
ext -> Pat GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcRn
p
      GhcPass p
GhcTc -> DataConCantHappen -> SDoc
forall a. DataConCantHappen -> a
dataConCantHappen XSplicePat (GhcPass p)
DataConCantHappen
ext
pprPat (SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
ty)        = GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsPatSigType (GhcPass (NoGhcTcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType (NoGhcTc (GhcPass p))
HsPatSigType (GhcPass (NoGhcTcPass p))
ty
pprPat (ListPat XListPat (GhcPass p)
_ [LPat (GhcPass p)]
pats)         = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats)
pprPat (OrPat XOrPat (GhcPass p)
_ NonEmpty (LPat (GhcPass p))
pats)           = (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithSemis GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LPat (GhcPass p))
NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
pats)
pprPat (TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)]
pats Boxity
bx)
    -- Special-case unary boxed tuples so that they are pretty-printed as
    -- `MkSolo x`, not `(x)`
  | [LPat (GhcPass p)
pat] <- [LPat (GhcPass p)]
pats
  , Boxity
Boxed <- Boxity
bx
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text (Boxity -> NameSpace -> Int -> String
mkTupleStr Boxity
Boxed NameSpace
dataName Int
1), PprPrec -> LPat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat]
  | Bool
otherwise
  = TupleSort -> SDoc -> SDoc
tupleParens (Boxity -> TupleSort
boxityTupleSort Boxity
bx) ((GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats)
pprPat (SumPat XSumPat (GhcPass p)
_ LPat (GhcPass p)
pat Int
alt Int
arity) = SDoc -> SDoc
sumParens ((GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc)
-> GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Int -> Int -> SDoc
forall a. (a -> SDoc) -> a -> Int -> Int -> SDoc
pprAlternative GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat Int
alt Int
arity)
pprPat (ConPat { pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = XRec (GhcPass p) (ConLikeP (GhcPass p))
con
               , pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass p)
details
               , pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = XConPat (GhcPass p)
ext
               }
       )
  = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> RdrName -> HsConPatDetails (GhcPass p) -> SDoc
forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
 Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated SrcSpanAnnN RdrName
con) HsConPatDetails (GhcPass p)
details
      GhcPass p
GhcRn -> Name -> HsConPatDetails (GhcPass p) -> SDoc
forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
 Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated SrcSpanAnnN Name
con) HsConPatDetails (GhcPass p)
details
      GhcPass p
GhcTc -> (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypecheckerElaboration ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
        Bool
False -> ConLike -> HsConPatDetails (GhcPass p) -> SDoc
forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
 Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (GenLocated SrcSpanAnnN ConLike -> ConLike
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated SrcSpanAnnN ConLike
con) HsConPatDetails (GhcPass p)
details
        Bool
True  ->
          -- Tiresome; in 'GHC.Tc.Gen.Bind.tcRhs' we print out a typechecked Pat in an
          -- error message, and we want to make sure it prints nicely
          GenLocated SrcSpanAnnN ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated SrcSpanAnnN ConLike
con
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((TyVar -> SDoc) -> [TyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPatBndr ([TyVar]
tvs [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVar]
dicts))
                           , TcEvBinds -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcEvBinds
binds ])
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsConPatDetails (GhcPass p) -> SDoc
forall (p :: Pass).
(OutputableBndrId p, Outputable (Anno (IdGhcP p))) =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs HsConPatDetails (GhcPass p)
details
        where ConPatTc { cpt_tvs :: ConPatTc -> [TyVar]
cpt_tvs = [TyVar]
tvs
                       , cpt_dicts :: ConPatTc -> [TyVar]
cpt_dicts = [TyVar]
dicts
                       , cpt_binds :: ConPatTc -> TcEvBinds
cpt_binds = TcEvBinds
binds
                       } = XConPat (GhcPass p)
ext
pprPat (EmbTyPat XEmbTyPat (GhcPass p)
_ HsTyPat (NoGhcTc (GhcPass p))
tp) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsTyPat (GhcPass (NoGhcTcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyPat (NoGhcTc (GhcPass p))
HsTyPat (GhcPass (NoGhcTcPass p))
tp
pprPat (InvisPat XInvisPat (GhcPass p)
x HsTyPat (NoGhcTc (GhcPass p))
tp) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
delimit (HsTyPat (GhcPass (NoGhcTcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsTyPat (NoGhcTc (GhcPass p))
HsTyPat (GhcPass (NoGhcTcPass p))
tp)
  where
    delimit :: SDoc -> SDoc
delimit
      | Bool
inferred     = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces
      | Bool
needs_parens = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens
      | Bool
otherwise    = SDoc -> SDoc
forall a. a -> a
id
    inferred :: Bool
inferred = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> (EpToken "@", Specificity) -> Specificity
forall a b. (a, b) -> b
snd (EpToken "@", Specificity)
XInvisPat (GhcPass p)
x Specificity -> Specificity -> Bool
forall a. Eq a => a -> a -> Bool
== Specificity
InferredSpec
      GhcPass p
GhcRn -> XInvisPat (GhcPass p)
Specificity
x Specificity -> Specificity -> Bool
forall a. Eq a => a -> a -> Bool
== Specificity
InferredSpec
      GhcPass p
GhcTc -> Bool
False
    needs_parens :: Bool
needs_parens = PprPrec -> HsType (GhcPass (NoGhcTcPass p)) -> Bool
forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens PprPrec
appPrec (HsType (GhcPass (NoGhcTcPass p)) -> Bool)
-> HsType (GhcPass (NoGhcTcPass p)) -> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType (GhcPass (NoGhcTcPass p)))
-> HsType (GhcPass (NoGhcTcPass p))
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (HsType (GhcPass (NoGhcTcPass p)))
 -> HsType (GhcPass (NoGhcTcPass p)))
-> GenLocated SrcSpanAnnA (HsType (GhcPass (NoGhcTcPass p)))
-> HsType (GhcPass (NoGhcTcPass p))
forall a b. (a -> b) -> a -> b
$ HsTyPat (GhcPass (NoGhcTcPass p))
-> LHsType (GhcPass (NoGhcTcPass p))
forall pass. HsTyPat pass -> LHsType pass
hstp_body HsTyPat (NoGhcTc (GhcPass p))
HsTyPat (GhcPass (NoGhcTcPass p))
tp

pprPat (XPat XXPat (GhcPass p)
ext) = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
  GhcPass p
GhcRn -> case XXPat (GhcPass p)
ext of
    HsPatExpanded Pat GhcRn
orig Pat GhcRn
_ -> Pat GhcRn -> SDoc
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat GhcRn
orig
  GhcPass p
GhcTc -> case XXPat (GhcPass p)
ext of
    CoPat HsWrapper
co Pat GhcTc
pat Type
_ ->
      HsWrapper -> (Bool -> SDoc) -> SDoc
pprHsWrapper HsWrapper
co ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
parens ->
        if Bool
parens
        then PprPrec -> Pat GhcTc -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
appPrec Pat GhcTc
pat
        else Pat GhcTc -> SDoc
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat GhcTc
pat
    ExpansionPat Pat GhcRn
orig Pat GhcTc
_ -> Pat GhcRn -> SDoc
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat GhcRn
orig

pprUserCon :: (OutputableBndr con, OutputableBndrId p,
                     Outputable (Anno (IdGhcP p)))
           => con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon :: forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
 Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon con
c (InfixCon LPat (GhcPass p)
p1 LPat (GhcPass p)
p2) = GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
p1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> con -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc con
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
p2
pprUserCon con
c HsConDetails
  (HsConPatTyArg (NoGhcTc (GhcPass p)))
  (LPat (GhcPass p))
  (HsRecFields (GhcPass p) (LPat (GhcPass p)))
details          = con -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc con
c SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsConDetails
  (HsConPatTyArg (NoGhcTc (GhcPass p)))
  (LPat (GhcPass p))
  (HsRecFields (GhcPass p) (LPat (GhcPass p)))
-> SDoc
forall (p :: Pass).
(OutputableBndrId p, Outputable (Anno (IdGhcP p))) =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs HsConDetails
  (HsConPatTyArg (NoGhcTc (GhcPass p)))
  (LPat (GhcPass p))
  (HsRecFields (GhcPass p) (LPat (GhcPass p)))
details

pprConArgs :: (OutputableBndrId p,
                     Outputable (Anno (IdGhcP p)))
           => HsConPatDetails (GhcPass p) -> SDoc
pprConArgs :: forall (p :: Pass).
(OutputableBndrId p, Outputable (Anno (IdGhcP p))) =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs (PrefixCon [HsConPatTyArg (NoGhcTc (GhcPass p))]
ts [LPat (GhcPass p)]
pats) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([HsConPatTyArg (GhcPass (NoGhcTcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprTyArgs [HsConPatTyArg (NoGhcTc (GhcPass p))]
[HsConPatTyArg (GhcPass (NoGhcTcPass p))]
ts SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SDoc)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec) [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats)
  where pprTyArgs :: [a] -> SDoc
pprTyArgs [a]
tyargs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
tyargs)
pprConArgs (InfixCon LPat (GhcPass p)
p1 LPat (GhcPass p)
p2)    = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ PprPrec -> LPat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
p1
                                     , PprPrec -> LPat (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
p2 ]
pprConArgs (RecCon HsRecFields (GhcPass p) (LPat (GhcPass p))
rpats)      = HsRecFields (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr HsRecFields (GhcPass p) (LPat (GhcPass p))
HsRecFields (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
rpats

{-
************************************************************************
*                                                                      *
*              Building patterns
*                                                                      *
************************************************************************
-}

mkPrefixConPat :: DataCon ->
                  [LPat GhcTc] -> [Type] -> LPat GhcTc
-- Make a vanilla Prefix constructor pattern
mkPrefixConPat :: DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
mkPrefixConPat DataCon
dc [LPat GhcTc]
pats [Type]
tys
  = 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
$ ConPat { pat_con :: XRec GhcTc (ConLikeP GhcTc)
pat_con = ConLike -> GenLocated SrcSpanAnnN ConLike
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (DataCon -> ConLike
RealDataCon DataCon
dc)
                    , pat_args :: HsConPatDetails GhcTc
pat_args = [HsConPatTyArg (NoGhcTc GhcTc)]
-> [LPat GhcTc] -> HsConPatDetails GhcTc
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [LPat GhcTc]
pats
                    , pat_con_ext :: XConPat GhcTc
pat_con_ext = ConPatTc
                      { cpt_tvs :: [TyVar]
cpt_tvs = []
                      , cpt_dicts :: [TyVar]
cpt_dicts = []
                      , cpt_binds :: TcEvBinds
cpt_binds = TcEvBinds
emptyTcEvBinds
                      , cpt_arg_tys :: [Type]
cpt_arg_tys = [Type]
tys
                      , cpt_wrap :: HsWrapper
cpt_wrap = HsWrapper
idHsWrapper
                      }
                    }

mkNilPat :: Type -> LPat GhcTc
mkNilPat :: Type -> LPat GhcTc
mkNilPat Type
ty = DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
mkPrefixConPat DataCon
nilDataCon [] [Type
ty]

mkCharLitPat :: SourceText -> Char -> LPat GhcTc
mkCharLitPat :: SourceText -> Char -> LPat GhcTc
mkCharLitPat SourceText
src Char
c = DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
mkPrefixConPat DataCon
charDataCon
                          [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 (XHsCharPrim GhcTc -> Char -> HsLit GhcTc
forall x. XHsCharPrim x -> Char -> HsLit x
HsCharPrim XHsCharPrim GhcTc
SourceText
src Char
c)] []

{-
************************************************************************
*                                                                      *
* Predicates for checking things about pattern-lists in EquationInfo   *
*                                                                      *
************************************************************************

\subsection[Pat-list-predicates]{Look for interesting things in patterns}

Unlike in the Wadler chapter, where patterns are either ``variables''
or ``constructors,'' here we distinguish between:
\begin{description}
\item[unfailable:]
Patterns that cannot fail to match: variables, wildcards, and lazy
patterns.

These are the irrefutable patterns; the two other categories
are refutable patterns.

\item[constructor:]
A non-literal constructor pattern (see next category).

\item[literal patterns:]
At least the numeric ones may be overloaded.
\end{description}

A pattern is in {\em exactly one} of the above three categories; `as'
patterns are treated specially, of course.

The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
-}

isBangedLPat :: LPat (GhcPass p) -> Bool
isBangedLPat :: forall (p :: Pass). LPat (GhcPass p) -> Bool
isBangedLPat = Pat (GhcPass p) -> Bool
forall (p :: Pass). Pat (GhcPass p) -> Bool
isBangedPat (Pat (GhcPass p) -> Bool)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p)
forall l e. GenLocated l e -> e
unLoc

isBangedPat :: Pat (GhcPass p) -> Bool
isBangedPat :: forall (p :: Pass). Pat (GhcPass p) -> Bool
isBangedPat (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
p) = LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isBangedLPat LPat (GhcPass p)
p
isBangedPat (BangPat {}) = Bool
True
isBangedPat Pat (GhcPass p)
_            = Bool
False

looksLazyPatBind :: HsBind GhcTc -> Bool
-- Returns True of anything *except*
--     a StrictHsBind (as above) or
--     a VarPat
-- In particular, returns True of a pattern binding with a compound pattern, like (I# x)
-- Looks through AbsBinds
looksLazyPatBind :: HsBind GhcTc -> Bool
looksLazyPatBind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcTc
p })
  = LPat GhcTc -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat GhcTc
p
looksLazyPatBind (XHsBindsLR (AbsBinds { abs_binds :: AbsBinds -> LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
binds }))
  = (GenLocated SrcSpanAnnA (HsBind GhcTc) -> Bool)
-> [GenLocated SrcSpanAnnA (HsBind GhcTc)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsBind GhcTc -> Bool
looksLazyPatBind (HsBind GhcTc -> Bool)
-> (GenLocated SrcSpanAnnA (HsBind GhcTc) -> HsBind GhcTc)
-> GenLocated SrcSpanAnnA (HsBind GhcTc)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsBind GhcTc) -> HsBind GhcTc
forall l e. GenLocated l e -> e
unLoc) LHsBinds GhcTc
[GenLocated SrcSpanAnnA (HsBind GhcTc)]
binds
looksLazyPatBind HsBind GhcTc
_
  = Bool
False

looksLazyLPat :: LPat (GhcPass p) -> Bool
looksLazyLPat :: forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat = Pat (GhcPass p) -> Bool
forall (p :: Pass). Pat (GhcPass p) -> Bool
looksLazyPat (Pat (GhcPass p) -> Bool)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p)
forall l e. GenLocated l e -> e
unLoc

looksLazyPat :: Pat (GhcPass p) -> Bool
looksLazyPat :: forall (p :: Pass). Pat (GhcPass p) -> Bool
looksLazyPat (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
p)  = LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat (GhcPass p)
p
looksLazyPat (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LPat (GhcPass p)
p) = LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat (GhcPass p)
p
looksLazyPat (BangPat {})  = Bool
False
looksLazyPat (VarPat {})   = Bool
False
looksLazyPat (WildPat {})  = Bool
False
looksLazyPat Pat (GhcPass p)
_             = Bool
True

{-
Note [-XStrict and irrefutability]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When -XStrict is enabled the rules for irrefutability are slightly modified.
Specifically, the pattern in a program like

    do ~(Just hi) <- expr

cannot be considered irrefutable. The ~ here merely disables the bang that
-XStrict would usually apply, rendering the program equivalent to the following
without -XStrict

    do Just hi <- expr

To achieve make this pattern irrefutable with -XStrict the user would rather
need to write

    do ~(~(Just hi)) <- expr

Failing to account for this resulted in #19027. To fix this isIrrefutableHsPat
takes care to check for two the irrefutability of the inner pattern when it
encounters a LazyPat and -XStrict is enabled.

See also Note [decideBangHood] in GHC.HsToCore.Utils.
-}

-- | @isIrrefutableHsPat p@ is true if matching against @p@ cannot fail
-- in the sense of falling through to the next pattern.
--      (NB: this is not quite the same as the (silly) defn
--      in 3.17.2 of the Haskell 98 report.)
--
-- If isIrrefutableHsPat returns 'True', the pattern is definitely irrefutable.
--
-- However, isIrrefutableHsPat returns 'False' if it's in doubt. It's a
-- best effort guess with the information we have available:
--
--  - we sometimes call 'isIrrefutableHsPat' from the renamer, in which case
--    we don't have type information to hand. This means we can't properly
--    handle GADTs, nor the result TyCon of COMPLETE pragmas.
--  - even when calling 'isIrrefutableHsPat' in the typechecker, we don't keep
--    track of any long distance information like the pattern-match checker does.
isIrrefutableHsPat
  :: forall p
  .  IsPass p
  => Bool                           -- ^ Are we in a @-XStrict@ context?
                                    -- See Note [-XStrict and irrefutability]
  -> (ConLikeP (GhcPass p) -> Bool) -- ^ How to check whether the 'ConLike' in a
                                    -- 'ConPat' pattern is irrefutable
  -> LPat (GhcPass p)               -- ^ The (located) pattern to check
  -> Bool                           -- Is it irrefutable?
isIrrefutableHsPat :: forall (p :: Pass).
IsPass p =>
Bool -> (ConLikeP (GhcPass p) -> Bool) -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat Bool
is_strict ConLikeP (GhcPass p) -> Bool
irref_conLike LPat (GhcPass p)
pat = Pat (GhcPass p) -> Bool
go (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p)
forall l e. GenLocated l e -> e
unLoc LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat)
  where
    goL :: GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL (L SrcSpanAnnA
_ Pat (GhcPass p)
p) = Pat (GhcPass p) -> Bool
go Pat (GhcPass p)
p

    go :: Pat (GhcPass p) -> Bool
    go :: Pat (GhcPass p) -> Bool
go (WildPat {})        = Bool
True
    go (VarPat {})         = Bool
True
    go (LazyPat XLazyPat (GhcPass p)
_ LPat (GhcPass p)
p')
      | Bool
is_strict
      = Bool -> (ConLikeP (GhcPass p) -> Bool) -> LPat (GhcPass p) -> Bool
forall (p :: Pass).
IsPass p =>
Bool -> (ConLikeP (GhcPass p) -> Bool) -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat Bool
False ConLikeP (GhcPass p) -> Bool
irref_conLike LPat (GhcPass p)
p'
      | Bool
otherwise          = Bool
True
    go (BangPat XBangPat (GhcPass p)
_ LPat (GhcPass p)
pat)     = GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat
    go (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
pat)      = GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat
    go (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LPat (GhcPass p)
pat)     = GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat
    go (ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
_ LPat (GhcPass p)
pat)   = GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat
    go (SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
_)    = GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat
    go (TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)]
pats Boxity
_) = (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats
    go (OrPat XOrPat (GhcPass p)
_ NonEmpty (LPat (GhcPass p))
pats)      = (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass p))) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL NonEmpty (LPat (GhcPass p))
NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
pats -- This is simplistic; see Note [Irrefutable or-patterns]
    go (SumPat {})         = Bool
False -- See Note [Unboxed sum patterns aren't irrefutable]
    go (ListPat {})        = Bool
False

    -- See Note [Irrefutability of ConPat]
    go (ConPat { pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = L Anno (ConLikeP (GhcPass p))
_ ConLikeP (GhcPass p)
con, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass p)
details })
                           =  ConLikeP (GhcPass p) -> Bool
irref_conLike ConLikeP (GhcPass p)
con
                           Bool -> Bool -> Bool
&& (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
goL (HsConPatDetails (GhcPass p) -> [LPat (GhcPass p)]
forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails (GhcPass p)
details)
    go (LitPat {})         = Bool
False
    go (NPat {})           = Bool
False
    go (NPlusKPat {})      = Bool
False

    -- We conservatively assume that no TH splices are irrefutable
    -- since we cannot know until the splice is evaluated.
    go (SplicePat {})      = Bool
False

    -- The behavior of this case is unimportant, as GHC will throw an error shortly
    -- after reaching this case for other reasons (see TcRnIllegalTypePattern).
    go (EmbTyPat {})       = Bool
True
    go (InvisPat {})       = Bool
True

    go (XPat XXPat (GhcPass p)
ext)          = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcRn -> case XXPat (GhcPass p)
ext of
        HsPatExpanded Pat GhcRn
_ Pat (GhcPass p)
pat -> Pat (GhcPass p) -> Bool
go Pat (GhcPass p)
pat
      GhcPass p
GhcTc -> case XXPat (GhcPass p)
ext of
        CoPat HsWrapper
_ Pat GhcTc
pat Type
_ -> Pat (GhcPass p) -> Bool
go Pat (GhcPass p)
Pat GhcTc
pat
        ExpansionPat Pat GhcRn
_ Pat GhcTc
pat -> Pat (GhcPass p) -> Bool
go Pat (GhcPass p)
Pat GhcTc
pat

-- | Is the pattern any of combination of:
--
-- - (pat)
-- - pat :: Type
-- - ~pat
-- - !pat
-- - x (variable)
isSimplePat :: LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat :: forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
p = case GenLocated SrcSpanAnnA (Pat (GhcPass x)) -> Pat (GhcPass x)
forall l e. GenLocated l e -> e
unLoc LPat (GhcPass x)
GenLocated SrcSpanAnnA (Pat (GhcPass x))
p of
  ParPat XParPat (GhcPass x)
_ LPat (GhcPass x)
x -> LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
  SigPat XSigPat (GhcPass x)
_ LPat (GhcPass x)
x HsPatSigType (NoGhcTc (GhcPass x))
_ -> LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
  LazyPat XLazyPat (GhcPass x)
_ LPat (GhcPass x)
x -> LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
  BangPat XBangPat (GhcPass x)
_ LPat (GhcPass x)
x -> LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
  VarPat XVarPat (GhcPass x)
_ LIdP (GhcPass x)
x -> IdGhcP x -> Maybe (IdGhcP x)
forall a. a -> Maybe a
Just (GenLocated (Anno (IdGhcP x)) (IdGhcP x) -> IdGhcP x
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass x)
GenLocated (Anno (IdGhcP x)) (IdGhcP x)
x)
  Pat (GhcPass x)
_ -> Maybe (IdP (GhcPass x))
Maybe (IdGhcP x)
forall a. Maybe a
Nothing

-- | Is this pattern boring from the perspective of pattern-match checking,
-- i.e. introduces no new pieces of long-distance information
-- which could influence pattern-match checking?
--
-- See Note [Boring patterns].
isBoringHsPat :: forall p. OutputableBndrId p => LPat (GhcPass p) -> Bool
-- NB: it's always safe to return 'False' in this function; that just means
-- performing potentially-redundant pattern-match checking.
isBoringHsPat :: forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
isBoringHsPat = LPat (GhcPass p) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL
  where
    goL :: forall p. OutputableBndrId p => LPat (GhcPass p) -> Bool
    goL :: forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL = Pat (GhcPass p) -> Bool
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> Bool
go (Pat (GhcPass p) -> Bool)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Pat (GhcPass p)
forall l e. GenLocated l e -> e
unLoc

    go :: forall p. OutputableBndrId p => Pat (GhcPass p) -> Bool
    go :: forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> Bool
go = \case
      WildPat {} -> Bool
True
      VarPat  {} -> Bool
True
      LazyPat {} -> Bool
True
      BangPat XBangPat (GhcPass p)
_ LPat (GhcPass p)
pat     -> LPat (GhcPass p) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
      ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
pat      -> LPat (GhcPass p) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
      AsPat {} -> Bool
False -- the pattern x@y links x and y together,
                        -- which is a nontrivial piece of information
      ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
_ LPat (GhcPass p)
pat   -> LPat (GhcPass p) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
      SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
_    -> LPat (GhcPass p) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
      TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)]
pats Boxity
_ -> (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat (GhcPass p) -> Bool
GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats
      SumPat  XSumPat (GhcPass p)
_ LPat (GhcPass p)
pat Int
_ Int
_ -> LPat (GhcPass p) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
      ListPat XListPat (GhcPass p)
_ [LPat (GhcPass p)]
pats    -> (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat (GhcPass p) -> Bool
GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats
      ConPat { pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = XRec (GhcPass p) (ConLikeP (GhcPass p))
con, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass p)
details }
        -> case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
            GhcPass p
GhcPs -> Bool
False -- conservative
            GhcPass p
GhcRn -> Bool
False -- conservative
            GhcPass p
GhcTc
              | ConLike -> Bool
isVanillaConLike (GenLocated SrcSpanAnnN ConLike -> ConLike
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated SrcSpanAnnN ConLike
con)
              -> (GenLocated SrcSpanAnnA (Pat GhcTc) -> Bool)
-> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat GhcTc -> Bool
GenLocated SrcSpanAnnA (Pat GhcTc) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL (HsConPatDetails (GhcPass p) -> [LPat (GhcPass p)]
forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails (GhcPass p)
details)
              | Bool
otherwise
              -- A pattern match on a GADT constructor can introduce
              -- type-level information (for example, T18572).
              -> Bool
False
      OrPat XOrPat (GhcPass p)
_ NonEmpty (LPat (GhcPass p))
pats  -> (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool)
-> NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass p))) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat (GhcPass p) -> Bool
GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
goL NonEmpty (LPat (GhcPass p))
NonEmpty (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
pats
      LitPat {}     -> Bool
True
      NPat {}       -> Bool
True
      NPlusKPat {}  -> Bool
True
      SplicePat {}  -> Bool
False
      EmbTyPat {}   -> Bool
True
      InvisPat {}   -> Bool
True
      XPat XXPat (GhcPass p)
ext ->
        case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
         GhcPass p
GhcRn -> case XXPat (GhcPass p)
ext of
           HsPatExpanded Pat GhcRn
_ Pat GhcRn
pat -> Pat GhcRn -> Bool
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> Bool
go Pat GhcRn
pat
         GhcPass p
GhcTc -> case XXPat (GhcPass p)
ext of
           CoPat HsWrapper
_ Pat GhcTc
pat Type
_      -> Pat GhcTc -> Bool
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> Bool
go Pat GhcTc
pat
           ExpansionPat Pat GhcRn
_ Pat GhcTc
pat -> Pat GhcTc -> Bool
forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> Bool
go Pat GhcTc
pat

isPatSyn :: LPat GhcTc -> Bool
isPatSyn :: LPat GhcTc -> Bool
isPatSyn (L SrcSpanAnnA
_ (ConPat {pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = L SrcSpanAnnN
_ (PatSynCon{})})) = Bool
True
isPatSyn LPat GhcTc
_ = Bool
False

{- Note [Irrefutability of ConPat]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A constructor pattern `ConPat { pat_con, pat_args }` is irrefutable under two
conditions:

  Irref-ConLike: the constructor, pat_con, is itself irrefutable.
  Irref-args   : all of the argument patterns, pat_args, are irrefutable.

The (Irref-ConLike) condition can be stated as follows:

  Irref-DataCon: a DataCon is irrefutable iff it is the only constructor of its
                 parent type constructor.
  Irref-PatSyn:  a PatSyn is irrefutable iff there is a COMPLETE pragma
                 containing this PatSyn as its sole member.

To understand this, let's consider some simple examples:

  data A = MkA Int Bool
  data BC = B Int | C

  pattern P :: Maybe Int -> BC
  pattern P mb_i <- ( ( \ case { B i -> Just i; C -> Nothing } ) -> mb_i )
  {-# COMPLETE P #-}

In this case:

  - the pattern 'A p1 p2' (for patterns 'p1 :: Int', 'p2 :: Bool') is irrefutable
    precisely when both 'p1' and 'p2' are irrefutable (this is the same as
    irrefutability of tuple patterns);
  - neither of the patterns 'B p' (for any pattern 'p :: Int') or 'C' are irrefutable,
    because the parent type constructor 'BC' contains more than one data constructor,
  - the pattern 'P q', for a pattern 'q :: Maybe Int', is irrefutable precisely
    when 'q' is irrefutable, due to the COMPLETE pragma on 'P'.

Wrinkle [Irrefutability and COMPLETE pragma result TyCons]

  There is one subtlety in the Irref-PatSyn condition: COMPLETE pragmas may
  optionally specify a result TyCon, as explained in Note [Implementation of COMPLETE pragmas]
  in GHC.HsToCore.Pmc.Solver.

  So, for a COMPLETE pragma with a result TyCon, we would need to compute
  'completeMatchAppliesAtType' to ensure that the COMPLETE pragma is indeed
  applicable. Doing so is not so straightforward in 'isIrrefutableHsPat', for
  a couple of reasons:

    1. 'isIrrefutableHsPat' is called from within the renamer, which means
       we don't have the appropriate 'Type' to hand,
    2. Even when 'isIrrefutableHsPat' is called from within the typechecker,
       computing 'completeMatchAppliesAtType' for a 'ConPat' which might be
       nested deep inside the top-level call, such as

          ( ( _ , P (x :: Int) ) :: ( Int, Int )

        would require keeping track of types as we recur in 'isIrrefutableHsPat',
        which would be much more involved and require duplicating code from
        the pattern match checker (it performs this check using the notion
        of "match variables", which we don't have in the typechecker).

Note [Irrefutable or-patterns]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When is an or-pattern ( p_1 ; ... ; p_n ) irrefutable? It certainly suffices
that individual pattern p_i is irrefutable, but it isn't necessary.

For example, with the datatype definition

  data ABC = A | B | C

the or-pattern ( B ; C ; A ) is irrefutable. Similarly, one can take into
account COMPLETE pragmas, e.g. (P ; R ; Q) is irrefutable in the presence of
{-# COMPLETE P, Q, R #-}. This would extend Note [Irrefutability of ConPat] to
the case of disjunctions of constructor patterns.

For now, the function 'isIrrefutableHsPat' does not take into account these
additional complications, and considers an or-pattern irrefutable precisely when
any of the summands are irrefutable. This pessimistic behaviour is OK: the contract
of 'isIrrefutableHsPat' is that it can only return 'True' for definitely irrefutable
patterns, but may conservatively return 'False' in other cases.

The justification for this design choice is as follows:

  1. Producing the correct answer in all cases would be rather difficult,
     for example for a complex pattern such as ( P ; !( R ; S ; ( Q :: Ty ) ) ).
  2. Irrefutable or-patterns aren't particularly common or useful, given that
     (currently) or-patterns aren't allowed to bind variables.

Note [Unboxed sum patterns aren't irrefutable]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as
patterns. A simple example that demonstrates this is from #14228:

  pattern Just' x = (# x | #)
  pattern Nothing' = (# | () #)

  foo x = case x of
    Nothing' -> putStrLn "nothing"
    Just'    -> putStrLn "just"

In foo, the pattern Nothing' (that is, (# x | #)) is certainly not irrefutable,
as does not match an unboxed sum value of the same arity—namely, (# | y #)
(covered by Just'). In fact, no unboxed sum pattern is irrefutable, since the
minimum unboxed sum arity is 2.

Failing to mark unboxed sum patterns as non-irrefutable would cause the Just'
case in foo to be unreachable, as GHC would mistakenly believe that Nothing'
is the only thing that could possibly be matched!

Note [Boring patterns]
~~~~~~~~~~~~~~~~~~~~~~
A pattern is called boring when no new information is gained upon successfully
matching on the pattern.

Some examples of boring patterns:

  - x, for a variable x. We learn nothing about x upon matching this pattern.
  - Just y. This pattern can fail, but if it matches, we don't learn anything
    about y.

Some examples of non-boring patterns:

  - x@(Just y). A match on this pattern introduces the fact that x is headed
    by the constructor Just, which means that a subsequent pattern match such as

      case x of { Just z -> ... }

    should not be marked as incomplete.
  - a@b. Matching on this pattern introduces a relation between 'a' and 'b',
    which means that we shouldn't emit any warnings in code of the form

      case a of
        True -> case b of { True -> .. } -- no warning here!
        False -> ...
  - GADT patterns. For example, with the GADT

      data G i where { MkGInt :: G Int }

    a match on the pattern 'MkGInt' introduces type-level information:

      foo :: G i -> i
      foo MkGInt = 3

    Here we learn that i ~ Int after matching on 'MkGInt', so this pattern
    is not boring.

When a pattern is boring, and we are only interested in additional long-distance
information (not whether the pattern itself is fallible), we can skip pattern-match
checking entirely. Doing this saves about 10% allocations in test T11195.

This happens when we are checking pattern-matches in do-notation, for example:

  do { x@(Just y) <- z
     ; ...
     ; return $ case x of { Just w -> ... } }

Here we *do not* want to emit a pattern-match warning on the first line for the
incomplete pattern-match, as incompleteness inside do-notation is handled
using MonadFail. However, we still want to propagate the fact that x is headed
by the 'Just' constructor, to avoid a pattern-match warning on the last line.

Note [Implementation of OrPatterns]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This Note describes the implementation of the extension -XOrPatterns.

* Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0522-or-patterns.rst
* Discussion: https://github.com/ghc-proposals/ghc-proposals/pull/522 and others

Parser
------
We parse an or-pattern `pat_1; ...; pat_k` into `OrPat [pat_1, ..., pat_k]`,
where `OrPat` is a constructor of `Pat` in Language.Haskell.Syntax.Pat.
We occasionally refer to any of the `pat_k` as "pattern alternatives" below.
The changes to the parser are as outlined in Section 8.1 of the proposal.
The main productions are

  orpats -> exp | exp ';' orpats
  aexp2 -> '(' orpats ')'
  pat -> orpats

Renamer and typechecker
-----------------------
The typing rule for or-patterns in terms of pattern types is

                   Γ0, Σ0 ⊢ pat_i : τ ⤳ Γ0,Σi,Ψi
            --------------------------------------------
            Γ0, Σ0 ⊢ ( pat_1; ...; pat_n ) : τ ⤳ Γ0,Σ0,∅

(See the proposal for what a pattern type `Γ, Σ ⊢ pat : τ ⤳ Γ,Σ,Ψ` is.)
The main points

  * None of the patterns may bind any variables, hence the same Γ0 in both input
    and output.
  * Any Given constraints bound by the pattern are discarded: the rule discards
    the Σi returned by each pattern.
  * Similarly any existentials Ψi bound by the pattern are discarded.

In GHC.Rename.Pat.rnPatAndThen, we reject visible term and type binders (i.e.
concerning Γ0).

Regarding the Givens Σi and existenials Ψi (i.e. invisible type binders)
introduced by the pattern alternatives `pat_i`, we discard them in
GHC.Tc.Gen.Pats.tc_pat in a manner similar to LazyPats;
see Note [Hopping the LIE in lazy patterns].

Why is it useful to allow Σi and Ψi only to discard them immediately after?
Consider

  data T a where MkT :: forall a x. Num a => x -> T a
  foo :: T a -> a
  foo (MkT{}; MkT{}) = 3

We do want to allow matching on MkT{} in or-patterns, despite them invisibly
binding an existential type variable `x` and a new Given constraint `Num a`.
Clearly, `x` must be dead in the RHS of foo, because there is no field binder
that brings it to life, so no harm done.
But we must be careful not to solve the `Num a` Wanted constraint in the RHS of
foo with the Given constraint from the pattern alternatives, hence we are
Hopping the LIE.

Desugarer
---------
The desugaring of or-patterns is complicated by the fact that we have to avoid
exponential code blowup. Consider
  f (LT; GT) (EQ; GT) = rhs1
  f _        _        = rhs2
The naïve desugaring of or-patterns would explode every or-pattern, thus
  f LT EQ = rhs1
  f LT GT = rhs1
  f GT EQ = rhs1
  f GT GT = rhs1
  f _  _  = rhs2
which leads to an exponential number of copies of `rhs1`.
Our current strategy, implemented in GHC.HsToCore.Match.tidy1, is to
desugar to LambdaCase and ViewPatterns,
  f ((\case LT -> True; GT -> True; _ -> False) -> True)
    ((\case EQ -> True; GT -> True; _ -> False) -> True)
    = rhs1
  f _ _ = rhs2
The existing code for ViewPatterns makes sure that we do not duplicate `rhs1`
and the Simplifier will take care to turn this into efficient code.

Pattern-match checker
---------------------
The changes to the pattern-match checker are described in detail in Section 4.9
of the 2024 revision of the "Lower Your Guards" paper.
What follows is a brief summary of that change.

The pattern-match checker desugars patterns as well, into syntactic variants of
*guard trees* such as `PmMatch`, describing a single Match `f ps | grhss`.
It used to be that each such guard trees nicely captured the effects of pattern
matching `ps` in a conjunctive list of `PmGrd`s, each of which refines
the set of Nablas that reach the RHS of the clause.
`PmGrd` is the heart of the Lower Your Guards approach: it is compositional,
simple, and *non-recursive*, unlike or-patterns!
Conjunction is implemented with the `...Pmc.Check.leftToRight` combinator.
But to desugar or-patterns, we need to compose with `Pmc.Check.topToBottom`
to model first match semantics!
This was previously impossible in the pattern fragment, and indeed is
incompatible with the simple "list of `PmGrd`s" desugaring of patterns.

So our solution is to generalise "sequence of `PmGrd`" into a series-parallel
graph `GrdDag`, a special kind of DAG, where "series" corresponds to
left-to-right sequence and "parallel" corresponds to top-to-bottom or-pattern
alternatives. Example

  f (LT; GT) True (EQ; GT) = rhs

desugars to

   /- LT <- x -\             /- EQ <- z -\
  .             . True <- y .             .-> rhs
   \- GT <- x ./             \- GT <- z -/

Branching is GdAlt and models first-match semantics of or-patterns, and
sequencing is GdSeq.

We must take care of exponential explosion of Covered sets for long matches like
  g (LT; GT) (LT; GT) ... True = 1
Fortunately, we can build on our existing throttling mechanism;
see Note [Countering exponential blowup] in GHC.HsToCore.Pmc.Check.
-}


-- | @'patNeedsParens' p pat@ returns 'True' if the pattern @pat@ needs
-- parentheses under precedence @p@.
patNeedsParens :: forall p. IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens :: forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
p = forall (q :: Pass). IsPass q => Pat (GhcPass q) -> Bool
go @p
  where
    -- Remark: go needs to be polymorphic, as we call it recursively
    -- at a different GhcPass (see the case for GhcTc XPat below).
    go :: forall q. IsPass q => Pat (GhcPass q) -> Bool
    go :: forall (q :: Pass). IsPass q => Pat (GhcPass q) -> Bool
go (NPlusKPat {})    = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
opPrec
    go (OrPat {})        = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec
    go (SplicePat {})    = Bool
False
    go (ConPat { pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass q)
ds })
                         = PprPrec
-> HsConDetails
     (HsConPatTyArg (GhcPass (NoGhcTcPass q)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass q)))
     (HsRecFields
        (GhcPass q) (GenLocated SrcSpanAnnA (Pat (GhcPass q))))
-> Bool
forall t a b. PprPrec -> HsConDetails t a b -> Bool
conPatNeedsParens PprPrec
p HsConPatDetails (GhcPass q)
HsConDetails
  (HsConPatTyArg (GhcPass (NoGhcTcPass q)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass q)))
  (HsRecFields
     (GhcPass q) (GenLocated SrcSpanAnnA (Pat (GhcPass q))))
ds
    go (SigPat {})       = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
sigPrec
    go (ViewPat {})      = Bool
True
    go (EmbTyPat {})     = Bool
True
    go (InvisPat{})      = Bool
False
    go (XPat XXPat (GhcPass q)
ext)        = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @q of
      GhcPass q
GhcRn -> case XXPat (GhcPass q)
ext of
        HsPatExpanded Pat GhcRn
orig Pat GhcRn
_ -> Pat GhcRn -> Bool
forall (q :: Pass). IsPass q => Pat (GhcPass q) -> Bool
go Pat GhcRn
orig
      GhcPass q
GhcTc -> case XXPat (GhcPass q)
ext of
        CoPat HsWrapper
_ Pat GhcTc
inner Type
_ -> Pat GhcTc -> Bool
forall (q :: Pass). IsPass q => Pat (GhcPass q) -> Bool
go Pat GhcTc
inner
        ExpansionPat Pat GhcRn
orig Pat GhcTc
_ -> Pat GhcRn -> Bool
forall (q :: Pass). IsPass q => Pat (GhcPass q) -> Bool
go Pat GhcRn
orig
          --                   ^^^^^^^
          -- NB: recursive call of go at a different GhcPass.
    go (WildPat {})      = Bool
False
    go (VarPat {})       = Bool
False
    go (LazyPat {})      = Bool
False
    go (BangPat {})      = Bool
False
    go (ParPat {})       = Bool
False
    go (AsPat {})        = Bool
False
    -- Special-case unary boxed tuple applications so that they are
    -- parenthesized as `Identity (Solo x)`, not `Identity Solo x` (#18612)
    -- See Note [One-tuples] in GHC.Builtin.Types
    go (TuplePat XTuplePat (GhcPass q)
_ [LPat (GhcPass q)
_] Boxity
Boxed)
                         = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
    go (TuplePat{})      = Bool
False
    go (SumPat {})       = Bool
False
    go (ListPat {})      = Bool
False
    go (LitPat XLitPat (GhcPass q)
_ HsLit (GhcPass q)
l)      = PprPrec -> HsLit (GhcPass q) -> Bool
forall x. PprPrec -> HsLit x -> Bool
hsLitNeedsParens PprPrec
p HsLit (GhcPass q)
l
    go (NPat XNPat (GhcPass q)
_ XRec (GhcPass q) (HsOverLit (GhcPass q))
lol Maybe (SyntaxExpr (GhcPass q))
_ SyntaxExpr (GhcPass q)
_)  = PprPrec -> HsOverLit (GhcPass q) -> Bool
forall x. PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens PprPrec
p (GenLocated EpAnnCO (HsOverLit (GhcPass q)) -> HsOverLit (GhcPass q)
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass q) (HsOverLit (GhcPass q))
GenLocated EpAnnCO (HsOverLit (GhcPass q))
lol)

-- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@
-- needs parentheses under precedence @p@.
conPatNeedsParens :: PprPrec -> HsConDetails t a b -> Bool
conPatNeedsParens :: forall t a b. PprPrec -> HsConDetails t a b -> Bool
conPatNeedsParens PprPrec
p = HsConDetails t a b -> Bool
go
  where
    go :: HsConDetails t a b -> Bool
go (PrefixCon [t]
ts [a]
args) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec Bool -> Bool -> Bool
&& (Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
args) Bool -> Bool -> Bool
|| Bool -> Bool
not ([t] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
ts))
    go (InfixCon {})       = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
opPrec -- type args should be empty in this case
    go (RecCon {})         = Bool
False


-- | Parenthesize a pattern without token information
gParPat :: forall p. IsPass p => LPat (GhcPass p) -> Pat (GhcPass p)
gParPat :: forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Pat (GhcPass p)
gParPat LPat (GhcPass p)
pat = XParPat (GhcPass p) -> LPat (GhcPass p) -> Pat (GhcPass p)
forall p. XParPat p -> LPat p -> Pat p
ParPat XParPat (GhcPass p)
x LPat (GhcPass p)
pat
  where
    x :: XParPat (GhcPass p)
x = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> (EpToken "(", EpToken ")")
XParPat (GhcPass p)
forall a. NoAnn a => a
noAnn
      GhcPass p
GhcRn -> XParPat (GhcPass p)
NoExtField
noExtField
      GhcPass p
GhcTc -> XParPat (GhcPass p)
NoExtField
noExtField

-- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
parenthesizePat :: IsPass p
                => PprPrec
                -> LPat (GhcPass p)
                -> LPat (GhcPass p)
parenthesizePat :: forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
p lpat :: LPat (GhcPass p)
lpat@(L SrcSpanAnnA
loc Pat (GhcPass p)
pat)
  | PprPrec -> Pat (GhcPass p) -> Bool
forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
p Pat (GhcPass p)
pat = SrcSpanAnnA
-> Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LPat (GhcPass p) -> Pat (GhcPass p)
forall (p :: Pass). IsPass p => LPat (GhcPass p) -> Pat (GhcPass p)
gParPat LPat (GhcPass p)
lpat)
  | Bool
otherwise            = LPat (GhcPass p)
lpat


{-
% Collect all EvVars from all constructor patterns
-}

-- May need to add more cases
collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar
collectEvVarsPats :: [Pat GhcTc] -> Bag TyVar
collectEvVarsPats = [Bag TyVar] -> Bag TyVar
forall a. [Bag a] -> Bag a
unionManyBags ([Bag TyVar] -> Bag TyVar)
-> ([Pat GhcTc] -> [Bag TyVar]) -> [Pat GhcTc] -> Bag TyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat GhcTc -> Bag TyVar) -> [Pat GhcTc] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map Pat GhcTc -> Bag TyVar
collectEvVarsPat

collectEvVarsLPat :: LPat GhcTc -> Bag EvVar
collectEvVarsLPat :: LPat GhcTc -> Bag TyVar
collectEvVarsLPat = Pat GhcTc -> Bag TyVar
collectEvVarsPat (Pat GhcTc -> Bag TyVar)
-> (GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc)
-> GenLocated SrcSpanAnnA (Pat GhcTc)
-> Bag TyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
forall l e. GenLocated l e -> e
unLoc

collectEvVarsPat :: Pat GhcTc -> Bag EvVar
collectEvVarsPat :: Pat GhcTc -> Bag TyVar
collectEvVarsPat Pat GhcTc
pat =
  case Pat GhcTc
pat of
    LazyPat XLazyPat GhcTc
_ LPat GhcTc
p      -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
    AsPat XAsPat GhcTc
_ LIdP GhcTc
_ LPat GhcTc
p      -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
    ParPat  XParPat GhcTc
_ LPat GhcTc
p      -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
    BangPat XBangPat GhcTc
_ LPat GhcTc
p      -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
    ListPat XListPat GhcTc
_ [LPat GhcTc]
ps     -> [Bag TyVar] -> Bag TyVar
forall a. [Bag a] -> Bag a
unionManyBags ([Bag TyVar] -> Bag TyVar) -> [Bag TyVar] -> Bag TyVar
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar)
-> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar
collectEvVarsLPat [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
ps
    TuplePat XTuplePat GhcTc
_ [LPat GhcTc]
ps Boxity
_  -> [Bag TyVar] -> Bag TyVar
forall a. [Bag a] -> Bag a
unionManyBags ([Bag TyVar] -> Bag TyVar) -> [Bag TyVar] -> Bag TyVar
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar)
-> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar
collectEvVarsLPat [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
ps
    OrPat XOrPat GhcTc
_ NonEmpty (LPat GhcTc)
ps       -> [Bag TyVar] -> Bag TyVar
forall a. [Bag a] -> Bag a
unionManyBags ([Bag TyVar] -> Bag TyVar) -> [Bag TyVar] -> Bag TyVar
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar)
-> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar
collectEvVarsLPat (NonEmpty (GenLocated SrcSpanAnnA (Pat GhcTc))
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LPat GhcTc)
NonEmpty (GenLocated SrcSpanAnnA (Pat GhcTc))
ps)
    SumPat XSumPat GhcTc
_ LPat GhcTc
p Int
_ Int
_   -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
    ConPat
      { pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args  = HsConPatDetails GhcTc
args
      , pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = ConPatTc
        { cpt_dicts :: ConPatTc -> [TyVar]
cpt_dicts = [TyVar]
dicts
        }
      }
                     -> Bag TyVar -> Bag TyVar -> Bag TyVar
forall a. Bag a -> Bag a -> Bag a
unionBags ([TyVar] -> Bag TyVar
forall a. [a] -> Bag a
listToBag [TyVar]
dicts)
                                   (Bag TyVar -> Bag TyVar) -> Bag TyVar -> Bag TyVar
forall a b. (a -> b) -> a -> b
$ [Bag TyVar] -> Bag TyVar
forall a. [Bag a] -> Bag a
unionManyBags
                                   ([Bag TyVar] -> Bag TyVar) -> [Bag TyVar] -> Bag TyVar
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar)
-> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
GenLocated SrcSpanAnnA (Pat GhcTc) -> Bag TyVar
collectEvVarsLPat
                                   ([GenLocated SrcSpanAnnA (Pat GhcTc)] -> [Bag TyVar])
-> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> a -> b
$ HsConPatDetails GhcTc -> [LPat GhcTc]
forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails GhcTc
args
    SigPat  XSigPat GhcTc
_ LPat GhcTc
p HsPatSigType (NoGhcTc GhcTc)
_    -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
    XPat XXPat GhcTc
ext -> case XXPat GhcTc
ext of
      CoPat HsWrapper
_ Pat GhcTc
p Type
_      -> Pat GhcTc -> Bag TyVar
collectEvVarsPat Pat GhcTc
p
      ExpansionPat Pat GhcRn
_ Pat GhcTc
p -> Pat GhcTc -> Bag TyVar
collectEvVarsPat Pat GhcTc
p
    Pat GhcTc
_other_pat       -> Bag TyVar
forall a. Bag a
emptyBag

{-
************************************************************************
*                                                                      *
\subsection{Anno instances}
*                                                                      *
************************************************************************
-}

type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO
type instance Anno ConLike = SrcSpanAnnN
type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA
type instance Anno RecFieldsDotDot = EpaLocation