{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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,
        EpAnnSumPat(..),
        ConPatTc (..),
        ConLikeP,
        HsPatExpansion(..),
        XXPatGhcTc(..),

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

        mkPrefixConPat, mkCharLitPat, mkNilPat,

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

        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 ( RdrName )
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Core.Type
import GHC.Types.SrcLoc
import GHC.Data.Bag -- collect ev vars from pats
import GHC.Data.Maybe
import GHC.Types.Name (Name, dataName)
import GHC.Driver.Session
import qualified GHC.LanguageExtensions as LangExt
import Data.Data


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

type instance XVarPat  (GhcPass _) = NoExtField

type instance XLazyPat GhcPs = EpAnn [AddEpAnn] -- For '~'
type instance XLazyPat GhcRn = NoExtField
type instance XLazyPat GhcTc = NoExtField

type instance XAsPat   GhcPs = EpAnnCO
type instance XAsPat   GhcRn = NoExtField
type instance XAsPat   GhcTc = NoExtField

type instance XParPat (GhcPass _) = EpAnnCO

type instance XBangPat GhcPs = EpAnn [AddEpAnn] -- For '!'
type instance XBangPat GhcRn = NoExtField
type instance XBangPat GhcTc = NoExtField

type instance XListPat GhcPs = EpAnn 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 = EpAnn [AddEpAnn]
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]

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

type instance XConPat GhcPs = EpAnn [AddEpAnn]
type instance XConPat GhcRn = NoExtField
type instance XConPat GhcTc = ConPatTc

type instance XViewPat GhcPs = EpAnn [AddEpAnn]
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 = EpAnn [AddEpAnn]
type instance XNPat GhcRn = EpAnn [AddEpAnn]
type instance XNPat GhcTc = Type

type instance XNPlusKPat GhcPs = EpAnn EpaLocation -- Of the "+"
type instance XNPlusKPat GhcRn = NoExtField
type instance XNPlusKPat GhcTc = Type

type instance XSigPat GhcPs = EpAnn [AddEpAnn]
type instance XSigPat GhcRn = NoExtField
type instance XSigPat 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 HsExpansion].
type instance XXPat GhcTc = XXPatGhcTc
  -- After typechecking, we add extra constructors: CoPat and HsExpansion.
  -- HsExpansion 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 XHsFieldBind _ = EpAnn [AddEpAnn]

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

-- API Annotations types

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

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

-- | 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 HsExpansion].
  | ExpansionPat (Pat GhcRn) (Pat GhcTc)


-- See Note [Rebindable syntax and HsExpansion].
data HsPatExpansion a b
  = HsPatExpanded a b
  deriving HsPatExpansion a b -> DataType
HsPatExpansion a b -> Constr
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 {a} {b}. (Data a, Data b) => Typeable (HsPatExpansion a b)
forall a b. (Data a, Data b) => HsPatExpansion a b -> DataType
forall a b. (Data a, Data b) => HsPatExpansion a b -> Constr
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 (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 e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsPatExpansion a b))
gmapMo :: 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)
gmapMp :: forall (m :: * -> *).
MonadPlus 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)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsPatExpansion a b -> m (HsPatExpansion a b)
$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)
gmapQi :: forall u.
Int -> (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
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsPatExpansion a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> HsPatExpansion a b -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsPatExpansion a b -> r
gmapT :: (forall b. Data b => b -> b)
-> HsPatExpansion a b -> HsPatExpansion a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b)
-> HsPatExpansion a b -> 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))
$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))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HsPatExpansion a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HsPatExpansion a b))
dataTypeOf :: HsPatExpansion a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => HsPatExpansion a b -> DataType
toConstr :: HsPatExpansion a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => HsPatExpansion a b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
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)
$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)
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 = forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
hsRecFieldSel

hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr :: forall (p :: Pass). HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS

hsRecUpdFieldId :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> Located Id
hsRecUpdFieldId :: forall arg.
HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> Located TyVar
hsRecUpdFieldId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall pass. FieldOcc pass -> XCFieldOcc pass
foExt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LocatedAn a e -> Located e
reLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arg.
HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc

