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

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

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                      -- in module GHC.Hs.Extension
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE LambdaCase #-}

module GHC.Hs.Pat (
        Pat(..), LPat,
        ConPatTc (..),
        CoPat (..),
        ListPatTc(..),
        ConLikeP,

        HsConPatDetails, hsConPatArgs,
        HsRecFields(..), HsRecField'(..), LHsRecField',
        HsRecField, LHsRecField,
        HsRecUpdField, LHsRecUpdField,
        hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
        hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,

        mkPrefixConPat, mkCharLitPat, mkNilPat,

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

        collectEvVarsPat, collectEvVarsPats,

        pprParendLPat, pprConArgs
    ) where

import GHC.Prelude

import {-# SOURCE #-} GHC.Hs.Expr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)

-- friends:
import GHC.Hs.Binds
import GHC.Hs.Lit
import GHC.Hs.Extension
import GHC.Hs.Type
import GHC.Tc.Types.Evidence
import GHC.Types.Basic
-- 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)
import GHC.Driver.Session
import qualified GHC.LanguageExtensions as LangExt
-- libraries:
import Data.Data hiding (TyCon,Fixity)

type LPat p = XRec p Pat

-- | Pattern
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'

-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data Pat p
  =     ------------ Simple patterns ---------------
    WildPat     (XWildPat p)        -- ^ Wildcard Pattern
        -- The sole reason for a type on a WildPat is to
        -- support hsPatType :: Pat Id -> Type

       -- AZ:TODO above comment needs to be updated
  | VarPat      (XVarPat p)
                (Located (IdP p))  -- ^ Variable Pattern

                             -- See Note [Located RdrNames] in GHC.Hs.Expr
  | LazyPat     (XLazyPat p)
                (LPat p)                -- ^ Lazy Pattern
    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde'

    -- For details on above see note [Api annotations] in GHC.Parser.Annotation

  | AsPat       (XAsPat p)
                (Located (IdP p)) (LPat p)    -- ^ As pattern
    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt'

    -- For details on above see note [Api annotations] in GHC.Parser.Annotation

  | ParPat      (XParPat p)
                (LPat p)                -- ^ Parenthesised pattern
                                        -- See Note [Parens in HsSyn] in GHC.Hs.Expr
    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
    --                                    'GHC.Parser.Annotation.AnnClose' @')'@

    -- For details on above see note [Api annotations] in GHC.Parser.Annotation
  | BangPat     (XBangPat p)
                (LPat p)                -- ^ Bang pattern
    -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'

    -- For details on above see note [Api annotations] in GHC.Parser.Annotation

        ------------ Lists, tuples, arrays ---------------
  | ListPat     (XListPat p)
                [LPat p]
                   -- For OverloadedLists a Just (ty,fn) gives
                   -- overall type of the pattern, and the toList
-- function to convert the scrutinee to a list value

    -- ^ Syntactic List
    --
    -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@,
    --                                    'GHC.Parser.Annotation.AnnClose' @']'@

    -- For details on above see note [Api annotations] in GHC.Parser.Annotation

  | TuplePat    (XTuplePat p)
                  -- after typechecking, holds the types of the tuple components
                [LPat p]         -- Tuple sub-patterns
                Boxity           -- UnitPat is TuplePat []
        -- You might think that the post typechecking Type was redundant,
        -- because we can get the pattern type by getting the types of the
        -- sub-patterns.
        -- But it's essential
        --      data T a where
        --        T1 :: Int -> T Int
        --      f :: (T a, a) -> Int
        --      f (T1 x, z) = z
        -- When desugaring, we must generate
        --      f = /\a. \v::a.  case v of (t::T a, w::a) ->
        --                       case t of (T1 (x::Int)) ->
        -- Note the (w::a), NOT (w::Int), because we have not yet
        -- refined 'a' to Int.  So we must know that the second component
        -- of the tuple is of type 'a' not Int.  See selectMatchVar
        -- (June 14: I'm not sure this comment is right; the sub-patterns
        --           will be wrapped in CoPats, no?)
    -- ^ Tuple sub-patterns
    --
    -- - 'GHC.Parser.Annotation.AnnKeywordId' :
    --            'GHC.Parser.Annotation.AnnOpen' @'('@ or @'(#'@,
    --            'GHC.Parser.Annotation.AnnClose' @')'@ or  @'#)'@

  | SumPat      (XSumPat p)        -- after typechecker, types of the alternative
                (LPat p)           -- Sum sub-pattern
                ConTag             -- Alternative (one-based)
                Arity              -- Arity (INVARIANT: ≥ 2)
    -- ^ Anonymous sum pattern
    --
    -- - 'GHC.Parser.Annotation.AnnKeywordId' :
    --            'GHC.Parser.Annotation.AnnOpen' @'(#'@,
    --            'GHC.Parser.Annotation.AnnClose' @'#)'@

    -- For details on above see note [Api annotations] in GHC.Parser.Annotation

        ------------ Constructor patterns ---------------
  | ConPat {
        forall p. Pat p -> XConPat p
pat_con_ext :: XConPat p,
        forall p. Pat p -> Located (ConLikeP p)
pat_con     :: Located (ConLikeP p),
        forall p. Pat p -> HsConPatDetails p
pat_args    :: HsConPatDetails p
    }
    -- ^ Constructor Pattern

        ------------ View patterns ---------------
  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'

  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
  | ViewPat       (XViewPat p)     -- The overall type of the pattern
                                   -- (= the argument type of the view function)
                                   -- for hsPatType.
                  (LHsExpr p)
                  (LPat p)
    -- ^ View Pattern

        ------------ Pattern splices ---------------
  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@
  --        'GHC.Parser.Annotation.AnnClose' @')'@

  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
  | SplicePat       (XSplicePat p)
                    (HsSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)

        ------------ Literal and n+k patterns ---------------
  | LitPat          (XLitPat p)
                    (HsLit p)           -- ^ Literal Pattern
                                        -- Used for *non-overloaded* literal patterns:
                                        -- Int#, Char#, Int, Char, String, etc.

  | NPat                -- Natural Pattern
                        -- Used for all overloaded literals,
                        -- including overloaded strings with -XOverloadedStrings
                    (XNPat p)            -- Overall type of pattern. Might be
                                         -- different than the literal's type
                                         -- if (==) or negate changes the type
                    (Located (HsOverLit p))     -- ALWAYS positive
                    (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for
                                           -- negative patterns, Nothing
                                           -- otherwise
                    (SyntaxExpr p)       -- Equality checker, of type t->t->Bool

  -- ^ Natural Pattern
  --
  -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVal' @'+'@

  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
  | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern
                    (Located (IdP p))        -- n+k pattern
                    (Located (HsOverLit p))  -- It'll always be an HsIntegral
                    (HsOverLit p)            -- See Note [NPlusK patterns] in GHC.Tc.Gen.Pat
                     -- NB: This could be (PostTc ...), but that induced a
                     -- a new hs-boot file. Not worth it.

                    (SyntaxExpr p)   -- (>=) function, of type t1->t2->Bool
                    (SyntaxExpr p)   -- Name of '-' (see GHC.Rename.Env.lookupSyntax)
  -- ^ n+k pattern

        ------------ Pattern type signatures ---------------
  -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'

  -- For details on above see note [Api annotations] in GHC.Parser.Annotation
  | SigPat          (XSigPat p)             -- After typechecker: Type
                    (LPat p)                -- Pattern with a type signature
                    (HsPatSigType (NoGhcTc p)) --  Signature can bind both
                                               --  kind and type vars

    -- ^ Pattern with a type signature

  -- | Trees that Grow extension point for new constructors
  | XPat
      !(XXPat p)


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

data ListPatTc
  = ListPatTc
      Type                             -- The type of the elements
      (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax

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

type instance XVarPat  (GhcPass _) = NoExtField
type instance XLazyPat (GhcPass _) = NoExtField
type instance XAsPat   (GhcPass _) = NoExtField
type instance XParPat  (GhcPass _) = NoExtField
type instance XBangPat (GhcPass _) = NoExtField

-- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap
-- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for
-- `SyntaxExpr`
type instance XListPat GhcPs = NoExtField
type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)
type instance XListPat GhcTc = ListPatTc

type instance XTuplePat GhcPs = NoExtField
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]

