{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                      -- in module Language.Haskell.Syntax.Extension
{-# LANGUAGE ViewPatterns #-}
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

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

-- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
module Language.Haskell.Syntax.Pat (
        Pat(..), LPat,
        ConLikeP,

        HsConPatDetails, hsConPatArgs,
        HsRecFields(..), HsRecField'(..), LHsRecField',
        HsRecField, LHsRecField,
        HsRecUpdField, LHsRecUpdField,
        hsRecFields, hsRecFieldSel, hsRecFieldsArgs,
    ) where

import GHC.Prelude

import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsSplice)

-- friends:
import Language.Haskell.Syntax.Lit
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
import GHC.Types.Basic
-- others:
import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
-- libraries:

type LPat p = XRec p (Pat p)

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

-- For details on above see note [exact print 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)
                (LIdP 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 [exact print annotations] in GHC.Parser.Annotation

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

    -- For details on above see note [exact print 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 [exact print 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 [exact print 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 [exact print 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 [exact print annotations] in GHC.Parser.Annotation

        ------------ Constructor patterns ---------------
  | ConPat {
        forall p. Pat p -> XConPat p
pat_con_ext :: XConPat p,
        forall p. Pat p -> XRec p (ConLikeP p)
pat_con     :: XRec p (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 [exact print 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 [exact print 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
                    (XRec p (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 [exact print annotations] in GHC.Parser.Annotation
  | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern
                    (LIdP p)                 -- n+k pattern
                    (XRec p (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 [exact print 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)

type family ConLikeP x


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


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

hsConPatArgs :: forall p . (UnXRec p) => HsConPatDetails p -> [LPat p]
hsConPatArgs :: forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs (PrefixCon [HsPatSigType (NoGhcTc p)]
_ [LPat p]
ps) = [LPat p]
ps
hsConPatArgs (RecCon HsRecFields p (LPat p)
fs)      = (XRec p (HsRecField' (FieldOcc p) (LPat p)) -> LPat p)
-> [XRec p (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)
-> (XRec p (HsRecField' (FieldOcc p) (LPat p))
    -> HsRecField' (FieldOcc p) (LPat p))
-> XRec p (HsRecField' (FieldOcc p) (LPat p))
-> LPat p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (HsRecFields p (LPat p)
-> [XRec p (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]

-- | 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]
  -- AZ:The XRec for LHsRecField makes the derivings fail.
  -- deriving (Functor, Foldable, 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 id arg = XRec p (HsRecField' id arg)

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

-- | Located Haskell Record Update Field
type LHsRecUpdField p   = XRec p (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 [exact print annotations] in GHC.Parser.Annotation
data HsRecField' id arg = HsRecField {
        forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldAnn :: XHsRecField id,
        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 ((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.Head.

hsRecFields :: forall p arg. UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
hsRecFields :: forall p arg. UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
hsRecFields HsRecFields p arg
rbinds = (XRec p (HsRecField p arg) -> XCFieldOcc p)
-> [XRec p (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)
-> (XRec p (HsRecField p arg) -> GenLocated SrcSpan (XCFieldOcc p))
-> XRec p (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))
-> (XRec p (HsRecField p arg) -> HsRecField p arg)
-> XRec p (HsRecField p arg)
-> GenLocated SrcSpan (XCFieldOcc p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (HsRecFields p arg -> [XRec p (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 :: forall p arg. UnXRec p => HsRecFields p arg -> [arg]
hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg]
hsRecFieldsArgs HsRecFields p arg
rbinds = (XRec p (HsRecField' (FieldOcc p) arg) -> arg)
-> [XRec p (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)
-> (XRec p (HsRecField' (FieldOcc p) arg)
    -> HsRecField' (FieldOcc p) arg)
-> XRec p (HsRecField' (FieldOcc p) arg)
-> arg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (HsRecFields p arg -> [XRec p (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 pass arg -> GenLocated SrcSpan (FieldOcc pass))
-> HsRecField pass arg
-> GenLocated SrcSpan (XCFieldOcc pass)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsRecField pass arg -> GenLocated SrcSpan (FieldOcc pass)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl


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

instance (Outputable arg, Outputable (XRec p (HsRecField p 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 = [XRec p (HsRecField 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 ((XRec p (HsRecField p arg) -> SDoc)
-> [XRec p (HsRecField p arg)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map XRec p (HsRecField p arg) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [XRec p (HsRecField p arg)]
flds)))
  ppr (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [XRec p (HsRecField p arg)]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (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 ((XRec p (HsRecField p arg) -> SDoc)
-> [XRec p (HsRecField p arg)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map XRec p (HsRecField p arg) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> [XRec p (HsRecField p arg)] -> [XRec p (HsRecField p arg)]
forall a. Int -> [a] -> [a]
take Int
n [XRec p (HsRecField p arg)]
flds) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc
dotdot])))
        where
          dotdot :: SDoc
dotdot = String -> SDoc
text String
".." SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
whenPprDebug ([XRec p (HsRecField p arg)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int -> [XRec p (HsRecField p arg)] -> [XRec p (HsRecField p arg)]
forall a. Int -> [a] -> [a]
drop Int
n [XRec p (HsRecField p arg)]
flds))

instance (Outputable p, OutputableBndr p, Outputable arg)
      => Outputable (HsRecField' p arg) where
  ppr :: HsRecField' p arg -> SDoc
ppr (HsRecField { hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl = L SrcSpan
_ p
f, hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecFieldArg = arg
arg,
                    hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun = Bool
pun })
    = p -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc 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)