hsRecUpdFieldOcc :: HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc :: forall arg.
HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS


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

instance Outputable (HsPatSigType p) => Outputable (HsConPatTyArg p) where
  ppr :: HsConPatTyArg p -> SDoc
ppr (HsConPatTyArg LHsToken "@" p
_ HsPatSigType p
ty) = Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr HsPatSigType p
ty

instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ Located 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
braces ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map 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 (forall l e. GenLocated l e -> e
unLoc -> RecFieldsDotDot Int
n) })
        = SDoc -> SDoc
braces ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr (forall a. Int -> [a] -> [a]
take Int
n [XRec p (HsRecField p arg)]
flds) forall a. [a] -> [a] -> [a]
++ [SDoc
dotdot])))
        where
          dotdot :: SDoc
dotdot = String -> SDoc
text String
".." SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
whenPprDebug (forall a. Outputable a => a -> SDoc
ppr (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 })
    = forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc p
f SDoc -> SDoc -> SDoc
<+> (Bool -> SDoc -> SDoc
ppUnless Bool
pun forall a b. (a -> b) -> a -> b
$ SDoc
equals SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr arg
arg)

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

-- See Note [Rebindable syntax and HsExpansion].
instance (Outputable a, Outputable b) => Outputable (HsPatExpansion a b) where
  ppr :: HsPatExpansion a b -> SDoc
ppr (HsPatExpanded a
a b
b) = SDoc -> SDoc -> SDoc
ifPprDebug ([SDoc] -> SDoc
vcat [forall a. Outputable a => a -> SDoc
ppr a
a, forall a. Outputable a => a -> SDoc
ppr b
b]) (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) = 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
getPprDebug forall a b. (a -> b) -> a -> b
$ \case
      Bool
True -> SDoc -> SDoc
parens (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 -> 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 = forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypecheckerElaboration 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
parens (forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat (GhcPass p)
pat)
    else 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
      = 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)          = forall a. OutputableBndr a => a -> SDoc
pprPatBndr (forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
lvar)
pprPat (WildPat XWildPat (GhcPass p)
_)              = Char -> SDoc
char Char
'_'
pprPat (LazyPat XLazyPat (GhcPass p)
_ LPat (GhcPass p)
pat)          = Char -> SDoc
char Char
'~' SDoc -> SDoc -> 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
char Char
'!' SDoc -> SDoc -> 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 LHsToken "@" (GhcPass p)
_ LPat (GhcPass p)
pat)     = [SDoc] -> SDoc
hcat [forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
name), Char -> SDoc
char Char
'@',
                                        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