type instance XConPat GhcPs = NoExtField
type instance XConPat GhcRn = NoExtField
type instance XConPat GhcTc = ConPatTc

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

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

type instance XSplicePat (GhcPass _) = NoExtField
type instance XLitPat    (GhcPass _) = NoExtField

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

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

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

type instance XXPat GhcPs = NoExtCon
type instance XXPat GhcRn = NoExtCon
type instance XXPat GhcTc = CoPat
  -- After typechecking, we add one extra constructor: CoPat

type family ConLikeP x

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

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


-- | Haskell Constructor Pattern Details
type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))

hsConPatArgs :: HsConPatDetails p -> [LPat p]
hsConPatArgs :: forall p. HsConPatDetails p -> [LPat p]
hsConPatArgs (PrefixCon [LPat p]
ps)   = [LPat p]
ps
hsConPatArgs (RecCon HsRecFields p (LPat p)
fs)      = (GenLocated SrcSpan (HsRecField' (FieldOcc p) (LPat p)) -> LPat p)
-> [GenLocated SrcSpan (HsRecField' (FieldOcc p) (LPat p))]
-> [LPat p]
forall a b. (a -> b) -> [a] -> [b]
map (HsRecField' (FieldOcc p) (LPat p) -> LPat p
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg (HsRecField' (FieldOcc p) (LPat p) -> LPat p)
-> (GenLocated SrcSpan (HsRecField' (FieldOcc p) (LPat p))
    -> HsRecField' (FieldOcc p) (LPat p))
-> GenLocated SrcSpan (HsRecField' (FieldOcc p) (LPat p))
-> LPat p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsRecField' (FieldOcc p) (LPat p))
-> HsRecField' (FieldOcc p) (LPat p)
forall l e. GenLocated l e -> e
unLoc) (HsRecFields p (LPat p)
-> [GenLocated SrcSpan (HsRecField' (FieldOcc p) (LPat p))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields p (LPat p)
fs)
hsConPatArgs (InfixCon LPat p
p1 LPat p
p2) = [LPat p
p1,LPat p
p2]

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

-- | 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'.
data CoPat
  = CoPat
    { -- | Coercion Pattern
      -- If co :: t1 ~ t2, p :: t2,
      -- then (CoPat co p) :: t1
      CoPat -> HsWrapper
co_cpt_wrap :: HsWrapper

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

    , -- | Type of whole pattern, t1
      CoPat -> Type
co_pat_ty :: Type
    }

-- | Haskell Record Fields
--
-- HsRecFields is used only for patterns and expressions (not data type
-- declarations)
data HsRecFields p arg         -- A bunch of record fields
                                --      { x = 3, y = True }
        -- Used for both expressions and patterns
  = HsRecFields { forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds   :: [LHsRecField p arg],
                  forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot :: Maybe (Located Int) }  -- Note [DotDot fields]
  deriving ((forall a b. (a -> b) -> HsRecFields p a -> HsRecFields p b)
-> (forall a b. a -> HsRecFields p b -> HsRecFields p a)
-> Functor (HsRecFields p)
forall a b. a -> HsRecFields p b -> HsRecFields p a
forall a b. (a -> b) -> HsRecFields p a -> HsRecFields p b
forall p a b. a -> HsRecFields p b -> HsRecFields p a
forall p a b. (a -> b) -> HsRecFields p a -> HsRecFields p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HsRecFields p b -> HsRecFields p a
$c<$ :: forall p a b. a -> HsRecFields p b -> HsRecFields p a
fmap :: forall a b. (a -> b) -> HsRecFields p a -> HsRecFields p b
$cfmap :: forall p a b. (a -> b) -> HsRecFields p a -> HsRecFields p b
Functor, (forall m. Monoid m => HsRecFields p m -> m)
-> (forall m a. Monoid m => (a -> m) -> HsRecFields p a -> m)
-> (forall m a. Monoid m => (a -> m) -> HsRecFields p a -> m)
-> (forall a b. (a -> b -> b) -> b -> HsRecFields p a -> b)
-> (forall a b. (a -> b -> b) -> b -> HsRecFields p a -> b)
-> (forall b a. (b -> a -> b) -> b -> HsRecFields p a -> b)
-> (forall b a. (b -> a -> b) -> b -> HsRecFields p a -> b)
-> (forall a. (a -> a -> a) -> HsRecFields p a -> a)
-> (forall a. (a -> a -> a) -> HsRecFields p a -> a)
-> (forall a. HsRecFields p a -> [a])
-> (forall a. HsRecFields p a -> Bool)
-> (forall a. HsRecFields p a -> Int)
-> (forall a. Eq a => a -> HsRecFields p a -> Bool)
-> (forall a. Ord a => HsRecFields p a -> a)
-> (forall a. Ord a => HsRecFields p a -> a)
-> (forall a. Num a => HsRecFields p a -> a)
-> (forall a. Num a => HsRecFields p a -> a)
-> Foldable (HsRecFields p)
forall a. Eq a => a -> HsRecFields p a -> Bool
forall a. Num a => HsRecFields p a -> a
forall a. Ord a => HsRecFields p a -> a
forall m. Monoid m => HsRecFields p m -> m
forall a. HsRecFields p a -> Bool
forall a. HsRecFields p a -> Int
forall a. HsRecFields p a -> [a]
forall a. (a -> a -> a) -> HsRecFields p a -> a
forall p a. Eq a => a -> HsRecFields p a -> Bool
forall p a. Num a => HsRecFields p a -> a
forall p a. Ord a => HsRecFields p a -> a
forall m a. Monoid m => (a -> m) -> HsRecFields p a -> m
forall p m. Monoid m => HsRecFields p m -> m
forall p a. HsRecFields p a -> Bool
forall p a. HsRecFields p a -> Int
forall p a. HsRecFields p a -> [a]
forall b a. (b -> a -> b) -> b -> HsRecFields p a -> b
forall a b. (a -> b -> b) -> b -> HsRecFields p a -> b
forall p a. (a -> a -> a) -> HsRecFields p a -> a
forall p m a. Monoid m => (a -> m) -> HsRecFields p a -> m
forall p b a. (b -> a -> b) -> b -> HsRecFields p a -> b
forall p a b. (a -> b -> b) -> b -> HsRecFields p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => HsRecFields p a -> a
$cproduct :: forall p a. Num a => HsRecFields p a -> a
sum :: forall a. Num a => HsRecFields p a -> a
$csum :: forall p a. Num a => HsRecFields p a -> a
minimum :: forall a. Ord a => HsRecFields p a -> a
$cminimum :: forall p a. Ord a => HsRecFields p a -> a
maximum :: forall a. Ord a => HsRecFields p a -> a
$cmaximum :: forall p a. Ord a => HsRecFields p a -> a
elem :: forall a. Eq a => a -> HsRecFields p a -> Bool
$celem :: forall p a. Eq a => a -> HsRecFields p a -> Bool
length :: forall a. HsRecFields p a -> Int
$clength :: forall p a. HsRecFields p a -> Int
null :: forall a. HsRecFields p a -> Bool
$cnull :: forall p a. HsRecFields p a -> Bool
toList :: forall a. HsRecFields p a -> [a]
$ctoList :: forall p a. HsRecFields p a -> [a]
foldl1 :: forall a. (a -> a -> a) -> HsRecFields p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> HsRecFields p a -> a
foldr1 :: forall a. (a -> a -> a) -> HsRecFields p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> HsRecFields p a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> HsRecFields p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> HsRecFields p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HsRecFields p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> HsRecFields p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HsRecFields p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> HsRecFields p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HsRecFields p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> HsRecFields p a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> HsRecFields p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> HsRecFields p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HsRecFields p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> HsRecFields p a -> m
fold :: forall m. Monoid m => HsRecFields p m -> m
$cfold :: forall p m. Monoid m => HsRecFields p m -> m
Foldable, Functor (HsRecFields p)
Foldable (HsRecFields p)
Functor (HsRecFields p)
-> Foldable (HsRecFields p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> HsRecFields p a -> f (HsRecFields p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    HsRecFields p (f a) -> f (HsRecFields p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> HsRecFields p a -> m (HsRecFields p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    HsRecFields p (m a) -> m (HsRecFields p a))
-> Traversable (HsRecFields p)
forall p. Functor (HsRecFields p)
forall p. Foldable (HsRecFields p)
forall p (m :: * -> *) a.
Monad m =>
HsRecFields p (m a) -> m (HsRecFields p a)
forall p (f :: * -> *) a.
Applicative f =>
HsRecFields p (f a) -> f (HsRecFields p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecFields p a -> m (HsRecFields p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecFields p a -> f (HsRecFields p b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
HsRecFields p (m a) -> m (HsRecFields p a)
forall (f :: * -> *) a.
Applicative f =>
HsRecFields p (f a) -> f (HsRecFields p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecFields p a -> m (HsRecFields p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecFields p a -> f (HsRecFields p b)
sequence :: forall (m :: * -> *) a.
Monad m =>
HsRecFields p (m a) -> m (HsRecFields p a)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
HsRecFields p (m a) -> m (HsRecFields p a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecFields p a -> m (HsRecFields p b)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecFields p a -> m (HsRecFields p b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HsRecFields p (f a) -> f (HsRecFields p a)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
HsRecFields p (f a) -> f (HsRecFields p a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecFields p a -> f (HsRecFields p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecFields p a -> f (HsRecFields p b)
Traversable)


-- Note [DotDot fields]
-- ~~~~~~~~~~~~~~~~~~~~
-- The rec_dotdot field means this:
--   Nothing => the normal case
--   Just n  => the group uses ".." notation,
--
-- In the latter case:
--
--   *before* renamer: rec_flds are exactly the n user-written fields
--
--   *after* renamer:  rec_flds includes *all* fields, with
--                     the first 'n' being the user-written ones
--                     and the remainder being 'filled in' implicitly

-- | Located Haskell Record Field
type LHsRecField' p arg = Located (HsRecField' p arg)

-- | Located Haskell Record Field
type LHsRecField  p arg = Located (HsRecField  p arg)

-- | Located Haskell Record Update Field
type LHsRecUpdField p   = Located (HsRecUpdField p)

-- | Haskell Record Field
type HsRecField    p arg = HsRecField' (FieldOcc p) arg

-- | Haskell Record Update Field
type HsRecUpdField p     = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)

-- | Haskell Record Field
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual',
--
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
data HsRecField' id arg = HsRecField {
        forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl :: Located id,
        forall id arg. HsRecField' id arg -> arg
hsRecFieldArg :: arg,           -- ^ Filled in by renamer when punning
        forall id arg. HsRecField' id arg -> Bool
hsRecPun      :: Bool           -- ^ Note [Punning]
  } deriving (Typeable (HsRecField' id arg)
Typeable (HsRecField' id arg)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> HsRecField' id arg
    -> c (HsRecField' id arg))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (HsRecField' id arg))
-> (HsRecField' id arg -> Constr)
-> (HsRecField' id arg -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (HsRecField' id arg)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (HsRecField' id arg)))
-> ((forall b. Data b => b -> b)
    -> HsRecField' id arg -> HsRecField' id arg)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> HsRecField' id arg -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HsRecField' id arg -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> HsRecField' id arg -> m (HsRecField' id arg))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HsRecField' id arg -> m (HsRecField' id arg))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HsRecField' id arg -> m (HsRecField' id arg))
-> Data (HsRecField' id arg)
HsRecField' id arg -> DataType
HsRecField' id arg -> Constr
(forall b. Data b => b -> b)
-> HsRecField' id arg -> HsRecField' id arg
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) -> HsRecField' id arg -> u
forall u. (forall d. Data d => d -> u) -> HsRecField' id arg -> [u]
forall {id} {arg}.
(Data id, Data arg) =>
Typeable (HsRecField' id arg)
forall id arg.
(Data id, Data arg) =>
HsRecField' id arg -> DataType
forall id arg. (Data id, Data arg) => HsRecField' id arg -> Constr
forall id arg.
(Data id, Data arg) =>
(forall b. Data b => b -> b)
-> HsRecField' id arg -> HsRecField' id arg
forall id arg u.
(Data id, Data arg) =>
Int -> (forall d. Data d => d -> u) -> HsRecField' id arg -> u
forall id arg u.
(Data id, Data arg) =>
(forall d. Data d => d -> u) -> HsRecField' id arg -> [u]
forall id arg r r'.
(Data id, Data arg) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
forall id arg r r'.
(Data id, Data arg) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
forall id arg (m :: * -> *).
(Data id, Data arg, Monad m) =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
forall id arg (m :: * -> *).
(Data id, Data arg, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
forall id arg (c :: * -> *).
(Data id, Data arg) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsRecField' id arg)
forall id arg (c :: * -> *).
(Data id, Data arg) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsRecField' id arg
-> c (HsRecField' id arg)
forall id arg (t :: * -> *) (c :: * -> *).
(Data id, Data arg, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HsRecField' id arg))
forall id arg (t :: * -> * -> *) (c :: * -> *).
(Data id, Data arg, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsRecField' id arg))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsRecField' id arg)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsRecField' id arg
-> c (HsRecField' id arg)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HsRecField' id arg))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsRecField' id arg))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
$cgmapMo :: forall id arg (m :: * -> *).
(Data id, Data arg, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
$cgmapMp :: forall id arg (m :: * -> *).
(Data id, Data arg, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
$cgmapM :: forall id arg (m :: * -> *).
(Data id, Data arg, Monad m) =>
(forall d. Data d => d -> m d)
-> HsRecField' id arg -> m (HsRecField' id arg)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsRecField' id arg -> u
$cgmapQi :: forall id arg u.
(Data id, Data arg) =>
Int -> (forall d. Data d => d -> u) -> HsRecField' id arg -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsRecField' id arg -> [u]
$cgmapQ :: forall id arg u.
(Data id, Data arg) =>
(forall d. Data d => d -> u) -> HsRecField' id arg -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
$cgmapQr :: forall id arg r r'.
(Data id, Data arg) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
$cgmapQl :: forall id arg r r'.
(Data id, Data arg) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsRecField' id arg -> r
gmapT :: (forall b. Data b => b -> b)
-> HsRecField' id arg -> HsRecField' id arg
$cgmapT :: forall id arg.
(Data id, Data arg) =>
(forall b. Data b => b -> b)
-> HsRecField' id arg -> HsRecField' id arg
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsRecField' id arg))
$cdataCast2 :: forall id arg (t :: * -> * -> *) (c :: * -> *).
(Data id, Data arg, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HsRecField' id arg))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HsRecField' id arg))
$cdataCast1 :: forall id arg (t :: * -> *) (c :: * -> *).
(Data id, Data arg, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HsRecField' id arg))
dataTypeOf :: HsRecField' id arg -> DataType
$cdataTypeOf :: forall id arg.
(Data id, Data arg) =>
HsRecField' id arg -> DataType
toConstr :: HsRecField' id arg -> Constr
$ctoConstr :: forall id arg. (Data id, Data arg) => HsRecField' id arg -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsRecField' id arg)
$cgunfold :: forall id arg (c :: * -> *).
(Data id, Data arg) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HsRecField' id arg)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsRecField' id arg
-> c (HsRecField' id arg)
$cgfoldl :: forall id arg (c :: * -> *).
(Data id, Data arg) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsRecField' id arg
-> c (HsRecField' id arg)
Data, (forall a b. (a -> b) -> HsRecField' id a -> HsRecField' id b)
-> (forall a b. a -> HsRecField' id b -> HsRecField' id a)
-> Functor (HsRecField' id)
forall a b. a -> HsRecField' id b -> HsRecField' id a
forall a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
forall id a b. a -> HsRecField' id b -> HsRecField' id a
forall id a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HsRecField' id b -> HsRecField' id a
$c<$ :: forall id a b. a -> HsRecField' id b -> HsRecField' id a
fmap :: forall a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
$cfmap :: forall id a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
Functor, (forall m. Monoid m => HsRecField' id m -> m)
-> (forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m)
-> (forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m)
-> (forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b)
-> (forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b)
-> (forall b a. (b -> a -> b) -> b -> HsRecField' id a -> b)
-> (forall b a. (b -> a -> b) -> b -> HsRecField' id a -> b)
-> (forall a. (a -> a -> a) -> HsRecField' id a -> a)
-> (forall a. (a -> a -> a) -> HsRecField' id a -> a)
-> (forall a. HsRecField' id a -> [a])
-> (forall a. HsRecField' id a -> Bool)
-> (forall a. HsRecField' id a -> Int)
-> (forall a. Eq a => a -> HsRecField' id a -> Bool)
-> (forall a. Ord a => HsRecField' id a -> a)
-> (forall a. Ord a => HsRecField' id a -> a)
-> (forall a. Num a => HsRecField' id a -> a)
-> (forall a. Num a => HsRecField' id a -> a)
-> Foldable (HsRecField' id)
forall a. Eq a => a -> HsRecField' id a -> Bool
forall a. Num a => HsRecField' id a -> a
forall a. Ord a => HsRecField' id a -> a
forall m. Monoid m => HsRecField' id m -> m
forall a. HsRecField' id a -> Bool
forall a. HsRecField' id a -> Int
forall a. HsRecField' id a -> [a]
forall a. (a -> a -> a) -> HsRecField' id a -> a
forall id a. Eq a => a -> HsRecField' id a -> Bool
forall id a. Num a => HsRecField' id a -> a
forall id a. Ord a => HsRecField' id a -> a
forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m
forall id m. Monoid m => HsRecField' id m -> m
forall id arg. HsRecField' id arg -> Bool
forall id a. HsRecField' id a -> Int
forall id a. HsRecField' id a -> [a]
forall b a. (b -> a -> b) -> b -> HsRecField' id a -> b
forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b
forall id a. (a -> a -> a) -> HsRecField' id a -> a
forall id m a. Monoid m => (a -> m) -> HsRecField' id a -> m
forall id b a. (b -> a -> b) -> b -> HsRecField' id a -> b
forall id a b. (a -> b -> b) -> b -> HsRecField' id a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => HsRecField' id a -> a
$cproduct :: forall id a. Num a => HsRecField' id a -> a
sum :: forall a. Num a => HsRecField' id a -> a
$csum :: forall id a. Num a => HsRecField' id a -> a
minimum :: forall a. Ord a => HsRecField' id a -> a
$cminimum :: forall id a. Ord a => HsRecField' id a -> a
maximum :: forall a. Ord a => HsRecField' id a -> a
$cmaximum :: forall id a. Ord a => HsRecField' id a -> a
elem :: forall a. Eq a => a -> HsRecField' id a -> Bool
$celem :: forall id a. Eq a => a -> HsRecField' id a -> Bool
length :: forall a. HsRecField' id a -> Int
$clength :: forall id a. HsRecField' id a -> Int
null :: forall a. HsRecField' id a -> Bool
$cnull :: forall id arg. HsRecField' id arg -> Bool
toList :: forall a. HsRecField' id a -> [a]
$ctoList :: forall id a. HsRecField' id a -> [a]
foldl1 :: forall a. (a -> a -> a) -> HsRecField' id a -> a
$cfoldl1 :: forall id a. (a -> a -> a) -> HsRecField' id a -> a
foldr1 :: forall a. (a -> a -> a) -> HsRecField' id a -> a
$cfoldr1 :: forall id a. (a -> a -> a) -> HsRecField' id a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> HsRecField' id a -> b
$cfoldl' :: forall id b a. (b -> a -> b) -> b -> HsRecField' id a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HsRecField' id a -> b
$cfoldl :: forall id b a. (b -> a -> b) -> b -> HsRecField' id a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b
$cfoldr' :: forall id a b. (a -> b -> b) -> b -> HsRecField' id a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b
$cfoldr :: forall id a b. (a -> b -> b) -> b -> HsRecField' id a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m
$cfoldMap' :: forall id m a. Monoid m => (a -> m) -> HsRecField' id a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m
$cfoldMap :: forall id m a. Monoid m => (a -> m) -> HsRecField' id a -> m
fold :: forall m. Monoid m => HsRecField' id m -> m
$cfold :: forall id m. Monoid m => HsRecField' id m -> m
Foldable, Functor (HsRecField' id)
Foldable (HsRecField' id)
Functor (HsRecField' id)
-> Foldable (HsRecField' id)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> HsRecField' id a -> f (HsRecField' id b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    HsRecField' id (f a) -> f (HsRecField' id a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> HsRecField' id a -> m (HsRecField' id b))
-> (forall (m :: * -> *) a.
    Monad m =>
    HsRecField' id (m a) -> m (HsRecField' id a))
-> Traversable (HsRecField' id)
forall id. Functor (HsRecField' id)
forall id. Foldable (HsRecField' id)
forall id (m :: * -> *) a.
Monad m =>
HsRecField' id (m a) -> m (HsRecField' id a)
forall id (f :: * -> *) a.
Applicative f =>
HsRecField' id (f a) -> f (HsRecField' id a)
forall id (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecField' id a -> m (HsRecField' id b)
forall id (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
HsRecField' id (m a) -> m (HsRecField' id a)
forall (f :: * -> *) a.
Applicative f =>
HsRecField' id (f a) -> f (HsRecField' id a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecField' id a -> m (HsRecField' id b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id b)
sequence :: forall (m :: * -> *) a.
Monad m =>
HsRecField' id (m a) -> m (HsRecField' id a)
$csequence :: forall id (m :: * -> *) a.
Monad m =>
HsRecField' id (m a) -> m (HsRecField' id a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecField' id a -> m (HsRecField' id b)
$cmapM :: forall id (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecField' id a -> m (HsRecField' id b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HsRecField' id (f a) -> f (HsRecField' id a)
$csequenceA :: forall id (f :: * -> *) a.
Applicative f =>
HsRecField' id (f a) -> f (HsRecField' id a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id b)
$ctraverse :: forall id (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id b)
Traversable)


-- Note [Punning]
-- ~~~~~~~~~~~~~~
-- If you write T { x, y = v+1 }, the HsRecFields will be
--      HsRecField x x True ...
--      HsRecField y (v+1) False ...
-- That is, for "punned" field x is expanded (in the renamer)
-- to x=x; but with a punning flag so we can detect it later
-- (e.g. when pretty printing)
--
-- If the original field was qualified, we un-qualify it, thus
--    T { A.x } means T { A.x = x }


-- Note [HsRecField and HsRecUpdField]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-- A HsRecField (used for record construction and pattern matching)
-- contains an unambiguous occurrence of a field (i.e. a FieldOcc).
-- We can't just store the Name, because thanks to
-- DuplicateRecordFields this may not correspond to the label the user
-- wrote.
--
-- A HsRecUpdField (used for record update) contains a potentially
-- ambiguous occurrence of a field (an AmbiguousFieldOcc).  The
-- renamer will fill in the selector function if it can, but if the
-- selector is ambiguous the renamer will defer to the typechecker.
-- After the typechecker, a unique selector will have been determined.
--
-- The renamer produces an Unambiguous result if it can, rather than
-- just doing the lookup in the typechecker, so that completely
-- unambiguous updates can be represented by 'GHC.HsToCore.Quote.repUpdFields'.
--
-- For example, suppose we have:
--
--     data S = MkS { x :: Int }
--     data T = MkT { x :: Int }
--
--     f z = (z { x = 3 }) :: S
--
-- The parsed HsRecUpdField corresponding to the record update will have:
--
--     hsRecFieldLbl = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName
--
-- After the renamer, this will become:
--
--     hsRecFieldLbl = Ambiguous   "x" noExtField :: AmbiguousFieldOcc Name
--
-- (note that the Unambiguous constructor is not type-correct here).
-- The typechecker will determine the particular selector:
--
--     hsRecFieldLbl = Unambiguous "x" $sel:x:MkS  :: AmbiguousFieldOcc Id
--
-- See also Note [Disambiguating record fields] in GHC.Tc.Gen.Expr.

hsRecFields :: HsRecFields p arg -> [XCFieldOcc p]
hsRecFields :: forall p arg. HsRecFields p arg -> [XCFieldOcc p]
hsRecFields HsRecFields p arg
rbinds = (GenLocated SrcSpan (HsRecField p arg) -> XCFieldOcc p)
-> [GenLocated SrcSpan (HsRecField p arg)] -> [XCFieldOcc p]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpan (XCFieldOcc p) -> XCFieldOcc p
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (XCFieldOcc p) -> XCFieldOcc p)
-> (GenLocated SrcSpan (HsRecField p arg)
    -> GenLocated SrcSpan (XCFieldOcc p))
-> GenLocated SrcSpan (HsRecField p arg)
-> XCFieldOcc p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField p arg -> GenLocated SrcSpan (XCFieldOcc p)
forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel (HsRecField p arg -> GenLocated SrcSpan (XCFieldOcc p))
-> (GenLocated SrcSpan (HsRecField p arg) -> HsRecField p arg)
-> GenLocated SrcSpan (HsRecField p arg)
-> GenLocated SrcSpan (XCFieldOcc p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsRecField p arg) -> HsRecField p arg
forall l e. GenLocated l e -> e
unLoc) (HsRecFields p arg -> [GenLocated SrcSpan (HsRecField p arg)]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields p arg
rbinds)

-- Probably won't typecheck at once, things have changed :/
hsRecFieldsArgs :: HsRecFields p arg -> [arg]
hsRecFieldsArgs :: forall p a. HsRecFields p a -> [a]
hsRecFieldsArgs HsRecFields p arg
rbinds = (GenLocated SrcSpan (HsRecField' (FieldOcc p) arg) -> arg)
-> [GenLocated SrcSpan (HsRecField' (FieldOcc p) arg)] -> [arg]
forall a b. (a -> b) -> [a] -> [b]
map (HsRecField' (FieldOcc p) arg -> arg
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg (HsRecField' (FieldOcc p) arg -> arg)
-> (GenLocated SrcSpan (HsRecField' (FieldOcc p) arg)
    -> HsRecField' (FieldOcc p) arg)
-> GenLocated SrcSpan (HsRecField' (FieldOcc p) arg)
-> arg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsRecField' (FieldOcc p) arg)
-> HsRecField' (FieldOcc p) arg
forall l e. GenLocated l e -> e
unLoc) (HsRecFields p arg
-> [GenLocated SrcSpan (HsRecField' (FieldOcc p) arg)]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields p arg
rbinds)

hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel :: forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel = (FieldOcc pass -> XCFieldOcc pass)
-> GenLocated SrcSpan (FieldOcc pass)
-> GenLocated SrcSpan (XCFieldOcc pass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldOcc pass -> XCFieldOcc pass
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc (GenLocated SrcSpan (FieldOcc pass)
 -> GenLocated SrcSpan (XCFieldOcc pass))
-> (HsRecField' (FieldOcc pass) arg
    -> GenLocated SrcSpan (FieldOcc pass))
-> HsRecField' (FieldOcc pass) arg
-> GenLocated SrcSpan (XCFieldOcc pass)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField' (FieldOcc pass) arg
-> GenLocated SrcSpan (FieldOcc pass)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl

hsRecFieldId :: HsRecField GhcTc arg -> Located Id
hsRecFieldId :: forall arg. HsRecField GhcTc arg -> Located TyVar
hsRecFieldId = HsRecField' (FieldOcc GhcTc) arg -> Located TyVar
forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel

hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr :: forall (p :: Pass). HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr = (AmbiguousFieldOcc (GhcPass p) -> RdrName)
-> GenLocated SrcSpan (AmbiguousFieldOcc (GhcPass p))
-> Located RdrName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AmbiguousFieldOcc (GhcPass p) -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc (GenLocated SrcSpan (AmbiguousFieldOcc (GhcPass p))
 -> Located RdrName)
-> (HsRecField'
      (AmbiguousFieldOcc (GhcPass p)) (LHsExpr (GhcPass p))
    -> GenLocated SrcSpan (AmbiguousFieldOcc (GhcPass p)))
-> HsRecField'
     (AmbiguousFieldOcc (GhcPass p)) (LHsExpr (GhcPass p))
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField' (AmbiguousFieldOcc (GhcPass p)) (LHsExpr (GhcPass p))
-> GenLocated SrcSpan (AmbiguousFieldOcc (GhcPass p))
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl

hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
hsRecUpdFieldId :: forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located TyVar
hsRecUpdFieldId = (FieldOcc GhcTc -> TyVar)
-> GenLocated SrcSpan (FieldOcc GhcTc) -> Located TyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldOcc GhcTc -> TyVar
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc (GenLocated SrcSpan (FieldOcc GhcTc) -> Located TyVar)
-> (HsRecField' (AmbiguousFieldOcc GhcTc) arg
    -> GenLocated SrcSpan (FieldOcc GhcTc))
-> HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> Located TyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> GenLocated SrcSpan (FieldOcc GhcTc)
forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> GenLocated SrcSpan (FieldOcc GhcTc)
hsRecUpdFieldOcc

hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc :: forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> GenLocated SrcSpan (FieldOcc GhcTc)
hsRecUpdFieldOcc = (AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc)
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
-> GenLocated SrcSpan (FieldOcc GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc (GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
 -> GenLocated SrcSpan (FieldOcc GhcTc))
-> (HsRecField' (AmbiguousFieldOcc GhcTc) arg
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
-> HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> GenLocated SrcSpan (FieldOcc GhcTc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl


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

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

-- | Print with type info if -dppr-debug is on
pprPatBndr :: OutputableBndr name => name -> SDoc
pprPatBndr :: forall name. OutputableBndr name => name -> SDoc
pprPatBndr name
var
  = (Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
      Bool
True -> SDoc -> SDoc
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 name. OutputableBndr name => name -> 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 SrcSpan (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpan (Pat (GhcPass p))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (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
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 XXPat GhcTc
ext <- Pat (GhcPass p)
pat
      , CoPat {} <- XXPat GhcTc
ext
      = 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)
_ Located (IdP (GhcPass p))
lvar)          = IdGhcP p -> SDoc
forall name. OutputableBndr name => name -> SDoc
pprPatBndr (Located (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc Located (IdGhcP p)
Located (IdP (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
<> 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
char Char
'!' SDoc -> SDoc -> SDoc
<> 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)
_ Located (IdP (GhcPass p))
name LPat (GhcPass p)
pat)       = [SDoc] -> SDoc
hcat [IdGhcP p -> SDoc
forall name. OutputableBndr name => name -> SDoc
pprPrefixOcc (Located (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc Located (IdGhcP p)
Located (IdP (GhcPass p))
name), Char -> SDoc
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
hcat [LHsExpr (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
LHsExpr (GhcPass p) -> SDoc
pprLExpr LHsExpr (GhcPass p)
expr, String -> SDoc
text String
" -> ", Located (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat (GhcPass p))
LPat (GhcPass p)
pat]
pprPat (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
pat)           = SDoc -> SDoc
parens (Located (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat (GhcPass p))
LPat (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)
_ Located (HsOverLit (GhcPass p))
l Maybe (SyntaxExpr (GhcPass p))
Nothing  SyntaxExpr (GhcPass p)
_)    = Located (HsOverLit (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (HsOverLit (GhcPass p))
l
pprPat (NPat XNPat (GhcPass p)
_ Located (HsOverLit (GhcPass p))
l (Just SyntaxExpr (GhcPass p)
_) SyntaxExpr (GhcPass p)
_)    = Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> Located (HsOverLit (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (HsOverLit (GhcPass p))
l
pprPat (NPlusKPat XNPlusKPat (GhcPass p)
_ Located (IdP (GhcPass p))
n Located (HsOverLit (GhcPass p))
k HsOverLit (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ SyntaxExpr (GhcPass p)
_)  = [SDoc] -> SDoc
hcat [Located (IdGhcP p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (IdGhcP p)
Located (IdP (GhcPass p))
n, Char -> SDoc
char Char
'+', Located (HsOverLit (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (HsOverLit (GhcPass p))
k]
pprPat (SplicePat XSplicePat (GhcPass p)
_ HsSplice (GhcPass p)
splice)     = HsSplice (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsSplice (GhcPass p) -> SDoc
pprSplice HsSplice (GhcPass p)
splice
pprPat (SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
ty)        = Located (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat (GhcPass p))
LPat (GhcPass p)
pat SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> SDoc
ppr_ty
  where ppr_ty :: SDoc
ppr_ty = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
                   GhcPass p
GhcPs -> HsPatSigType (GhcPass 'Parsed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType (GhcPass 'Parsed)
HsPatSigType (NoGhcTc (GhcPass p))
ty
                   GhcPass p
GhcRn -> HsPatSigType (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType (GhcPass 'Renamed)
HsPatSigType (NoGhcTc (GhcPass p))
ty
                   GhcPass p
GhcTc -> HsPatSigType (GhcPass 'Renamed) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsPatSigType (GhcPass 'Renamed)
HsPatSigType (NoGhcTc (GhcPass p))
ty
pprPat (ListPat XListPat (GhcPass p)
_ [LPat (GhcPass p)]
pats)         = SDoc -> SDoc
brackets ([Located (Pat (GhcPass p))] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [Located (Pat (GhcPass p))]
[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 -> Int -> String
mkTupleStr Boxity
Boxed 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) ((Located (Pat (GhcPass p)) -> SDoc)
-> [Located (Pat (GhcPass p))] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Located (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Located (Pat (GhcPass p))]
[LPat (GhcPass p)]
pats)
pprPat (SumPat XSumPat (GhcPass p)
_ LPat (GhcPass p)
pat Int
alt Int
arity) = SDoc -> SDoc
sumParens ((Located (Pat (GhcPass p)) -> SDoc)
-> Located (Pat (GhcPass p)) -> Int -> Int -> SDoc
forall a. (a -> SDoc) -> a -> Int -> Int -> SDoc
pprAlternative Located (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat (GhcPass p))
LPat (GhcPass p)
pat Int
alt Int
arity)
pprPat (ConPat { pat_con :: forall p. Pat p -> Located (ConLikeP p)
pat_con = Located (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) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc Located RdrName
Located (ConLikeP (GhcPass p))
con) HsConPatDetails (GhcPass p)
details
      GhcPass p
GhcRn -> Name -> HsConPatDetails (GhcPass p) -> SDoc
forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (GenLocated SrcSpan Name -> Name
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan Name
Located (ConLikeP (GhcPass p))
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) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (Located ConLike -> ConLike
forall l e. GenLocated l e -> e
unLoc Located ConLike
Located (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
          Located ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located ConLike
Located (ConLikeP (GhcPass p))
con
            SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [ [SDoc] -> SDoc
hsep ((TyVar -> SDoc) -> [TyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> SDoc
forall name. OutputableBndr name => name -> 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
<+> HsConPatDetails (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId 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)
ConPatTc
ext
pprPat (XPat XXPat (GhcPass p)
ext) = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
  GhcPs -> noExtCon ext
  GhcRn -> noExtCon ext
#endif
  GhcPass p
GhcTc -> 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
    where CoPat HsWrapper
co Pat GhcTc
pat Type
_ = XXPat (GhcPass p)
CoPat
ext

pprUserCon :: (OutputableBndr con, OutputableBndrId p)
           => con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon :: forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon con
c (InfixCon LPat (GhcPass p)
p1 LPat (GhcPass p)
p2) = Located (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat (GhcPass p))
LPat (GhcPass p)
p1 SDoc -> SDoc -> SDoc
<+> con -> SDoc
forall name. OutputableBndr name => name -> SDoc
pprInfixOcc con
c SDoc -> SDoc -> SDoc
<+> Located (Pat (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat (GhcPass p))
LPat (GhcPass p)
p2
pprUserCon con
c HsConDetails
  (LPat (GhcPass p)) (HsRecFields (GhcPass p) (LPat (GhcPass p)))
details          = con -> SDoc
forall name. OutputableBndr name => name -> SDoc
pprPrefixOcc con
c SDoc -> SDoc -> SDoc
<+> HsConDetails
  (LPat (GhcPass p)) (HsRecFields (GhcPass p) (LPat (GhcPass p)))
-> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs HsConDetails
  (LPat (GhcPass p)) (HsRecFields (GhcPass p) (LPat (GhcPass p)))
details

pprConArgs :: (OutputableBndrId p)
           => HsConPatDetails (GhcPass p) -> SDoc
pprConArgs :: forall (p :: Pass).
OutputableBndrId p =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs (PrefixCon [LPat (GhcPass p)]
pats) = [SDoc] -> SDoc
fsep ((Located (Pat (GhcPass p)) -> SDoc)
-> [Located (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) [Located (Pat (GhcPass p))]
[LPat (GhcPass p)]
pats)
pprConArgs (InfixCon LPat (GhcPass p)
p1 LPat (GhcPass p)
p2) = [SDoc] -> SDoc
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) (Located (Pat (GhcPass p))) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsRecFields (GhcPass p) (Located (Pat (GhcPass p)))
HsRecFields (GhcPass p) (LPat (GhcPass p))
rpats

instance (Outputable arg)
      => 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 = [LHsRecField p arg]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot = Maybe (Located Int)
Nothing })
        = SDoc -> SDoc
braces ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((LHsRecField p arg -> SDoc) -> [LHsRecField p arg] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LHsRecField p arg -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsRecField p arg]
flds)))
  ppr (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [LHsRecField p arg]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot = Just (Located Int -> Int
forall l e. GenLocated l e -> e
unLoc -> Int
n) })
        = SDoc -> SDoc
braces ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((LHsRecField p arg -> SDoc) -> [LHsRecField p arg] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LHsRecField p arg -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> [LHsRecField p arg] -> [LHsRecField p arg]
forall a. Int -> [a] -> [a]
take Int
n [LHsRecField p arg]
flds) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc
dotdot])))
        where
          dotdot :: SDoc
dotdot = String -> SDoc
text String
".." SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
whenPprDebug ([LHsRecField p arg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> [LHsRecField p arg] -> [LHsRecField p arg]
forall a. Int -> [a] -> [a]
drop Int
n [LHsRecField p arg]
flds))

instance (Outputable p, Outputable arg)
      => Outputable (HsRecField' p arg) where
  ppr :: HsRecField' p arg -> SDoc
ppr (HsRecField { hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl = Located p
f, hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecFieldArg = arg
arg,
                    hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun = Bool
pun })
    = Located p -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located p
f SDoc -> SDoc -> SDoc
<+> (Bool -> SDoc -> SDoc
ppUnless Bool
pun (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
equals SDoc -> SDoc -> SDoc
<+> arg -> SDoc
forall a. Outputable a => a -> SDoc
ppr arg
arg)


{-
************************************************************************
*                                                                      *
*              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 -> Located (Pat GhcTc)
forall e. e -> Located e
noLoc (Pat GhcTc -> Located (Pat GhcTc))
-> Pat GhcTc -> Located (Pat GhcTc)
forall a b. (a -> b) -> a -> b
$ ConPat :: forall p.
XConPat p -> Located (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat { pat_con :: Located (ConLikeP GhcTc)
pat_con = ConLike -> Located ConLike
forall e. e -> Located e
noLoc (DataCon -> ConLike
RealDataCon DataCon
dc)
                   , pat_args :: HsConPatDetails GhcTc
pat_args = [Located (Pat GhcTc)]
-> HsConDetails
     (Located (Pat GhcTc)) (HsRecFields GhcTc (Located (Pat GhcTc)))
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon [Located (Pat GhcTc)]
[LPat GhcTc]
pats
                   , pat_con_ext :: XConPat GhcTc
pat_con_ext = ConPatTc :: [Type] -> [TyVar] -> [TyVar] -> TcEvBinds -> HsWrapper -> ConPatTc
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 -> Located (Pat GhcTc)
forall e. e -> Located e
noLoc (Pat GhcTc -> Located (Pat GhcTc))
-> Pat GhcTc -> Located (Pat GhcTc)
forall a b. (a -> b) -> a -> b
$ XLitPat GhcTc -> HsLit GhcTc -> Pat GhcTc
forall p. XLitPat p -> HsLit p -> Pat p
LitPat NoExtField
XLitPat GhcTc
noExtField (XHsCharPrim GhcTc -> Char -> HsLit GhcTc
forall x. XHsCharPrim x -> Char -> HsLit x
HsCharPrim SourceText
XHsCharPrim GhcTc
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 SrcSpan (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpan (Pat (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (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 (GhcPass p) -> 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 :: forall (p :: Pass). HsBind (GhcPass p) -> Bool
looksLazyPatBind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat (GhcPass p)
p })
  = LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat (GhcPass p)
p
looksLazyPatBind (AbsBinds { abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
abs_binds = LHsBinds (GhcPass p)
binds })
  = (GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p)) -> Bool)
-> LHsBinds (GhcPass p) -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
anyBag (HsBindLR (GhcPass p) (GhcPass p) -> Bool
forall (p :: Pass). HsBind (GhcPass p) -> Bool
looksLazyPatBind (HsBindLR (GhcPass p) (GhcPass p) -> Bool)
-> (GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p))
    -> HsBindLR (GhcPass p) (GhcPass p))
-> GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p))
-> HsBindLR (GhcPass p) (GhcPass p)
forall l e. GenLocated l e -> e
unLoc) LHsBinds (GhcPass p)
binds
looksLazyPatBind HsBindLR (GhcPass p) (GhcPass p)
_
  = 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 SrcSpan (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpan (Pat (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (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)
_ Located (IdP (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

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 =
    Bool -> XRec (GhcPass p) Pat -> Bool
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 (Pat (GhcPass p) -> Bool)
-> (GenLocated SrcSpan (Pat (GhcPass p)) -> Pat (GhcPass p))
-> GenLocated SrcSpan (Pat (GhcPass p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (Pat (GhcPass p)) -> Pat (GhcPass p)
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
      = Bool -> LPat (GhcPass p) -> Bool
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)
_ LPat (GhcPass p)
pat)      = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
    go (AsPat XAsPat (GhcPass p)
_ Located (IdP (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
_) = (GenLocated SrcSpan (Pat (GhcPass p)) -> Bool)
-> [GenLocated SrcSpan (Pat (GhcPass p))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpan (Pat (GhcPass p)) -> Bool
LPat (GhcPass p) -> Bool
goL [GenLocated SrcSpan (Pat (GhcPass p))]
[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 -> Located (ConLikeP p)
pat_con  = Located (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 Located (ConLikeP (GhcPass p))
con of
         L SrcSpan
_ (PatSynCon PatSyn
_pat)  -> Bool
False -- Conservative
         L SrcSpan
_ (RealDataCon DataCon
con) ->
           Maybe DataCon -> Bool
forall a. Maybe a -> Bool
isJust (TyCon -> Maybe DataCon
tyConSingleDataCon_maybe (DataCon -> TyCon
dataConTyCon DataCon
con))
           -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because
           -- the latter is false of existentials. See #4439
           Bool -> Bool -> Bool
&& (Located (Pat GhcTc) -> Bool) -> [Located (Pat GhcTc)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Located (Pat GhcTc) -> Bool
LPat (GhcPass p) -> Bool
goL (HsConPatDetails (GhcPass p) -> [LPat (GhcPass p)]
forall 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 -> noExtCon ext
      GhcRn -> noExtCon ext
#endif
      GhcPass p
GhcTc -> Pat (GhcPass p) -> Bool
go Pat (GhcPass p)
Pat GhcTc
pat
        where CoPat HsWrapper
_ Pat GhcTc
pat Type
_ = XXPat (GhcPass p)
CoPat
ext

-- | 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 SrcSpan (Pat (GhcPass x)) -> Pat (GhcPass x)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (Pat (GhcPass x))
LPat (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)
_ Located (IdP (GhcPass x))
x -> IdGhcP x -> Maybe (IdGhcP x)
forall a. a -> Maybe a
Just (GenLocated SrcSpan (IdGhcP x) -> IdGhcP x
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (IdGhcP x)
Located (IdP (GhcPass x))
x)
  Pat (GhcPass x)
_ -> Maybe (IdP (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 = Pat (GhcPass p) -> Bool
go
  where
    go :: Pat (GhcPass p) -> Bool
    go :: Pat (GhcPass p) -> Bool
go (NPlusKPat {})    = PprPrec
p PprPrec -> PprPrec -> Bool
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 p)
ds})
                         = PprPrec
-> HsConDetails
     (Located (Pat (GhcPass p)))
     (HsRecFields (GhcPass p) (Located (Pat (GhcPass p))))
-> Bool
forall a b. PprPrec -> HsConDetails a b -> Bool
conPatNeedsParens PprPrec
p HsConDetails
  (Located (Pat (GhcPass p)))
  (HsRecFields (GhcPass p) (Located (Pat (GhcPass p))))
HsConPatDetails (GhcPass p)
ds
    go (SigPat {})       = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
sigPrec
    go (ViewPat {})      = Bool
True
    go (XPat XXPat (GhcPass p)
ext)        = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> NoExtCon -> Bool
forall a. NoExtCon -> a
noExtCon NoExtCon
XXPat (GhcPass p)
ext
      GhcPass p
GhcRn -> NoExtCon -> Bool
forall a. NoExtCon -> a
noExtCon NoExtCon
XXPat (GhcPass p)
ext
      GhcPass p
GhcTc -> Pat (GhcPass p) -> Bool
go Pat (GhcPass p)
Pat GhcTc
inner
        where CoPat HsWrapper
_ Pat GhcTc
inner Type
_ = XXPat (GhcPass p)
CoPat
ext
    go (WildPat {})      = Bool
False
    go (VarPat {})       = Bool
False
    go (LazyPat {})      = Bool
False
    go (BangPat {})      = Bool
False
    go (ParPat {})       = Bool
False
    go (AsPat {})        = Bool
False
    go (TuplePat {})     = Bool
False
    go (SumPat {})       = Bool
False
    go (ListPat {})      = Bool
False
    go (LitPat XLitPat (GhcPass p)
_ HsLit (GhcPass p)
l)      = PprPrec -> HsLit (GhcPass p) -> Bool
forall x. PprPrec -> HsLit x -> Bool
hsLitNeedsParens PprPrec
p HsLit (GhcPass p)
l
    go (NPat XNPat (GhcPass p)
_ Located (HsOverLit (GhcPass p))
lol Maybe (SyntaxExpr (GhcPass p))
_ SyntaxExpr (GhcPass p)
_)  = PprPrec -> HsOverLit (GhcPass p) -> Bool
forall x. PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens PprPrec
p (Located (HsOverLit (GhcPass p)) -> HsOverLit (GhcPass p)
forall l e. GenLocated l e -> e
unLoc Located (HsOverLit (GhcPass p))
lol)

-- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@
-- needs parentheses under precedence @p@.
conPatNeedsParens :: PprPrec -> HsConDetails a b -> Bool
conPatNeedsParens :: forall a b. PprPrec -> HsConDetails a b -> Bool
conPatNeedsParens PprPrec
p = HsConDetails a b -> Bool
go
  where
    go :: HsConDetails a b -> Bool
go (PrefixCon [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 (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
args)
    go (InfixCon {})    = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
>= PprPrec
opPrec
    go (RecCon {})      = Bool
False

-- | @'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 SrcSpan
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 = SrcSpan -> Pat (GhcPass p) -> GenLocated SrcSpan (Pat (GhcPass p))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XParPat (GhcPass p) -> LPat (GhcPass p) -> Pat (GhcPass p)
forall p. XParPat p -> LPat p -> Pat p
ParPat NoExtField
XParPat (GhcPass p)
noExtField 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)
-> (Located (Pat GhcTc) -> Pat GhcTc)
-> Located (Pat GhcTc)
-> Bag TyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (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
_ Located (IdP 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
$ (Located (Pat GhcTc) -> Bag TyVar)
-> [Located (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat GhcTc) -> Bag TyVar
LPat GhcTc -> Bag TyVar
collectEvVarsLPat [Located (Pat GhcTc)]
[LPat 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
$ (Located (Pat GhcTc) -> Bag TyVar)
-> [Located (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat GhcTc) -> Bag TyVar
LPat GhcTc -> Bag TyVar
collectEvVarsLPat [Located (Pat GhcTc)]
[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
        }
      }
                     -> 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
$ (Located (Pat GhcTc) -> Bag TyVar)
-> [Located (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat GhcTc) -> Bag TyVar
LPat GhcTc -> Bag TyVar
collectEvVarsLPat
                                   ([Located (Pat GhcTc)] -> [Bag TyVar])
-> [Located (Pat GhcTc)] -> [Bag TyVar]
forall a b. (a -> b) -> a -> b
$ HsConPatDetails GhcTc -> [LPat GhcTc]
forall 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 (CoPat HsWrapper
_ Pat GhcTc
p Type
_) -> Pat GhcTc -> Bag TyVar
collectEvVarsPat  Pat GhcTc
p
    Pat GhcTc
_other_pat       -> Bag TyVar
forall a. Bag a
emptyBag