hcat [forall (p :: Pass).
OutputableBndrId p =>
LHsExpr (GhcPass p) -> SDoc
pprLExpr LHsExpr (GhcPass p)
expr, String -> SDoc
text String
" -> ", forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
pat]
pprPat (ParPat XParPat (GhcPass p)
_ LHsToken "(" (GhcPass p)
_ LPat (GhcPass p)
pat LHsToken ")" (GhcPass p)
_)      = SDoc -> SDoc
parens (forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
pat)
pprPat (LitPat XLitPat (GhcPass p)
_ HsLit (GhcPass p)
s)             = 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)
_)    = forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (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
char Char
'-' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (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
hcat [SDoc
ppr_n, Char -> SDoc
char Char
'+', forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (HsOverLit (GhcPass p))
k]
  where ppr_n :: SDoc
ppr_n = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
                  GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
                  GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
                  GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
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 -> forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True forall a. Maybe a
Nothing HsUntypedSplice (GhcPass p)
splice
      GhcPass p
GhcRn | HsUntypedSpliceNested Name
n <- XSplicePat (GhcPass p)
ext -> forall (p :: Pass).
OutputableBndrId p =>
Bool -> Maybe Name -> HsUntypedSplice (GhcPass p) -> SDoc
pprUntypedSplice Bool
True (forall a. a -> Maybe a
Just Name
n) HsUntypedSplice (GhcPass p)
splice
      GhcPass p
GhcRn | HsUntypedSpliceTop ThModFinalizers
_ Pat GhcRn
p  <- XSplicePat (GhcPass p)
ext -> forall a. Outputable a => a -> SDoc
ppr Pat GhcRn
p
      GhcPass p
GhcTc -> forall a. DataConCantHappen -> a
dataConCantHappen XSplicePat (GhcPass p)
ext
pprPat (SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
ty)        = forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
pat SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr HsPatSigType (NoGhcTc (GhcPass p))
ty
pprPat (ListPat XListPat (GhcPass p)
_ [LPat (GhcPass p)]
pats)         = SDoc -> SDoc
brackets (forall a. Outputable a => [a] -> SDoc
interpp'SP [LPat (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
    -- `Solo x`, not `(x)`
  | [LPat (GhcPass p)
pat] <- [LPat (GhcPass p)]
pats
  , Boxity
Boxed <- Boxity
bx
  = [SDoc] -> SDoc
hcat [String -> SDoc
text (Boxity -> NameSpace -> Int -> String
mkTupleStr Boxity
Boxed NameSpace
dataName Int
1), 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) (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [LPat (GhcPass p)]
pats)
pprPat (SumPat XSumPat (GhcPass p)
_ LPat (GhcPass p)
pat Int
alt Int
arity) = SDoc -> SDoc
sumParens (forall a. (a -> SDoc) -> a -> Int -> Int -> SDoc
pprAlternative forall a. Outputable a => a -> SDoc
ppr LPat (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 -> forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
 Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
con) HsConPatDetails (GhcPass p)
details
      GhcPass p
GhcRn -> forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
 Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
con) HsConPatDetails (GhcPass p)
details
      GhcPass p
GhcTc -> forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypecheckerElaboration forall a b. (a -> b) -> a -> b
$ \case
        Bool
False -> forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
 Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
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
          forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (ConLikeP (GhcPass p))
con
            SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [ [SDoc] -> SDoc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. OutputableBndr a => a -> SDoc
pprPatBndr ([TyVar]
tvs forall a. [a] -> [a] -> [a]
++ [TyVar]
dicts))
                           , forall a. Outputable a => a -> SDoc
ppr TcEvBinds
binds ])
            SDoc -> SDoc -> 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 (XPat XXPat (GhcPass p)
ext) = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
  GhcPs -> dataConCantHappen ext
#endif
  GhcPass p
GhcRn -> case XXPat (GhcPass p)
ext of
    HsPatExpanded Pat GhcRn
orig Pat GhcRn
_ -> 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 forall a b. (a -> b) -> a -> b
$ \Bool
parens ->
        if Bool
parens
        then forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
appPrec Pat GhcTc
pat
        else forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat GhcTc
pat
    ExpansionPat Pat GhcRn
orig Pat GhcTc
_ -> 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) = forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
p1 SDoc -> SDoc -> SDoc
<+> forall a. OutputableBndr a => a -> SDoc
pprInfixOcc con
c SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
p2
pprUserCon con
c HsConDetails
  (HsConPatTyArg (NoGhcTc (GhcPass p)))
  (LPat (GhcPass p))
  (HsRecFields (GhcPass p) (LPat (GhcPass p)))
details          = forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc con
c SDoc -> SDoc -> 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
fsep (forall a. Outputable a => [a] -> SDoc
pprTyArgs [HsConPatTyArg (NoGhcTc (GhcPass p))]
ts forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec) [LPat (GhcPass p)]
pats)
  where pprTyArgs :: [a] -> SDoc
pprTyArgs [a]
tyargs = [SDoc] -> SDoc
fsep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [a]
tyargs)
pprConArgs (InfixCon LPat (GhcPass p)
p1 LPat (GhcPass p)
p2)    = [SDoc] -> SDoc
sep [ forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
p1
                                     , 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)      = forall a. Outputable a => a -> SDoc
ppr HsRecFields (GhcPass p) (LPat (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
  = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ ConPat { pat_con :: XRec GhcTc (ConLikeP GhcTc)
pat_con = forall a an. a -> LocatedAn an a
noLocA (DataCon -> ConLike
RealDataCon DataCon
dc)
                    , pat_args :: HsConPatDetails GhcTc
pat_args = 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
                          [forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p. XLitPat p -> HsLit p -> Pat p
LitPat NoExtField
noExtField (forall x. XHsCharPrim x -> Char -> HsLit x
HsCharPrim 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 = forall (p :: Pass). Pat (GhcPass p) -> Bool
isBangedPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
_ LHsToken "(" (GhcPass p)
_ LPat (GhcPass p)
p LHsToken ")" (GhcPass p)
_) = 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 })
  = forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat GhcTc
p
looksLazyPatBind (XHsBindsLR (AbsBinds { abs_binds :: AbsBinds -> LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
binds }))
  = forall a. (a -> Bool) -> Bag a -> Bool
anyBag (HsBind GhcTc -> Bool
looksLazyPatBind forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) LHsBinds GhcTc
binds
looksLazyPatBind HsBind GhcTc
_
  = Bool
False

looksLazyLPat :: LPat (GhcPass p) -> Bool
looksLazyLPat :: forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat = forall (p :: Pass). Pat (GhcPass p) -> Bool
looksLazyPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
_ LHsToken "(" (GhcPass p)
_ LPat (GhcPass p)
p LHsToken ")" (GhcPass p)
_)  = forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat (GhcPass p)
p
looksLazyPat (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LHsToken "@" (GhcPass p)
_ LPat (GhcPass p)
p)   = 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

isIrrefutableHsPat :: forall p. (OutputableBndrId p)
                   => DynFlags -> LPat (GhcPass p) -> Bool
-- (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.)
--
-- WARNING: isIrrefutableHsPat returns False if it's in doubt.
-- Specifically on a ConPatIn, which is what it sees for a
-- (LPat Name) in the renamer, it doesn't know the size of the
-- constructor family, so it returns False.  Result: only
-- tuple patterns are considered irrefutable at the renamer stage.
--
-- But if it returns True, the pattern is definitely irrefutable
isIrrefutableHsPat :: forall (p :: Pass).
OutputableBndrId p =>
DynFlags -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat DynFlags
dflags =
    forall (p :: Pass).
OutputableBndrId p =>
Bool -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' (Extension -> DynFlags -> Bool
xopt Extension
LangExt.Strict DynFlags
dflags)

{-
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' :: forall p. (OutputableBndrId p)
                    => Bool -- ^ Are we in a @-XStrict@ context?
                            -- See Note [-XStrict and irrefutability]
                    -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' :: forall (p :: Pass).
OutputableBndrId p =>
Bool -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' Bool
is_strict = LPat (GhcPass p) -> Bool
goL
  where
    goL :: LPat (GhcPass p) -> Bool
    goL :: LPat (GhcPass p) -> Bool
goL = Pat (GhcPass p) -> Bool
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc

    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
      = forall (p :: Pass).
OutputableBndrId p =>
Bool -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' Bool
False LPat (GhcPass p)
p'
      | Bool
otherwise          = Bool
True
    go (BangPat XBangPat (GhcPass p)
_ LPat (GhcPass p)
pat)     = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
    go (ParPat XParPat (GhcPass p)
_ LHsToken "(" (GhcPass p)
_ LPat (GhcPass p)
pat LHsToken ")" (GhcPass p)
_)  = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
    go (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LHsToken "@" (GhcPass p)
_ LPat (GhcPass p)
pat)   = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
    go (ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
_ LPat (GhcPass p)
pat)   = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
    go (SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
_)    = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
    go (TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)]
pats Boxity
_) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat (GhcPass p) -> Bool
goL [LPat (GhcPass p)]
pats
    go (SumPat {})         = Bool
False
                    -- See Note [Unboxed sum patterns aren't irrefutable]
    go (ListPat {})        = Bool
False

    go (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 -> case XRec (GhcPass p) (ConLikeP (GhcPass p))
con of
         L SrcSpanAnnN
_ (PatSynCon PatSyn
_pat)  -> Bool
False -- Conservative
         L SrcSpanAnnN
_ (RealDataCon DataCon
con) ->
           forall a. Maybe a -> Bool
isJust (TyCon -> Maybe DataCon
tyConSingleDataCon_maybe (DataCon -> TyCon
dataConTyCon DataCon
con))
           Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat (GhcPass p) -> Bool
goL (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

    go (XPat XXPat (GhcPass p)
ext)          = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
      GhcPs -> dataConCantHappen ext
#endif
      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 GhcTc
pat
        ExpansionPat Pat GhcRn
_ Pat GhcTc
pat -> Pat (GhcPass p) -> Bool
go 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 forall l e. GenLocated l e -> e
unLoc LPat (GhcPass x)
p of
  ParPat XParPat (GhcPass x)
_ LHsToken "(" (GhcPass x)
_ LPat (GhcPass x)
x LHsToken ")" (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))
_ -> forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
  LazyPat XLazyPat (GhcPass x)
_ LPat (GhcPass x)
x -> forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
  BangPat XBangPat (GhcPass x)
_ LPat (GhcPass x)
x -> forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
  VarPat XVarPat (GhcPass x)
_ LIdP (GhcPass x)
x -> forall a. a -> Maybe a
Just (forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass x)
x)
  Pat (GhcPass x)
_ -> forall a. Maybe a
Nothing


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

-- | @'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 forall a. Ord a => a -> a -> Bool
> PprPrec
opPrec
    go (SplicePat {})    = Bool
False
    go (ConPat { pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass q)
ds })
                         = forall t a b. PprPrec -> HsConDetails t a b -> Bool
conPatNeedsParens PprPrec
p HsConPatDetails (GhcPass q)
ds
    go (SigPat {})       = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
sigPrec
    go (ViewPat {})      = Bool
True
    go (XPat XXPat (GhcPass q)
ext)        = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @q of
#if __GLASGOW_HASKELL__ < 901
      GhcPs -> dataConCantHappen ext
#endif
      GhcPass q
GhcRn -> case XXPat (GhcPass q)
ext of
        HsPatExpanded Pat GhcRn
orig Pat GhcRn
_ -> 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
_ -> forall (q :: Pass). IsPass q => Pat (GhcPass q) -> Bool
go Pat GhcTc
inner
        ExpansionPat Pat GhcRn
orig Pat GhcTc
_ -> 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 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)      = 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)
_)  = forall x. PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens PprPrec
p (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass q) (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 forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec Bool -> Bool -> Bool
&& (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
args) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
ts))
    go (InfixCon {})       = PprPrec
p 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 :: LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat :: forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat LPat (GhcPass pass)
p = forall p.
XParPat p -> LHsToken "(" p -> LPat p -> LHsToken ")" p -> Pat p
ParPat forall a. EpAnn a
noAnn forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LPat (GhcPass pass)
p forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok

-- | @'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)
  | forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
p Pat (GhcPass p)
pat = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
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 = forall a. [Bag a] -> Bag a
unionManyBags forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_ LHsToken "@" GhcTc
_ LPat GhcTc
p    -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
    ParPat  XParPat GhcTc
_ LHsToken "(" GhcTc
_ LPat GhcTc
p LHsToken ")" GhcTc
_  -> 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     -> forall a. [Bag a] -> Bag a
unionManyBags forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
collectEvVarsLPat [LPat GhcTc]
ps
    TuplePat XTuplePat GhcTc
_ [LPat GhcTc]
ps Boxity
_  -> forall a. [Bag a] -> Bag a
unionManyBags forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
collectEvVarsLPat [LPat 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
        }
      }
                     -> forall a. Bag a -> Bag a -> Bag a
unionBags (forall a. [a] -> Bag a
listToBag [TyVar]
dicts)
                                   forall a b. (a -> b) -> a -> b
$ forall a. [Bag a] -> Bag a
unionManyBags
                                   forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
collectEvVarsLPat
                                   forall a b. (a -> b) -> a -> b
$ 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       -> forall a. Bag a
emptyBag

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

type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
type instance Anno (HsOverLit (GhcPass p)) = SrcAnn NoEpAnns
type instance Anno ConLike = SrcSpanAnnN
type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA
type instance Anno RecFieldsDotDot = SrcSpan