{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TupleSections   #-}

{-|
Module      : GHC.Hs.Utils
Description : Generic helpers for the HsSyn type.
Copyright   : (c) The University of Glasgow, 1992-2006

Here we collect a variety of helper functions that construct or
analyse HsSyn.  All these functions deal with generic HsSyn; functions
which deal with the instantiated versions are located elsewhere:

   Parameterised by          Module
   ----------------          -------------
   GhcPs/RdrName             GHC.Parser.PostProcess
   GhcRn/Name                GHC.Rename.*
   GhcTc/Id                  GHC.Tc.Zonk.Type

The @mk*@ functions attempt to construct a not-completely-useless SrcSpan
from their components, compared with the @nl*@ functions which
just attach noSrcSpan to everything.

-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module GHC.Hs.Utils(
  -- * Terms
  mkHsPar, mkHsApp, mkHsAppWith, mkHsApps, mkHsAppsWith,
  mkHsAppType, mkHsAppTypes, mkHsCaseAlt,
  mkSimpleMatch, unguardedGRHSs, unguardedRHS,
  mkMatchGroup, mkLamCaseMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf,
  mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo,
  mkHsDictLet, mkHsLams,
  mkHsOpApp, mkHsDo, mkHsDoAnns, mkHsComp, mkHsCompAnns, mkHsWrapPat, mkHsWrapPatCo,
  mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap,
  mkHsCmdIf, mkConLikeTc,

  nlHsTyApp, nlHsTyApps, nlHsVar, nl_HsVar, nlHsDataCon,
  nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps,
  nlHsIntLit, nlHsVarApps,
  nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
  mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
  mkLocatedList,

  -- * Bindings
  mkFunBind, mkVarBind, mkHsVarBind, mkSimpleGeneratedFunBind, mkTopFunBind,
  mkPatSynBind,
  isInfixFunBind,
  spanHsLocaLBinds,

  -- * Literals
  mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString, mkHsStringFS, mkHsStringPrimLit,
  mkHsCharPrimLit,

  -- * Patterns
  mkNPat, mkNPlusKPat, nlVarPat, nlLitPat, nlConVarPat, nlConVarPatName, nlConPat,
  nlConPatName, nlInfixConPat, nlNullaryConPat, nlWildConPat, nlWildPat,
  nlWildPatName, nlTuplePat, mkParPat, nlParPat,
  mkBigLHsVarTup, mkBigLHsTup, mkBigLHsVarPatTup, mkBigLHsPatTup,

  -- * Types
  mkHsAppTy, mkHsAppKindTy,
  hsTypeToHsSigType, hsTypeToHsSigWcType, mkClassOpSigs, mkHsSigEnv,
  nlHsAppTy, nlHsAppKindTy, nlHsTyVar, nlHsFunTy, nlHsParTy, nlHsTyConApp,

  -- * Stmts
  mkTransformStmt, mkTransformByStmt, mkBodyStmt,
  mkPsBindStmt, mkRnBindStmt, mkTcBindStmt,
  mkLastStmt,
  emptyTransStmt, mkGroupUsingStmt, mkGroupByUsingStmt,
  emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
  unitRecStmtTc,
  mkLetStmt,

  -- * Collecting binders
  isUnliftedHsBind, isUnliftedHsBinds, isBangedHsBind,

  collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
  collectHsIdBinders,
  collectHsBindsBinders, collectHsBindBinders, collectMethodBinders,

  collectPatBinders, collectPatsBinders,
  collectLStmtsBinders, collectStmtsBinders,
  collectLStmtBinders, collectStmtBinders,
  CollectPass(..), CollectFlag(..),

  TyDeclBinders(..), LConsWithFields(..),
  hsLTyClDeclBinders, hsTyClForeignBinders,
  hsPatSynSelectors, getPatSynBinds,
  hsForeignDeclsBinders, hsGroupBinders, hsDataFamInstBinders,

  -- * Collecting implicit binders
  lStmtsImplicits, hsValBindsImplicits, lPatImplicits
  ) where

import GHC.Prelude hiding (head, init, last, tail)

import GHC.Hs.Decls
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Pat
import GHC.Hs.Type
import GHC.Hs.Lit
import Language.Haskell.Syntax.Decls
import Language.Haskell.Syntax.Extension
import GHC.Hs.Extension
import GHC.Parser.Annotation

import GHC.Tc.Types.Evidence

import GHC.Core.Coercion( isReflCo )
import GHC.Core.Multiplicity ( pattern ManyTy )
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.Make   ( mkChunkified )
import GHC.Core.Type   ( Type, isUnliftedType )

import GHC.Builtin.Types ( unitTy )

import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Set hiding ( unitFV )
import GHC.Types.Name.Env
import GHC.Types.Name.Reader
import GHC.Types.Var
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Types.Fixity
import GHC.Types.SourceText

import GHC.Data.FastString
import GHC.Data.Bag

import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic

import Control.Arrow ( first )
import Data.Either ( partitionEithers )
import Data.Foldable ( toList )
import Data.List ( partition )
import Data.List.NonEmpty ( nonEmpty )
import qualified Data.List.NonEmpty as NE

import Data.IntMap ( IntMap )
import qualified Data.IntMap.Strict as IntMap
import Data.Map ( Map )
import qualified Data.Map.Strict as Map

{-
************************************************************************
*                                                                      *
        Some useful helpers for constructing syntax
*                                                                      *
************************************************************************

These functions attempt to construct a not-completely-useless 'SrcSpan'
from their components, compared with the @nl*@ functions below which
just attach 'noSrcSpan' to everything.
-}

-- | @e => (e)@
mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsPar :: forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsPar LHsExpr (GhcPass id)
e = SrcSpanAnnA
-> HsExpr (GhcPass id)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (HsExpr (GhcPass id)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsExpr (GhcPass id)
GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
e) (LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar LHsExpr (GhcPass id)
e)

mkSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
                        ~ SrcSpanAnnA,
                  Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                        ~ SrcAnn NoEpAnns)
              => HsMatchContext (GhcPass p)
              -> [LPat (GhcPass p)] -> LocatedA (body (GhcPass p))
              -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch :: forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcSpanAnnA,
 Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext (GhcPass p)
ctxt [LPat (GhcPass p)]
pats LocatedA (body (GhcPass p))
rhs
  = SrcSpanAnnA
-> Match (GhcPass p) (LocatedA (body (GhcPass p)))
-> GenLocated
     SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (Match (GhcPass p) (LocatedA (body (GhcPass p)))
 -> GenLocated
      SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p)))))
-> Match (GhcPass p) (LocatedA (body (GhcPass p)))
-> GenLocated
     SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
forall a b. (a -> b) -> a -> b
$
    Match { m_ext :: XCMatch (GhcPass p) (LocatedA (body (GhcPass p)))
m_ext = XCMatch (GhcPass p) (LocatedA (body (GhcPass p)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, m_ctxt :: HsMatchContext (GhcPass p)
m_ctxt = HsMatchContext (GhcPass p)
ctxt, m_pats :: [LPat (GhcPass p)]
m_pats = [LPat (GhcPass p)]
pats
          , m_grhss :: GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
m_grhss = SrcSpan
-> LocatedA (body (GhcPass p))
-> EpAnn GrhsAnn
-> GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
SrcSpan
-> LocatedA (body (GhcPass p))
-> EpAnn GrhsAnn
-> GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
unguardedGRHSs (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) LocatedA (body (GhcPass p))
rhs EpAnn GrhsAnn
forall a. EpAnn a
noAnn }
  where
    loc :: SrcSpanAnnA
loc = case [LPat (GhcPass p)]
pats of
                []      -> LocatedA (body (GhcPass p)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA (body (GhcPass p))
rhs
                (LPat (GhcPass p)
pat:[LPat (GhcPass p)]
_) -> SrcSpanAnnA -> SrcSpanAnnA -> SrcSpanAnnA
forall a. Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
combineSrcSpansA (GenLocated SrcSpanAnnA (Pat (GhcPass p)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat) (LocatedA (body (GhcPass p)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LocatedA (body (GhcPass p))
rhs)

unguardedGRHSs :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                     ~ SrcAnn NoEpAnns
               => SrcSpan -> LocatedA (body (GhcPass p)) -> EpAnn GrhsAnn
               -> GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
unguardedGRHSs :: forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
SrcSpan
-> LocatedA (body (GhcPass p))
-> EpAnn GrhsAnn
-> GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
unguardedGRHSs SrcSpan
loc LocatedA (body (GhcPass p))
rhs EpAnn GrhsAnn
an
  = XCGRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
-> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
-> HsLocalBinds (GhcPass p)
-> GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
EpAnnComments
emptyComments (EpAnn GrhsAnn
-> SrcSpan
-> LocatedA (body (GhcPass p))
-> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
EpAnn GrhsAnn
-> SrcSpan
-> LocatedA (body (GhcPass p))
-> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
unguardedRHS EpAnn GrhsAnn
an SrcSpan
loc LocatedA (body (GhcPass p))
rhs) HsLocalBinds (GhcPass p)
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds

unguardedRHS :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                     ~ SrcAnn NoEpAnns
             => EpAnn GrhsAnn -> SrcSpan -> LocatedA (body (GhcPass p))
             -> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
unguardedRHS :: forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
EpAnn GrhsAnn
-> SrcSpan
-> LocatedA (body (GhcPass p))
-> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
unguardedRHS EpAnn GrhsAnn
an SrcSpan
loc LocatedA (body (GhcPass p))
rhs = [SrcAnn NoEpAnns
-> GRHS (GhcPass p) (LocatedA (body (GhcPass p)))
-> GenLocated
     (SrcAnn NoEpAnns) (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn NoEpAnns
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (XCGRHS (GhcPass p) (LocatedA (body (GhcPass p)))
-> [GuardLStmt (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> GRHS (GhcPass p) (LocatedA (body (GhcPass p)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass p) (LocatedA (body (GhcPass p)))
EpAnn GrhsAnn
an [] LocatedA (body (GhcPass p))
rhs)]

type AnnoBody p body
  = ( XMG (GhcPass p) (LocatedA (body (GhcPass p))) ~ Origin
    , Anno [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))] ~ SrcSpanAnnL
    , Anno (Match (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpanAnnA
    )

mkMatchGroup :: AnnoBody p body
             => Origin
             -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
             -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup :: forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
origin LocatedL
  [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
matches = MG { mg_ext :: XMG (GhcPass p) (LocatedA (body (GhcPass p)))
mg_ext = XMG (GhcPass p) (LocatedA (body (GhcPass p)))
Origin
origin
                                 , mg_alts :: XRec (GhcPass p) [LMatch (GhcPass p) (LocatedA (body (GhcPass p)))]
mg_alts = XRec (GhcPass p) [LMatch (GhcPass p) (LocatedA (body (GhcPass p)))]
LocatedL
  [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
matches }

mkLamCaseMatchGroup :: AnnoBody p body
                    => Origin
                    -> LamCaseVariant
                    -> LocatedL [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
                    -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup :: forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LamCaseVariant
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkLamCaseMatchGroup Origin
origin LamCaseVariant
lc_variant (L SrcSpanAnn' (EpAnn AnnList)
l [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
matches)
  = Origin
-> GenLocated
     (SrcSpanAnn' (EpAnn AnnList))
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
origin (SrcSpanAnn' (EpAnn AnnList)
-> [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> GenLocated
     (SrcSpanAnn' (EpAnn AnnList))
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnn' (EpAnn AnnList)
l ([LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
 -> GenLocated
      (SrcSpanAnn' (EpAnn AnnList))
      [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))])
-> [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> GenLocated
     (SrcSpanAnn' (EpAnn AnnList))
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
forall a b. (a -> b) -> a -> b
$ (LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
 -> LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p)))))
-> [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
-> LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
fixCtxt [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
matches)
  where fixCtxt :: LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
-> LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
fixCtxt (L SrcSpanAnnA
a Match (GhcPass p) (LocatedA (body (GhcPass p)))
match) = SrcSpanAnnA
-> Match (GhcPass p) (LocatedA (body (GhcPass p)))
-> LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
a Match (GhcPass p) (LocatedA (body (GhcPass p)))
match{m_ctxt = LamCaseAlt lc_variant}

mkLocatedList :: Semigroup a
  => [GenLocated (SrcAnn a) e2] -> LocatedAn an [GenLocated (SrcAnn a) e2]
mkLocatedList :: forall a e2 an.
Semigroup a =>
[GenLocated (SrcAnn a) e2]
-> LocatedAn an [GenLocated (SrcAnn a) e2]
mkLocatedList [GenLocated (SrcAnn a) e2]
ms = case [GenLocated (SrcAnn a) e2]
-> Maybe (NonEmpty (GenLocated (SrcAnn a) e2))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [GenLocated (SrcAnn a) e2]
ms of
    Maybe (NonEmpty (GenLocated (SrcAnn a) e2))
Nothing -> [GenLocated (SrcAnn a) e2]
-> LocatedAn an [GenLocated (SrcAnn a) e2]
forall a an. a -> LocatedAn an a
noLocA []
    Just NonEmpty (GenLocated (SrcAnn a) e2)
ms1 -> SrcAnn an
-> [GenLocated (SrcAnn a) e2]
-> LocatedAn an [GenLocated (SrcAnn a) e2]
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn an
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcAnn an) -> SrcSpan -> SrcAnn an
forall a b. (a -> b) -> a -> b
$ SrcAnn a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcAnn a -> SrcSpan) -> SrcAnn a -> SrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcAnn a) e2 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
forall a e1 e2.
Semigroup a =>
GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
combineLocsA (NonEmpty (GenLocated (SrcAnn a) e2) -> GenLocated (SrcAnn a) e2
forall a. NonEmpty a -> a
NE.head NonEmpty (GenLocated (SrcAnn a) e2)
ms1) (NonEmpty (GenLocated (SrcAnn a) e2) -> GenLocated (SrcAnn a) e2
forall a. NonEmpty a -> a
NE.last NonEmpty (GenLocated (SrcAnn a) e2)
ms1)) [GenLocated (SrcAnn a) e2]
ms

mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp :: forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp LHsExpr (GhcPass id)
e1 LHsExpr (GhcPass id)
e2 = GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
-> HsExpr (GhcPass id)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA LHsExpr (GhcPass id)
GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
e1 LHsExpr (GhcPass id)
GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
e2 (XApp (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass id)
EpAnnCO
noComments LHsExpr (GhcPass id)
e1 LHsExpr (GhcPass id)
e2)

mkHsAppWith
  :: (LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> HsExpr (GhcPass id) -> LHsExpr (GhcPass id))
  -> LHsExpr (GhcPass id)
  -> LHsExpr (GhcPass id)
  -> LHsExpr (GhcPass id)
mkHsAppWith :: forall (id :: Pass).
(LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id)
 -> HsExpr (GhcPass id)
 -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
mkHsAppWith LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
mkLocated LHsExpr (GhcPass id)
e1 LHsExpr (GhcPass id)
e2 = LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
mkLocated LHsExpr (GhcPass id)
e1 LHsExpr (GhcPass id)
e2 (XApp (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass id)
EpAnnCO
forall a. EpAnn a
noAnn LHsExpr (GhcPass id)
e1 LHsExpr (GhcPass id)
e2)

mkHsApps
  :: LHsExpr (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
mkHsApps :: forall (id :: Pass).
LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
mkHsApps = (XRec (GhcPass id) (HsExpr (GhcPass id))
 -> XRec (GhcPass id) (HsExpr (GhcPass id))
 -> HsExpr (GhcPass id)
 -> XRec (GhcPass id) (HsExpr (GhcPass id)))
-> XRec (GhcPass id) (HsExpr (GhcPass id))
-> [XRec (GhcPass id) (HsExpr (GhcPass id))]
-> XRec (GhcPass id) (HsExpr (GhcPass id))
forall (id :: Pass).
(LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id)
 -> HsExpr (GhcPass id)
 -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
mkHsAppsWith XRec (GhcPass id) (HsExpr (GhcPass id))
-> XRec (GhcPass id) (HsExpr (GhcPass id))
-> HsExpr (GhcPass id)
-> XRec (GhcPass id) (HsExpr (GhcPass id))
GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
-> HsExpr (GhcPass id)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA

mkHsAppsWith
 :: (LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> HsExpr (GhcPass id) -> LHsExpr (GhcPass id))
 -> LHsExpr (GhcPass id)
 -> [LHsExpr (GhcPass id)]
 -> LHsExpr (GhcPass id)
mkHsAppsWith :: forall (id :: Pass).
(LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id)
 -> HsExpr (GhcPass id)
 -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
mkHsAppsWith LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
mkLocated = (GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass id))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id)
 -> HsExpr (GhcPass id)
 -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
forall (id :: Pass).
(LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id)
 -> HsExpr (GhcPass id)
 -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
mkHsAppWith LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
mkLocated)

mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn
mkHsAppType :: LHsExpr (GhcPass 'Renamed)
-> LHsWcType (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
mkHsAppType LHsExpr (GhcPass 'Renamed)
e LHsWcType (GhcPass 'Renamed)
t = GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a1 e1 a2 e2 e3 ann.
GenLocated (SrcSpanAnn' a1) e1
-> GenLocated (SrcSpanAnn' a2) e2
-> e3
-> GenLocated (SrcAnn ann) e3
addCLocAA GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
t_body LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
e (XAppTypeE (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed)
-> LHsToken "@" (GhcPass 'Renamed)
-> LHsWcType (NoGhcTc (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall p.
XAppTypeE p
-> LHsExpr p -> LHsToken "@" p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE (GhcPass 'Renamed)
NoExtField
noExtField LHsExpr (GhcPass 'Renamed)
e LHsToken "@" (GhcPass 'Renamed)
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsWcType (NoGhcTc (GhcPass 'Renamed))
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
paren_wct)
  where
    t_body :: GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
t_body    = HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed))
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (GhcPass 'Renamed)
HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
t
    paren_wct :: HsWildCardBndrs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
paren_wct = LHsWcType (GhcPass 'Renamed)
t { hswc_body = parenthesizeHsType appPrec t_body }

mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
mkHsAppTypes :: LHsExpr (GhcPass 'Renamed)
-> [LHsWcType (GhcPass 'Renamed)] -> LHsExpr (GhcPass 'Renamed)
mkHsAppTypes = (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
 -> HsWildCardBndrs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> [HsWildCardBndrs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr (GhcPass 'Renamed)
-> LHsWcType (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsWildCardBndrs
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
mkHsAppType

mkHsLam :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin)
        => [LPat (GhcPass p)]
        -> LHsExpr (GhcPass p)
        -> LHsExpr (GhcPass p)
mkHsLam :: forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam [LPat (GhcPass p)]
pats LHsExpr (GhcPass p)
body = LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsPar (SrcSpanAnnA -> HsExpr (GhcPass p) -> LocatedA (HsExpr (GhcPass p))
forall l e. l -> e -> GenLocated l e
L (LocatedA (HsExpr (GhcPass p)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsExpr (GhcPass p)
LocatedA (HsExpr (GhcPass p))
body) (XLam (GhcPass p)
-> MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
-> HsExpr (GhcPass p)
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam (GhcPass p)
NoExtField
noExtField MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
MatchGroup (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
matches))
  where
    matches :: MatchGroup (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
matches = Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup (DoPmc -> Origin
Generated DoPmc
SkipPmc)
                           ([LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
forall a an. a -> LocatedAn an a
noLocA [HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LocatedA (HsExpr (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcSpanAnnA,
 Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext (GhcPass p)
forall p. HsMatchContext p
LambdaExpr [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats' LHsExpr (GhcPass p)
LocatedA (HsExpr (GhcPass p))
body])
    pats' :: [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats' = (GenLocated SrcSpanAnnA (Pat (GhcPass p))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats

mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams :: [Id] -> [Id] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams [Id]
tyvars [Id]
dicts LHsExpr GhcTc
expr = HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrap ([Id] -> HsWrapper
mkWpTyLams [Id]
tyvars
                                       HsWrapper -> HsWrapper -> HsWrapper
<.> [Id] -> HsWrapper
mkWpEvLams [Id]
dicts) LHsExpr GhcTc
expr

-- |A simple case alternative with a single pattern, no binds, no guards;
-- pre-typechecking
mkHsCaseAlt :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
                     ~ SrcAnn NoEpAnns,
                 Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
                        ~ SrcSpanAnnA)
            => LPat (GhcPass p) -> (LocatedA (body (GhcPass p)))
            -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt :: forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns,
 Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcSpanAnnA) =>
LPat (GhcPass p)
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkHsCaseAlt LPat (GhcPass p)
pat LocatedA (body (GhcPass p))
expr
  = HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcSpanAnnA,
 Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext (GhcPass p)
forall p. HsMatchContext p
CaseAlt [LPat (GhcPass p)
pat] LocatedA (body (GhcPass p))
expr

nlHsTyApp :: Id -> [Type] -> LHsExpr GhcTc
nlHsTyApp :: Id -> [Type] -> LHsExpr GhcTc
nlHsTyApp Id
fun_id [Type]
tys
  = HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall a an. a -> LocatedAn an a
noLocA (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap ([Type] -> HsWrapper
mkWpTyApps [Type]
tys) (XVar GhcTc -> LIdP GhcTc -> HsExpr GhcTc
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcTc
NoExtField
noExtField (Id -> GenLocated SrcSpanAnnN Id
forall a an. a -> LocatedAn an a
noLocA Id
fun_id)))

nlHsTyApps :: Id -> [Type] -> [LHsExpr GhcTc] -> LHsExpr GhcTc
nlHsTyApps :: Id -> [Type] -> [LHsExpr GhcTc] -> LHsExpr GhcTc
nlHsTyApps Id
fun_id [Type]
tys [LHsExpr GhcTc]
xs = (GenLocated SrcSpanAnnA (HsExpr GhcTc)
 -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
 -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (Id -> [Type] -> LHsExpr GhcTc
nlHsTyApp Id
fun_id [Type]
tys) [LHsExpr GhcTc]
[GenLocated SrcSpanAnnA (HsExpr GhcTc)]
xs

--------- Adding parens ---------
-- | Wrap in parens if @'hsExprNeedsParens' appPrec@ says it needs them
-- So @f x@ becomes @(f x)@, but @3@ stays as @3@.
mkLHsPar :: IsPass id => LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar :: forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar = PprPrec
-> XRec (GhcPass id) (HsExpr (GhcPass id))
-> XRec (GhcPass id) (HsExpr (GhcPass id))
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
appPrec

mkParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
mkParPat :: forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
mkParPat = PprPrec
-> XRec (GhcPass p) (Pat (GhcPass p))
-> XRec (GhcPass p) (Pat (GhcPass p))
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec

nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
nlParPat :: forall (name :: Pass). LPat (GhcPass name) -> LPat (GhcPass name)
nlParPat LPat (GhcPass name)
p = Pat (GhcPass name) -> LocatedAn AnnListItem (Pat (GhcPass name))
forall a an. a -> LocatedAn an a
noLocA (LPat (GhcPass name) -> Pat (GhcPass name)
forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat LPat (GhcPass name)
p)

-------------------------------
-- These are the bits of syntax that contain rebindable names
-- See GHC.Rename.Env.lookupSyntax

mkHsIntegral   :: IntegralLit -> HsOverLit GhcPs
mkHsFractional :: FractionalLit -> HsOverLit GhcPs
mkHsIsString   :: SourceText -> FastString -> HsOverLit GhcPs
mkHsDo         :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsDoAnns     :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> EpAnn AnnList -> HsExpr GhcPs
mkHsComp       :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
               -> HsExpr GhcPs
mkHsCompAnns   :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
               -> EpAnn AnnList
               -> HsExpr GhcPs

mkNPat      :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpAnn [AddEpAnn]
            -> Pat GhcPs
mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpAnn EpaLocation
            -> Pat GhcPs

-- NB: The following functions all use noSyntaxExpr: the generated expressions
--     will not work with rebindable syntax if used after the renamer
mkLastStmt :: IsPass idR => LocatedA (bodyR (GhcPass idR))
           -> StmtLR (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkBodyStmt :: LocatedA (bodyR GhcPs)
           -> StmtLR (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))
mkPsBindStmt :: EpAnn [AddEpAnn] -> LPat GhcPs -> LocatedA (bodyR GhcPs)
             -> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs))
mkRnBindStmt :: LPat GhcRn -> LocatedA (bodyR GhcRn)
             -> StmtLR GhcRn GhcRn (LocatedA (bodyR GhcRn))
mkTcBindStmt :: LPat GhcTc -> LocatedA (bodyR GhcTc)
             -> StmtLR GhcTc GhcTc (LocatedA (bodyR GhcTc))

emptyRecStmt     :: (Anno [GenLocated
                             (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
                             (StmtLR (GhcPass idL) GhcPs bodyR)]
                        ~ SrcSpanAnnL)
                 => StmtLR (GhcPass idL) GhcPs bodyR
emptyRecStmtName :: (Anno [GenLocated
                             (Anno (StmtLR GhcRn GhcRn bodyR))
                             (StmtLR GhcRn GhcRn bodyR)]
                        ~ SrcSpanAnnL)
                 => StmtLR GhcRn GhcRn bodyR
emptyRecStmtId   :: Stmt GhcTc (LocatedA (HsCmd GhcTc))

mkRecStmt :: forall (idL :: Pass) bodyR.
                    (Anno [GenLocated
                             (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
                             (StmtLR (GhcPass idL) GhcPs bodyR)]
                        ~ SrcSpanAnnL)
                 => EpAnn AnnList
                 -> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]
                 -> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt :: forall (idL :: Pass) bodyR.
(Anno
   [GenLocated
      (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
      (StmtLR (GhcPass idL) GhcPs bodyR)]
 ~ SrcSpanAnn' (EpAnn AnnList)) =>
EpAnn AnnList
-> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt EpAnn AnnList
anns LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]
stmts  = (XRecStmt (GhcPass idL) GhcPs bodyR
-> StmtLR (GhcPass idL) GhcPs bodyR
forall (idL :: Pass) (idR :: Pass) body.
(WrapXRec (GhcPass idR) [LStmtLR (GhcPass idL) (GhcPass idR) body],
 IsPass idR) =>
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt (GhcPass idL) GhcPs bodyR
EpAnn AnnList
anns :: StmtLR (GhcPass idL) GhcPs bodyR)
                             { recS_stmts = stmts }


mkHsIntegral :: IntegralLit -> HsOverLit GhcPs
mkHsIntegral     IntegralLit
i  = XOverLit GhcPs -> OverLitVal -> HsOverLit GhcPs
forall p. XOverLit p -> OverLitVal -> HsOverLit p
OverLit XOverLit GhcPs
NoExtField
noExtField (IntegralLit -> OverLitVal
HsIntegral       IntegralLit
i)
mkHsFractional :: FractionalLit -> HsOverLit GhcPs
mkHsFractional   FractionalLit
f  = XOverLit GhcPs -> OverLitVal -> HsOverLit GhcPs
forall p. XOverLit p -> OverLitVal -> HsOverLit p
OverLit XOverLit GhcPs
NoExtField
noExtField (FractionalLit -> OverLitVal
HsFractional     FractionalLit
f)
mkHsIsString :: SourceText -> FastString -> HsOverLit GhcPs
mkHsIsString SourceText
src FastString
s  = XOverLit GhcPs -> OverLitVal -> HsOverLit GhcPs
forall p. XOverLit p -> OverLitVal -> HsOverLit p
OverLit XOverLit GhcPs
NoExtField
noExtField (SourceText -> FastString -> OverLitVal
HsIsString   SourceText
src FastString
s)

mkHsDo :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsDo     HsDoFlavour
ctxt LocatedL [ExprLStmt GhcPs]
stmts      = XDo GhcPs
-> HsDoFlavour -> XRec GhcPs [ExprLStmt GhcPs] -> HsExpr GhcPs
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn HsDoFlavour
ctxt XRec GhcPs [ExprLStmt GhcPs]
LocatedL [ExprLStmt GhcPs]
stmts
mkHsDoAnns :: HsDoFlavour
-> LocatedL [ExprLStmt GhcPs] -> EpAnn AnnList -> HsExpr GhcPs
mkHsDoAnns HsDoFlavour
ctxt LocatedL [ExprLStmt GhcPs]
stmts EpAnn AnnList
anns = XDo GhcPs
-> HsDoFlavour -> XRec GhcPs [ExprLStmt GhcPs] -> HsExpr GhcPs
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
EpAnn AnnList
anns  HsDoFlavour
ctxt XRec GhcPs [ExprLStmt GhcPs]
LocatedL [ExprLStmt GhcPs]
stmts
mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsComp HsDoFlavour
ctxt [ExprLStmt GhcPs]
stmts LHsExpr GhcPs
expr = HsDoFlavour
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> EpAnn AnnList
-> HsExpr GhcPs
mkHsCompAnns HsDoFlavour
ctxt [ExprLStmt GhcPs]
stmts LHsExpr GhcPs
expr EpAnn AnnList
forall a. EpAnn a
noAnn
mkHsCompAnns :: HsDoFlavour
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> EpAnn AnnList
-> HsExpr GhcPs
mkHsCompAnns HsDoFlavour
ctxt [ExprLStmt GhcPs]
stmts LHsExpr GhcPs
expr EpAnn AnnList
anns = HsDoFlavour
-> LocatedL [ExprLStmt GhcPs] -> EpAnn AnnList -> HsExpr GhcPs
mkHsDoAnns HsDoFlavour
ctxt ([GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
forall a e2 an.
Semigroup a =>
[GenLocated (SrcAnn a) e2]
-> LocatedAn an [GenLocated (SrcAnn a) e2]
mkLocatedList ([ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts [GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
last_stmt])) EpAnn AnnList
anns
  where
    -- Strip the annotations from the location, they are in the embedded expr
    last_stmt :: GenLocated
  SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
last_stmt = SrcSpanAnnA
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpan -> SrcSpanAnnA) -> SrcSpan -> SrcSpanAnnA
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr) (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
 -> GenLocated
      SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs)
-> StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
LocatedA (bodyR (GhcPass idR))
-> StmtLR
     (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkLastStmt LHsExpr GhcPs
LocatedA (HsExpr GhcPs)
expr

-- restricted to GhcPs because other phases might need a SyntaxExpr
mkHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn AnnsIf
       -> HsExpr GhcPs
mkHsIf :: LHsExpr GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn AnnsIf -> HsExpr GhcPs
mkHsIf LHsExpr GhcPs
c LHsExpr GhcPs
a LHsExpr GhcPs
b EpAnn AnnsIf
anns = XIf GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf XIf GhcPs
EpAnn AnnsIf
anns LHsExpr GhcPs
c LHsExpr GhcPs
a LHsExpr GhcPs
b

-- restricted to GhcPs because other phases might need a SyntaxExpr
mkHsCmdIf :: LHsExpr GhcPs -> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn AnnsIf
       -> HsCmd GhcPs
mkHsCmdIf :: LHsExpr GhcPs
-> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn AnnsIf -> HsCmd GhcPs
mkHsCmdIf LHsExpr GhcPs
c LHsCmd GhcPs
a LHsCmd GhcPs
b EpAnn AnnsIf
anns = XCmdIf GhcPs
-> SyntaxExpr GhcPs
-> LHsExpr GhcPs
-> LHsCmd GhcPs
-> LHsCmd GhcPs
-> HsCmd GhcPs
forall id.
XCmdIf id
-> SyntaxExpr id
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcPs
EpAnn AnnsIf
anns SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr LHsExpr GhcPs
c LHsCmd GhcPs
a LHsCmd GhcPs
b

mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs) -> EpAnn [AddEpAnn] -> Pat GhcPs
mkNPat LocatedAn NoEpAnns (HsOverLit GhcPs)
lit Maybe (SyntaxExpr GhcPs)
neg EpAnn [AddEpAnn]
anns  = XNPat GhcPs
-> XRec GhcPs (HsOverLit GhcPs)
-> Maybe (SyntaxExpr GhcPs)
-> SyntaxExpr GhcPs
-> Pat GhcPs
forall p.
XNPat p
-> XRec p (HsOverLit p)
-> Maybe (SyntaxExpr p)
-> SyntaxExpr p
-> Pat p
NPat XNPat GhcPs
EpAnn [AddEpAnn]
anns XRec GhcPs (HsOverLit GhcPs)
LocatedAn NoEpAnns (HsOverLit GhcPs)
lit Maybe (SyntaxExpr GhcPs)
neg SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
mkNPlusKPat :: LocatedN RdrName
-> LocatedAn NoEpAnns (HsOverLit GhcPs)
-> EpAnn EpaLocation
-> Pat GhcPs
mkNPlusKPat LocatedN RdrName
id LocatedAn NoEpAnns (HsOverLit GhcPs)
lit EpAnn EpaLocation
anns
  = XNPlusKPat GhcPs
-> LIdP GhcPs
-> XRec GhcPs (HsOverLit GhcPs)
-> HsOverLit GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> Pat GhcPs
forall p.
XNPlusKPat p
-> LIdP p
-> XRec p (HsOverLit p)
-> HsOverLit p
-> SyntaxExpr p
-> SyntaxExpr p
-> Pat p
NPlusKPat XNPlusKPat GhcPs
EpAnn EpaLocation
anns LIdP GhcPs
LocatedN RdrName
id XRec GhcPs (HsOverLit GhcPs)
LocatedAn NoEpAnns (HsOverLit GhcPs)
lit (LocatedAn NoEpAnns (HsOverLit GhcPs) -> HsOverLit GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedAn NoEpAnns (HsOverLit GhcPs)
lit) SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr

mkTransformStmt    :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkTransformByStmt  :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
                   -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkGroupUsingStmt   :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkGroupByUsingStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
                   -> LHsExpr GhcPs
                   -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)

emptyTransStmt :: EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt :: EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt EpAnn [AddEpAnn]
anns = TransStmt { trS_ext :: XTransStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
trS_ext = XTransStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
EpAnn [AddEpAnn]
anns
                                , trS_form :: TransForm
trS_form = String -> TransForm
forall a. HasCallStack => String -> a
panic String
"emptyTransStmt: form"
                                , trS_stmts :: [ExprLStmt GhcPs]
trS_stmts = [], trS_bndrs :: [(IdP GhcPs, IdP GhcPs)]
trS_bndrs = []
                                , trS_by :: Maybe (LHsExpr GhcPs)
trS_by = Maybe (LHsExpr GhcPs)
Maybe (LocatedA (HsExpr GhcPs))
forall a. Maybe a
Nothing, trS_using :: LHsExpr GhcPs
trS_using = HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA HsExpr GhcPs
forall (p :: Pass). HsExpr (GhcPass p)
noExpr
                                , trS_ret :: SyntaxExpr GhcPs
trS_ret = SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr, trS_bind :: SyntaxExpr GhcPs
trS_bind = SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
                                , trS_fmap :: HsExpr GhcPs
trS_fmap = HsExpr GhcPs
forall (p :: Pass). HsExpr (GhcPass p)
noExpr }
mkTransformStmt :: EpAnn [AddEpAnn]
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkTransformStmt    EpAnn [AddEpAnn]
a [ExprLStmt GhcPs]
ss LHsExpr GhcPs
u   = (EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt EpAnn [AddEpAnn]
a) { trS_form = ThenForm,  trS_stmts = ss, trS_using = u }
mkTransformByStmt :: EpAnn [AddEpAnn]
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkTransformByStmt  EpAnn [AddEpAnn]
a [ExprLStmt GhcPs]
ss LHsExpr GhcPs
u LHsExpr GhcPs
b = (EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt EpAnn [AddEpAnn]
a) { trS_form = ThenForm,  trS_stmts = ss, trS_using = u, trS_by = Just b }
mkGroupUsingStmt :: EpAnn [AddEpAnn]
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkGroupUsingStmt   EpAnn [AddEpAnn]
a [ExprLStmt GhcPs]
ss LHsExpr GhcPs
u   = (EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt EpAnn [AddEpAnn]
a) { trS_form = GroupForm, trS_stmts = ss, trS_using = u }
mkGroupByUsingStmt :: EpAnn [AddEpAnn]
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
-> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
mkGroupByUsingStmt EpAnn [AddEpAnn]
a [ExprLStmt GhcPs]
ss LHsExpr GhcPs
b LHsExpr GhcPs
u = (EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt EpAnn [AddEpAnn]
a) { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b }

mkLastStmt :: forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
LocatedA (bodyR (GhcPass idR))
-> StmtLR
     (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkLastStmt LocatedA (bodyR (GhcPass idR))
body = XLastStmt
  (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
-> LocatedA (bodyR (GhcPass idR))
-> Maybe Bool
-> SyntaxExpr (GhcPass idR)
-> StmtLR
     (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt
  (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
NoExtField
noExtField LocatedA (bodyR (GhcPass idR))
body Maybe Bool
forall a. Maybe a
Nothing SyntaxExpr (GhcPass idR)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
mkBodyStmt :: forall (bodyR :: * -> *) (idL :: Pass).
LocatedA (bodyR GhcPs)
-> StmtLR (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))
mkBodyStmt LocatedA (bodyR GhcPs)
body
  = XBodyStmt (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))
-> LocatedA (bodyR GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs))
NoExtField
noExtField LocatedA (bodyR GhcPs)
body SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
mkPsBindStmt :: forall (bodyR :: * -> *).
EpAnn [AddEpAnn]
-> LPat GhcPs
-> LocatedA (bodyR GhcPs)
-> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs))
mkPsBindStmt EpAnn [AddEpAnn]
ann LPat GhcPs
pat LocatedA (bodyR GhcPs)
body = XBindStmt GhcPs GhcPs (LocatedA (bodyR GhcPs))
-> LPat GhcPs
-> LocatedA (bodyR GhcPs)
-> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt GhcPs GhcPs (LocatedA (bodyR GhcPs))
EpAnn [AddEpAnn]
ann LPat GhcPs
pat LocatedA (bodyR GhcPs)
body
mkRnBindStmt :: forall (bodyR :: * -> *).
LPat (GhcPass 'Renamed)
-> LocatedA (bodyR (GhcPass 'Renamed))
-> StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (LocatedA (bodyR (GhcPass 'Renamed)))
mkRnBindStmt LPat (GhcPass 'Renamed)
pat LocatedA (bodyR (GhcPass 'Renamed))
body = XBindStmt
  (GhcPass 'Renamed)
  (GhcPass 'Renamed)
  (LocatedA (bodyR (GhcPass 'Renamed)))
-> LPat (GhcPass 'Renamed)
-> LocatedA (bodyR (GhcPass 'Renamed))
-> StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (LocatedA (bodyR (GhcPass 'Renamed)))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt (XBindStmtRn { xbsrn_bindOp :: SyntaxExpr (GhcPass 'Renamed)
xbsrn_bindOp = SyntaxExpr (GhcPass 'Renamed)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr, xbsrn_failOp :: FailOperator (GhcPass 'Renamed)
xbsrn_failOp = FailOperator (GhcPass 'Renamed)
Maybe SyntaxExprRn
forall a. Maybe a
Nothing }) LPat (GhcPass 'Renamed)
pat LocatedA (bodyR (GhcPass 'Renamed))
body
mkTcBindStmt :: forall (bodyR :: * -> *).
LPat GhcTc
-> LocatedA (bodyR GhcTc)
-> StmtLR GhcTc GhcTc (LocatedA (bodyR GhcTc))
mkTcBindStmt LPat GhcTc
pat LocatedA (bodyR GhcTc)
body = XBindStmt GhcTc GhcTc (LocatedA (bodyR GhcTc))
-> LPat GhcTc
-> LocatedA (bodyR GhcTc)
-> StmtLR GhcTc GhcTc (LocatedA (bodyR GhcTc))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt (XBindStmtTc { xbstc_bindOp :: SyntaxExpr GhcTc
xbstc_bindOp = SyntaxExpr GhcTc
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr,
                                                xbstc_boundResultType :: Type
xbstc_boundResultType = Type
unitTy,
                                                   -- unitTy is a dummy value
                                                   -- can't panic here: it's forced during zonking
                                                xbstc_boundResultMult :: Type
xbstc_boundResultMult = Type
ManyTy,
                                                xbstc_failOp :: FailOperator GhcTc
xbstc_failOp = FailOperator GhcTc
Maybe SyntaxExprTc
forall a. Maybe a
Nothing }) LPat GhcTc
pat LocatedA (bodyR GhcTc)
body

emptyRecStmt' :: forall idL idR body .
  (WrapXRec (GhcPass idR) [LStmtLR (GhcPass idL) (GhcPass idR) body], IsPass idR)
              => XRecStmt (GhcPass idL) (GhcPass idR) body
              -> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' :: forall (idL :: Pass) (idR :: Pass) body.
(WrapXRec (GhcPass idR) [LStmtLR (GhcPass idL) (GhcPass idR) body],
 IsPass idR) =>
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt (GhcPass idL) (GhcPass idR) body
tyVal =
   RecStmt
     { recS_stmts :: XRec (GhcPass idR) [LStmtLR (GhcPass idL) (GhcPass idR) body]
recS_stmts = forall p a. WrapXRec p a => a -> XRec p a
wrapXRec @(GhcPass idR) []
     , recS_later_ids :: [IdP (GhcPass idR)]
recS_later_ids = []
     , recS_rec_ids :: [IdP (GhcPass idR)]
recS_rec_ids = []
     , recS_ret_fn :: SyntaxExpr (GhcPass idR)
recS_ret_fn = SyntaxExpr (GhcPass idR)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
     , recS_mfix_fn :: SyntaxExpr (GhcPass idR)
recS_mfix_fn = SyntaxExpr (GhcPass idR)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
     , recS_bind_fn :: SyntaxExpr (GhcPass idR)
recS_bind_fn = SyntaxExpr (GhcPass idR)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
     , recS_ext :: XRecStmt (GhcPass idL) (GhcPass idR) body
recS_ext = XRecStmt (GhcPass idL) (GhcPass idR) body
tyVal }

unitRecStmtTc :: RecStmtTc
unitRecStmtTc :: RecStmtTc
unitRecStmtTc = RecStmtTc { recS_bind_ty :: Type
recS_bind_ty = Type
unitTy
                          , recS_later_rets :: [HsExpr GhcTc]
recS_later_rets = []
                          , recS_rec_rets :: [HsExpr GhcTc]
recS_rec_rets = []
                          , recS_ret_ty :: Type
recS_ret_ty = Type
unitTy }

emptyRecStmt :: forall (idL :: Pass) bodyR.
(Anno
   [GenLocated
      (Anno (StmtLR (GhcPass idL) GhcPs bodyR))
      (StmtLR (GhcPass idL) GhcPs bodyR)]
 ~ SrcSpanAnn' (EpAnn AnnList)) =>
StmtLR (GhcPass idL) GhcPs bodyR
emptyRecStmt     = XRecStmt (GhcPass idL) GhcPs bodyR
-> StmtLR (GhcPass idL) GhcPs bodyR
forall (idL :: Pass) (idR :: Pass) body.
(WrapXRec (GhcPass idR) [LStmtLR (GhcPass idL) (GhcPass idR) body],
 IsPass idR) =>
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt (GhcPass idL) GhcPs bodyR
EpAnn AnnList
forall a. EpAnn a
noAnn
emptyRecStmtName :: forall bodyR.
(Anno
   [GenLocated
      (Anno (StmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) bodyR))
      (StmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) bodyR)]
 ~ SrcSpanAnn' (EpAnn AnnList)) =>
StmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) bodyR
emptyRecStmtName = XRecStmt (GhcPass 'Renamed) (GhcPass 'Renamed) bodyR
-> StmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) bodyR
forall (idL :: Pass) (idR :: Pass) body.
(WrapXRec (GhcPass idR) [LStmtLR (GhcPass idL) (GhcPass idR) body],
 IsPass idR) =>
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt (GhcPass 'Renamed) (GhcPass 'Renamed) bodyR
NoExtField
noExtField
emptyRecStmtId :: StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc))
emptyRecStmtId   = XRecStmt GhcTc GhcTc (LocatedA (HsCmd GhcTc))
-> StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc))
forall (idL :: Pass) (idR :: Pass) body.
(WrapXRec (GhcPass idR) [LStmtLR (GhcPass idL) (GhcPass idR) body],
 IsPass idR) =>
XRecStmt (GhcPass idL) (GhcPass idR) body
-> StmtLR (GhcPass idL) (GhcPass idR) body
emptyRecStmt' XRecStmt GhcTc GhcTc (LocatedA (HsCmd GhcTc))
RecStmtTc
unitRecStmtTc
                                        -- a panic might trigger during zonking

mkLetStmt :: EpAnn [AddEpAnn] -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
mkLetStmt :: forall b.
EpAnn [AddEpAnn]
-> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
mkLetStmt EpAnn [AddEpAnn]
anns HsLocalBinds GhcPs
binds = XLetStmt GhcPs GhcPs (LocatedA b)
-> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (LocatedA b)
EpAnn [AddEpAnn]
anns HsLocalBinds GhcPs
binds

-------------------------------
-- | A useful function for building @OpApps@.  The operator is always a
-- variable, and we don't know the fixity yet.
mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsOpApp LHsExpr GhcPs
e1 IdP GhcPs
op LHsExpr GhcPs
e2 = XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr GhcPs
e1 (HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField (RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA IdP GhcPs
RdrName
op))) LHsExpr GhcPs
e2

mkHsString :: String -> HsLit (GhcPass p)
mkHsString :: forall (p :: Pass). String -> HsLit (GhcPass p)
mkHsString String
s = XHsString (GhcPass p) -> FastString -> HsLit (GhcPass p)
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString (GhcPass p)
SourceText
NoSourceText (String -> FastString
mkFastString String
s)

mkHsStringFS :: FastString -> HsLit (GhcPass p)
mkHsStringFS :: forall (p :: Pass). FastString -> HsLit (GhcPass p)
mkHsStringFS FastString
s = XHsString (GhcPass p) -> FastString -> HsLit (GhcPass p)
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString (GhcPass p)
SourceText
NoSourceText FastString
s

mkHsStringPrimLit :: FastString -> HsLit (GhcPass p)
mkHsStringPrimLit :: forall (p :: Pass). FastString -> HsLit (GhcPass p)
mkHsStringPrimLit FastString
fs = XHsStringPrim (GhcPass p) -> ByteString -> HsLit (GhcPass p)
forall x. XHsStringPrim x -> ByteString -> HsLit x
HsStringPrim XHsStringPrim (GhcPass p)
SourceText
NoSourceText (FastString -> ByteString
bytesFS FastString
fs)

mkHsCharPrimLit :: Char -> HsLit (GhcPass p)
mkHsCharPrimLit :: forall (p :: Pass). Char -> HsLit (GhcPass p)
mkHsCharPrimLit Char
c = XHsChar (GhcPass p) -> Char -> HsLit (GhcPass p)
forall x. XHsChar x -> Char -> HsLit x
HsChar XHsChar (GhcPass p)
SourceText
NoSourceText Char
c

mkConLikeTc :: ConLike -> HsExpr GhcTc
mkConLikeTc :: ConLike -> HsExpr GhcTc
mkConLikeTc ConLike
con = XXExpr GhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (ConLike -> [Id] -> [Scaled Type] -> XXExprGhcTc
ConLikeTc ConLike
con [] [])

{-
************************************************************************
*                                                                      *
        Constructing syntax with no location info
*                                                                      *
************************************************************************
-}

nlHsVar :: IsSrcSpanAnn p a
        => IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass p)
n = HsExpr (GhcPass p) -> LocatedAn AnnListItem (HsExpr (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XVar (GhcPass p) -> LIdP (GhcPass p) -> HsExpr (GhcPass p)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass p)
NoExtField
noExtField (IdGhcP p -> LocatedAn a (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
n))

nl_HsVar :: IsSrcSpanAnn p a
        => IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar IdP (GhcPass p)
n = XVar (GhcPass p) -> LIdP (GhcPass p) -> HsExpr (GhcPass p)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass p)
NoExtField
noExtField (IdGhcP p -> LocatedAn a (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
n)

-- | NB: Only for 'LHsExpr' 'Id'.
nlHsDataCon :: DataCon -> LHsExpr GhcTc
nlHsDataCon :: DataCon -> LHsExpr GhcTc
nlHsDataCon DataCon
con = HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall a an. a -> LocatedAn an a
noLocA (ConLike -> HsExpr GhcTc
mkConLikeTc (DataCon -> ConLike
RealDataCon DataCon
con))

nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit :: forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit HsLit (GhcPass p)
n = HsExpr (GhcPass p) -> LocatedAn AnnListItem (HsExpr (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XLitE (GhcPass p) -> HsLit (GhcPass p) -> HsExpr (GhcPass p)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass p)
EpAnnCO
noComments HsLit (GhcPass p)
n)

nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
nlHsIntLit :: forall (p :: Pass). Integer -> LHsExpr (GhcPass p)
nlHsIntLit Integer
n = HsExpr (GhcPass p) -> LocatedAn AnnListItem (HsExpr (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XLitE (GhcPass p) -> HsLit (GhcPass p) -> HsExpr (GhcPass p)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass p)
EpAnnCO
noComments (XHsInt (GhcPass p) -> IntegralLit -> HsLit (GhcPass p)
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt (GhcPass p)
NoExtField
noExtField (Integer -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit Integer
n)))

nlVarPat :: IsSrcSpanAnn p a
        => IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat IdP (GhcPass p)
n = Pat (GhcPass p) -> LocatedAn AnnListItem (Pat (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XVarPat (GhcPass p) -> LIdP (GhcPass p) -> Pat (GhcPass p)
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat (GhcPass p)
NoExtField
noExtField (IdGhcP p -> LocatedAn a (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
n))

nlLitPat :: HsLit GhcPs -> LPat GhcPs
nlLitPat :: HsLit GhcPs -> LPat GhcPs
nlLitPat HsLit GhcPs
l = Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XLitPat GhcPs -> HsLit GhcPs -> Pat GhcPs
forall p. XLitPat p -> HsLit p -> Pat p
LitPat XLitPat GhcPs
NoExtField
noExtField HsLit GhcPs
l)

nlHsApp :: IsPass id => LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp :: forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp LHsExpr (GhcPass id)
f LHsExpr (GhcPass id)
x = HsExpr (GhcPass id) -> LocatedAn AnnListItem (HsExpr (GhcPass id))
forall a an. a -> LocatedAn an a
noLocA (XApp (GhcPass id)
-> LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass id)
EpAnnCO
noComments LHsExpr (GhcPass id)
f (LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr (GhcPass id)
x))

nlHsSyntaxApps :: SyntaxExprTc -> [LHsExpr GhcTc]
               -> LHsExpr GhcTc
nlHsSyntaxApps :: SyntaxExprTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
nlHsSyntaxApps (SyntaxExprTc { syn_expr :: SyntaxExprTc -> HsExpr GhcTc
syn_expr      = HsExpr GhcTc
fun
                             , syn_arg_wraps :: SyntaxExprTc -> [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps
                             , syn_res_wrap :: SyntaxExprTc -> HsWrapper
syn_res_wrap  = HsWrapper
res_wrap }) [LHsExpr GhcTc]
args
  = HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrap HsWrapper
res_wrap ((GenLocated SrcSpanAnnA (HsExpr GhcTc)
 -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
 -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall a an. a -> LocatedAn an a
noLocA HsExpr GhcTc
fun) (String
-> (HsWrapper
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> [HsWrapper]
-> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
forall a b c.
HasDebugCallStack =>
String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"nlHsSyntaxApps"
                                                     HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
HsWrapper
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
mkLHsWrap [HsWrapper]
arg_wraps [LHsExpr GhcTc]
[GenLocated SrcSpanAnnA (HsExpr GhcTc)]
args))
nlHsSyntaxApps SyntaxExprTc
NoSyntaxExprTc [LHsExpr GhcTc]
args = String -> SDoc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"nlHsSyntaxApps" ([GenLocated SrcSpanAnnA (HsExpr GhcTc)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsExpr GhcTc]
[GenLocated SrcSpanAnnA (HsExpr GhcTc)]
args)
  -- this function should never be called in scenarios where there is no
  -- syntax expr

nlHsApps :: IsSrcSpanAnn p a
         => IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsApps IdP (GhcPass p)
f [LHsExpr (GhcPass p)]
xs = (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (IdP (GhcPass p) -> LHsExpr (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar IdP (GhcPass p)
f) [LHsExpr (GhcPass p)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
xs

nlHsVarApps :: IsSrcSpanAnn p a
            => IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p)
nlHsVarApps IdP (GhcPass p)
f [IdP (GhcPass p)]
xs = HsExpr (GhcPass p) -> LocatedAn AnnListItem (HsExpr (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA ((HsExpr (GhcPass p) -> HsExpr (GhcPass p) -> HsExpr (GhcPass p))
-> HsExpr (GhcPass p) -> [HsExpr (GhcPass p)] -> HsExpr (GhcPass p)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HsExpr (GhcPass p) -> HsExpr (GhcPass p) -> HsExpr (GhcPass p)
forall {p} {an}.
(XRec p (HsExpr p) ~ LocatedAn an (HsExpr p), XApp p ~ EpAnnCO) =>
HsExpr p -> HsExpr p -> HsExpr p
mk (XVar (GhcPass p) -> LIdP (GhcPass p) -> HsExpr (GhcPass p)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass p)
NoExtField
noExtField (IdGhcP p -> LocatedAn a (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
f))
                                         ((IdGhcP p -> HsExpr (GhcPass p))
-> [IdGhcP p] -> [HsExpr (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map ((XVar (GhcPass p) -> LIdP (GhcPass p) -> HsExpr (GhcPass p)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass p)
NoExtField
noExtField) (LocatedAn a (IdGhcP p) -> HsExpr (GhcPass p))
-> (IdGhcP p -> LocatedAn a (IdGhcP p))
-> IdGhcP p
-> HsExpr (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdGhcP p -> LocatedAn a (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA) [IdP (GhcPass p)]
[IdGhcP p]
xs))
                 where
                   mk :: HsExpr p -> HsExpr p -> HsExpr p
mk HsExpr p
f HsExpr p
a = XApp p -> XRec p (HsExpr p) -> XRec p (HsExpr p) -> HsExpr p
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp p
EpAnnCO
noComments (HsExpr p -> LocatedAn an (HsExpr p)
forall a an. a -> LocatedAn an a
noLocA HsExpr p
f) (HsExpr p -> LocatedAn an (HsExpr p)
forall a an. a -> LocatedAn an a
noLocA HsExpr p
a)

nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs
nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs
nlConVarPat RdrName
con [RdrName]
vars = RdrName -> [LPat GhcPs] -> LPat GhcPs
nlConPat RdrName
con ((RdrName -> LocatedAn AnnListItem (Pat GhcPs))
-> [RdrName] -> [LocatedAn AnnListItem (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map IdP GhcPs -> LPat GhcPs
RdrName -> LocatedAn AnnListItem (Pat GhcPs)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat [RdrName]
vars)

nlConVarPatName :: Name -> [Name] -> LPat GhcRn
nlConVarPatName :: Name -> [Name] -> LPat (GhcPass 'Renamed)
nlConVarPatName Name
con [Name]
vars = Name -> [LPat (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
nlConPatName Name
con ((Name -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [Name] -> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass 'Renamed) -> LPat (GhcPass 'Renamed)
Name -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat [Name]
vars)

nlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs
nlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs
nlInfixConPat RdrName
con LPat GhcPs
l LPat GhcPs
r = Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs))
-> Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
  { pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
con
  , pat_args :: HsConPatDetails GhcPs
pat_args = LocatedAn AnnListItem (Pat GhcPs)
-> LocatedAn AnnListItem (Pat GhcPs)
-> HsConDetails
     (HsConPatTyArg GhcPs)
     (LocatedAn AnnListItem (Pat GhcPs))
     (HsRecFields GhcPs (LocatedAn AnnListItem (Pat GhcPs)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat GhcPs
l)
                        (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat GhcPs
r)
  , pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
  }

nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs
nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs
nlConPat RdrName
con [LPat GhcPs]
pats = Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs))
-> Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
  { pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
  , pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
con
  , pat_args :: HsConPatDetails GhcPs
pat_args = [HsConPatTyArg GhcPs]
-> [LocatedAn AnnListItem (Pat GhcPs)]
-> HsConDetails
     (HsConPatTyArg GhcPs)
     (LocatedAn AnnListItem (Pat GhcPs))
     (HsRecFields GhcPs (LocatedAn AnnListItem (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] ((LocatedAn AnnListItem (Pat GhcPs)
 -> LocatedAn AnnListItem (Pat GhcPs))
-> [LocatedAn AnnListItem (Pat GhcPs)]
-> [LocatedAn AnnListItem (Pat GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat GhcPs -> LPat GhcPs
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [LPat GhcPs]
[LocatedAn AnnListItem (Pat GhcPs)]
pats)
  }

nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
nlConPatName :: Name -> [LPat (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
nlConPatName Name
con [LPat (GhcPass 'Renamed)]
pats = Pat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall a an. a -> LocatedAn an a
noLocA (Pat (GhcPass 'Renamed)
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> Pat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ ConPat
  { pat_con_ext :: XConPat (GhcPass 'Renamed)
pat_con_ext = XConPat (GhcPass 'Renamed)
NoExtField
noExtField
  , pat_con :: XRec (GhcPass 'Renamed) (ConLikeP (GhcPass 'Renamed))
pat_con = Name -> GenLocated SrcSpanAnnN Name
forall a an. a -> LocatedAn an a
noLocA Name
con
  , pat_args :: HsConPatDetails (GhcPass 'Renamed)
pat_args = [HsConPatTyArg (GhcPass 'Renamed)]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> HsConDetails
     (HsConPatTyArg (GhcPass 'Renamed))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
     (HsRecFields
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] ((GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass 'Renamed) -> LPat (GhcPass 'Renamed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
pats)
  }

nlNullaryConPat :: RdrName -> LPat GhcPs
nlNullaryConPat :: RdrName -> LPat GhcPs
nlNullaryConPat RdrName
con = Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs))
-> Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
  { pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
  , pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
con
  , pat_args :: HsConPatDetails GhcPs
pat_args = [HsConPatTyArg GhcPs]
-> [LocatedAn AnnListItem (Pat GhcPs)]
-> HsConDetails
     (HsConPatTyArg GhcPs)
     (LocatedAn AnnListItem (Pat GhcPs))
     (HsRecFields GhcPs (LocatedAn AnnListItem (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] []
  }

nlWildConPat :: DataCon -> LPat GhcPs
nlWildConPat :: DataCon -> LPat GhcPs
nlWildConPat DataCon
con = Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs))
-> Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ ConPat
  { pat_con_ext :: XConPat GhcPs
pat_con_ext = XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
  , pat_con :: XRec GhcPs (ConLikeP GhcPs)
pat_con = RdrName -> LocatedN RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> LocatedN RdrName) -> RdrName -> LocatedN RdrName
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
con
  , pat_args :: HsConPatDetails GhcPs
pat_args = [HsConPatTyArg (NoGhcTc GhcPs)]
-> [LPat GhcPs] -> HsConPatDetails GhcPs
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] ([LPat GhcPs] -> HsConPatDetails GhcPs)
-> [LPat GhcPs] -> HsConPatDetails GhcPs
forall a b. (a -> b) -> a -> b
$
     Int
-> LocatedAn AnnListItem (Pat GhcPs)
-> [LocatedAn AnnListItem (Pat GhcPs)]
forall a. Int -> a -> [a]
replicate (DataCon -> Int
dataConSourceArity DataCon
con)
               LPat GhcPs
LocatedAn AnnListItem (Pat GhcPs)
nlWildPat
  }

-- | Wildcard pattern - after parsing
nlWildPat :: LPat GhcPs
nlWildPat :: LPat GhcPs
nlWildPat  = Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XWildPat GhcPs -> Pat GhcPs
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcPs
NoExtField
noExtField )

-- | Wildcard pattern - after renaming
nlWildPatName :: LPat GhcRn
nlWildPatName :: LPat (GhcPass 'Renamed)
nlWildPatName  = Pat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall a an. a -> LocatedAn an a
noLocA (XWildPat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
forall p. XWildPat p -> Pat p
WildPat XWildPat (GhcPass 'Renamed)
NoExtField
noExtField )

nlHsDo :: HsDoFlavour -> [LStmt GhcPs (LHsExpr GhcPs)]
       -> LHsExpr GhcPs
nlHsDo :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
nlHsDo HsDoFlavour
ctxt [ExprLStmt GhcPs]
stmts = HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsDo HsDoFlavour
ctxt ([GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
stmts))

nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
nlHsOpApp LHsExpr GhcPs
e1 IdP GhcPs
op LHsExpr GhcPs
e2 = HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
mkHsOpApp LHsExpr GhcPs
e1 IdP GhcPs
op LHsExpr GhcPs
e2)

nlHsLam  :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
nlHsPar  :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
         -> LHsExpr GhcPs
nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs

-- AZ:Is this used?
nlHsLam :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
nlHsLam LMatch GhcPs (LHsExpr GhcPs)
match = HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> LocatedA (HsExpr GhcPs))
-> HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
NoExtField
noExtField
              (MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs)
-> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Origin
-> LocatedL [LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup (DoPmc -> Origin
Generated DoPmc
SkipPmc) ([LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> LocatedL [LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA [LMatch GhcPs (LHsExpr GhcPs)
LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))
match])
nlHsPar :: forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr (GhcPass id)
e     = HsExpr (GhcPass id) -> LocatedAn AnnListItem (HsExpr (GhcPass id))
forall a an. a -> LocatedAn an a
noLocA (LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar LHsExpr (GhcPass id)
e)

-- nlHsIf should generate if-expressions which are NOT subject to
-- RebindableSyntax, so the first field of HsIf is False. (#12080)
nlHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
nlHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
nlHsIf LHsExpr GhcPs
cond LHsExpr GhcPs
true LHsExpr GhcPs
false = HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XIf GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf XIf GhcPs
EpAnn AnnsIf
forall a. EpAnn a
noAnn LHsExpr GhcPs
cond LHsExpr GhcPs
true LHsExpr GhcPs
false)

nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs
nlHsCase LHsExpr GhcPs
expr [LMatch GhcPs (LHsExpr GhcPs)]
matches
  = HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XCase GhcPs
-> LHsExpr GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsExpr GhcPs
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcPs
EpAnn EpAnnHsCase
forall a. EpAnn a
noAnn LHsExpr GhcPs
expr (Origin
-> LocatedL [LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup (DoPmc -> Origin
Generated DoPmc
SkipPmc) ([LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> LocatedL [LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
matches)))
nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
nlList [LHsExpr GhcPs]
exprs          = HsExpr GhcPs -> LocatedA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XExplicitList GhcPs -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
EpAnn AnnList
forall a. EpAnn a
noAnn [LHsExpr GhcPs]
exprs)

nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar :: IsSrcSpanAnn p a
          => PromotionFlag -> IdP (GhcPass p)           -> LHsType (GhcPass p)
nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)

nlHsAppTy :: forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppTy LHsType (GhcPass p)
f LHsType (GhcPass p)
t = HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XAppTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy (GhcPass p)
NoExtField
noExtField LHsType (GhcPass p)
f (PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass p)
t))
nlHsTyVar :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
p IdP (GhcPass p)
x = HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XTyVar (GhcPass p)
-> PromotionFlag -> LIdP (GhcPass p) -> HsType (GhcPass p)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass p)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
p (IdGhcP p -> LocatedAn a (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
x))
nlHsFunTy :: forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy LHsType (GhcPass p)
a LHsType (GhcPass p)
b = HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XFunTy (GhcPass p)
-> HsArrow (GhcPass p)
-> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy (GhcPass p)
EpAnnCO
forall a. EpAnn a
noAnn (LHsUniToken "->" "\8594" (GhcPass p) -> HsArrow (GhcPass p)
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow LHsUniToken "->" "\8594" (GhcPass p)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok) (PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
funPrec LHsType (GhcPass p)
a) LHsType (GhcPass p)
b)
nlHsParTy :: forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy LHsType (GhcPass p)
t   = HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XParTy (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass p)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass p)
t)

nlHsTyConApp :: IsSrcSpanAnn p a
             => PromotionFlag
             -> LexicalFixity -> IdP (GhcPass p)
             -> [LHsTypeArg (GhcPass p)] -> LHsType (GhcPass p)
nlHsTyConApp :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag
-> LexicalFixity
-> IdP (GhcPass p)
-> [LHsTypeArg (GhcPass p)]
-> LHsType (GhcPass p)
nlHsTyConApp PromotionFlag
prom LexicalFixity
fixity IdP (GhcPass p)
tycon [LHsTypeArg (GhcPass p)]
tys
  | LexicalFixity
Infix <- LexicalFixity
fixity
  , HsValArg LHsType (GhcPass p)
ty1 : HsValArg LHsType (GhcPass p)
ty2 : [LHsTypeArg (GhcPass p)]
rest <- [LHsTypeArg (GhcPass p)]
tys
  = (LocatedAn AnnListItem (HsType (GhcPass p))
 -> HsArg
      (GhcPass p)
      (LocatedAn AnnListItem (HsType (GhcPass p)))
      (LocatedAn AnnListItem (HsType (GhcPass p)))
 -> LocatedAn AnnListItem (HsType (GhcPass p)))
-> LocatedAn AnnListItem (HsType (GhcPass p))
-> [HsArg
      (GhcPass p)
      (LocatedAn AnnListItem (HsType (GhcPass p)))
      (LocatedAn AnnListItem (HsType (GhcPass p)))]
-> LocatedAn AnnListItem (HsType (GhcPass p))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsType (GhcPass p)
-> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
LocatedAn AnnListItem (HsType (GhcPass p))
-> HsArg
     (GhcPass p)
     (LocatedAn AnnListItem (HsType (GhcPass p)))
     (LocatedAn AnnListItem (HsType (GhcPass p)))
-> LocatedAn AnnListItem (HsType (GhcPass p))
forall (p :: Pass).
LHsType (GhcPass p)
-> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
mk_app (HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p)))
-> HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p))
forall a b. (a -> b) -> a -> b
$ XOpTy (GhcPass p)
-> PromotionFlag
-> LHsType (GhcPass p)
-> LIdP (GhcPass p)
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy (GhcPass p)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom LHsType (GhcPass p)
ty1 (IdGhcP p -> LocatedAn a (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
tycon) LHsType (GhcPass p)
ty2) [LHsTypeArg (GhcPass p)]
[HsArg
   (GhcPass p)
   (LocatedAn AnnListItem (HsType (GhcPass p)))
   (LocatedAn AnnListItem (HsType (GhcPass p)))]
rest
  | Bool
otherwise
  = (LocatedAn AnnListItem (HsType (GhcPass p))
 -> HsArg
      (GhcPass p)
      (LocatedAn AnnListItem (HsType (GhcPass p)))
      (LocatedAn AnnListItem (HsType (GhcPass p)))
 -> LocatedAn AnnListItem (HsType (GhcPass p)))
-> LocatedAn AnnListItem (HsType (GhcPass p))
-> [HsArg
      (GhcPass p)
      (LocatedAn AnnListItem (HsType (GhcPass p)))
      (LocatedAn AnnListItem (HsType (GhcPass p)))]
-> LocatedAn AnnListItem (HsType (GhcPass p))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsType (GhcPass p)
-> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
LocatedAn AnnListItem (HsType (GhcPass p))
-> HsArg
     (GhcPass p)
     (LocatedAn AnnListItem (HsType (GhcPass p)))
     (LocatedAn AnnListItem (HsType (GhcPass p)))
-> LocatedAn AnnListItem (HsType (GhcPass p))
forall (p :: Pass).
LHsType (GhcPass p)
-> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
mk_app (PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
prom IdP (GhcPass p)
tycon) [LHsTypeArg (GhcPass p)]
[HsArg
   (GhcPass p)
   (LocatedAn AnnListItem (HsType (GhcPass p)))
   (LocatedAn AnnListItem (HsType (GhcPass p)))]
tys
  where
    mk_app :: LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
    mk_app :: forall (p :: Pass).
LHsType (GhcPass p)
-> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
mk_app fun :: LHsType (GhcPass p)
fun@(L SrcSpanAnnA
_ (HsOpTy {})) LHsTypeArg (GhcPass p)
arg = LHsType (GhcPass p)
-> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
LHsType (GhcPass p)
-> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
mk_app (HsType (GhcPass p) -> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (HsType (GhcPass p) -> GenLocated SrcSpanAnnA (HsType (GhcPass p)))
-> HsType (GhcPass p)
-> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a b. (a -> b) -> a -> b
$ XParTy (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass p)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass p)
fun) LHsTypeArg (GhcPass p)
arg
      -- parenthesize things like `(A + B) C`
    mk_app LHsType (GhcPass p)
fun (HsValArg LHsType (GhcPass p)
ty) = HsType (GhcPass p) -> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XAppTy (GhcPass p)
-> LHsType (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy (GhcPass p)
NoExtField
noExtField LHsType (GhcPass p)
fun (PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass p)
ty))
    mk_app LHsType (GhcPass p)
fun (HsTypeArg LHsToken "@" (GhcPass p)
at LHsType (GhcPass p)
ki) = HsType (GhcPass p) -> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XAppKindTy (GhcPass p)
-> LHsType (GhcPass p)
-> LHsToken "@" (GhcPass p)
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
forall pass.
XAppKindTy pass
-> LHsType pass -> LHsToken "@" pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass p)
NoExtField
noExtField LHsType (GhcPass p)
fun LHsToken "@" (GhcPass p)
at (PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass p)
ki))
    mk_app LHsType (GhcPass p)
fun (HsArgPar SrcSpan
_) = HsType (GhcPass p) -> GenLocated SrcSpanAnnA (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XParTy (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass p)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass p)
fun)

nlHsAppKindTy ::
  LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
nlHsAppKindTy :: forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppKindTy LHsType (GhcPass p)
f LHsType (GhcPass p)
k
  = HsType (GhcPass p) -> LocatedAn AnnListItem (HsType (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XAppKindTy (GhcPass p)
-> LHsType (GhcPass p)
-> LHsToken "@" (GhcPass p)
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
forall pass.
XAppKindTy pass
-> LHsType pass -> LHsToken "@" pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass p)
NoExtField
noExtField LHsType (GhcPass p)
f LHsToken "@" (GhcPass p)
GenLocated TokenLocation (HsToken "@")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok (PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass p)
k))

{-
Tuples.  All these functions are *pre-typechecker* because they lack
types on the tuple.
-}

mkLHsTupleExpr :: [LHsExpr (GhcPass p)] -> XExplicitTuple (GhcPass p)
               -> LHsExpr (GhcPass p)
-- Makes a pre-typechecker boxed tuple, deals with 1 case
mkLHsTupleExpr :: forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsTupleExpr [LHsExpr (GhcPass p)
e] XExplicitTuple (GhcPass p)
_ = LHsExpr (GhcPass p)
e
mkLHsTupleExpr [LHsExpr (GhcPass p)]
es XExplicitTuple (GhcPass p)
ext
  = HsExpr (GhcPass p) -> LocatedAn AnnListItem (HsExpr (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (HsExpr (GhcPass p) -> LocatedAn AnnListItem (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p) -> LocatedAn AnnListItem (HsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$ XExplicitTuple (GhcPass p)
-> [HsTupArg (GhcPass p)] -> Boxity -> HsExpr (GhcPass p)
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple (GhcPass p)
ext ((LocatedAn AnnListItem (HsExpr (GhcPass p))
 -> HsTupArg (GhcPass p))
-> [LocatedAn AnnListItem (HsExpr (GhcPass p))]
-> [HsTupArg (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map (XPresent (GhcPass p) -> LHsExpr (GhcPass p) -> HsTupArg (GhcPass p)
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent (GhcPass p)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) [LHsExpr (GhcPass p)]
[LocatedAn AnnListItem (HsExpr (GhcPass p))]
es) Boxity
Boxed

mkLHsVarTuple :: IsSrcSpanAnn p a
               => [IdP (GhcPass p)]  -> XExplicitTuple (GhcPass p)
              -> LHsExpr (GhcPass p)
mkLHsVarTuple :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsVarTuple [IdP (GhcPass p)]
ids XExplicitTuple (GhcPass p)
ext = [XRec (GhcPass p) (HsExpr (GhcPass p))]
-> XExplicitTuple (GhcPass p)
-> XRec (GhcPass p) (HsExpr (GhcPass p))
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsTupleExpr ((IdGhcP p -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> [IdGhcP p] -> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass p) -> XRec (GhcPass p) (HsExpr (GhcPass p))
IdGhcP p -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar [IdP (GhcPass p)]
[IdGhcP p]
ids) XExplicitTuple (GhcPass p)
ext

nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
nlTuplePat [LPat GhcPs]
pats Boxity
box = Pat GhcPs -> LocatedAn AnnListItem (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XTuplePat GhcPs -> [LPat GhcPs] -> Boxity -> Pat GhcPs
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LPat GhcPs]
pats Boxity
box)

missingTupArg :: EpAnn EpaLocation -> HsTupArg GhcPs
missingTupArg :: EpAnn EpaLocation -> HsTupArg GhcPs
missingTupArg EpAnn EpaLocation
ann = XMissing GhcPs -> HsTupArg GhcPs
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcPs
EpAnn EpaLocation
ann

mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkLHsPatTup :: [LPat (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
mkLHsPatTup []     = Pat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall a an. a -> LocatedAn an a
noLocA (Pat (GhcPass 'Renamed)
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> Pat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XTuplePat (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> Boxity -> Pat (GhcPass 'Renamed)
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat (GhcPass 'Renamed)
NoExtField
noExtField [] Boxity
Boxed
mkLHsPatTup [LPat (GhcPass 'Renamed)
lpat] = LPat (GhcPass 'Renamed)
lpat
mkLHsPatTup lpats :: [LPat (GhcPass 'Renamed)]
lpats@(LPat (GhcPass 'Renamed)
lpat:[LPat (GhcPass 'Renamed)]
_) = SrcSpanAnnA
-> Pat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
lpat) (Pat (GhcPass 'Renamed)
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> Pat (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XTuplePat (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> Boxity -> Pat (GhcPass 'Renamed)
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat (GhcPass 'Renamed)
NoExtField
noExtField [LPat (GhcPass 'Renamed)]
lpats Boxity
Boxed

-- | The Big equivalents for the source tuple expressions
mkBigLHsVarTup :: IsSrcSpanAnn p a
               => [IdP (GhcPass p)] -> XExplicitTuple (GhcPass p)
               -> LHsExpr (GhcPass p)
mkBigLHsVarTup :: forall (p :: Pass) a.
IsSrcSpanAnn p a =>
[IdP (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkBigLHsVarTup [IdP (GhcPass p)]
ids XExplicitTuple (GhcPass p)
anns = [XRec (GhcPass p) (HsExpr (GhcPass p))]
-> XExplicitTuple (GhcPass p)
-> XRec (GhcPass p) (HsExpr (GhcPass p))
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkBigLHsTup ((IdGhcP p -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> [IdGhcP p] -> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass p) -> XRec (GhcPass p) (HsExpr (GhcPass p))
IdGhcP p -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
nlHsVar [IdP (GhcPass p)]
[IdGhcP p]
ids) XExplicitTuple (GhcPass p)
anns

mkBigLHsTup :: [LHsExpr (GhcPass id)] -> XExplicitTuple (GhcPass id)
            -> LHsExpr (GhcPass id)
mkBigLHsTup :: forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkBigLHsTup [LHsExpr (GhcPass id)]
es XExplicitTuple (GhcPass id)
anns = ([GenLocated SrcSpanAnnA (HsExpr (GhcPass id))]
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass id)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass id))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass id))
forall a. ([a] -> a) -> [a] -> a
mkChunkified (\[GenLocated SrcSpanAnnA (HsExpr (GhcPass id))]
e -> [LHsExpr (GhcPass id)]
-> XExplicitTuple (GhcPass id) -> LHsExpr (GhcPass id)
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
mkLHsTupleExpr [LHsExpr (GhcPass id)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass id))]
e XExplicitTuple (GhcPass id)
anns) [LHsExpr (GhcPass id)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass id))]
es

-- | The Big equivalents for the source tuple patterns
mkBigLHsVarPatTup :: [IdP GhcRn] -> LPat GhcRn
mkBigLHsVarPatTup :: [IdP (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
mkBigLHsVarPatTup [IdP (GhcPass 'Renamed)]
bs = [LPat (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
mkBigLHsPatTup ((IdGhcP 'Renamed
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [IdGhcP 'Renamed]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
forall a b. (a -> b) -> [a] -> [b]
map IdP (GhcPass 'Renamed) -> LPat (GhcPass 'Renamed)
IdGhcP 'Renamed -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
nlVarPat [IdP (GhcPass 'Renamed)]
[IdGhcP 'Renamed]
bs)

mkBigLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
mkBigLHsPatTup :: [LPat (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
mkBigLHsPatTup = ([GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall a. ([a] -> a) -> [a] -> a
mkChunkified [LPat (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
mkLHsPatTup

{-
************************************************************************
*                                                                      *
        LHsSigType and LHsSigWcType
*                                                                      *
********************************************************************* -}

-- | Convert an 'LHsType' to an 'LHsSigType'.
hsTypeToHsSigType :: LHsType GhcPs -> LHsSigType GhcPs
hsTypeToHsSigType :: LHsType GhcPs -> LHsSigType GhcPs
hsTypeToHsSigType lty :: LHsType GhcPs
lty@(L SrcSpanAnnA
loc HsType GhcPs
ty) = SrcSpanAnnA
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall a b. (a -> b) -> a -> b
$ case HsType GhcPs
ty of
  HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
hst_tele = HsForAllInvis { hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
hsf_xinvis = XHsForAllInvis GhcPs
an
                                        , hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcPs]
bndrs }
             , hst_body :: forall pass. HsType pass -> LHsType pass
hst_body = LHsType GhcPs
body }
    -> EpAnnForallTy
-> [LHsTyVarBndr Specificity GhcPs]
-> LHsType GhcPs
-> HsSigType GhcPs
mkHsExplicitSigType XHsForAllInvis GhcPs
EpAnnForallTy
an [LHsTyVarBndr Specificity GhcPs]
bndrs LHsType GhcPs
body
  HsType GhcPs
_ -> LHsType GhcPs -> HsSigType GhcPs
mkHsImplicitSigType LHsType GhcPs
lty

-- | Convert an 'LHsType' to an 'LHsSigWcType'.
hsTypeToHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs
hsTypeToHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs
hsTypeToHsSigWcType = GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall thing. thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs (GenLocated SrcSpanAnnA (HsSigType GhcPs)
 -> HsWildCardBndrs
      GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs)))
-> (GenLocated SrcSpanAnnA (HsType GhcPs)
    -> GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
hsTypeToHsSigType

mkHsSigEnv :: forall a. (LSig GhcRn -> Maybe ([LocatedN Name], a))
                     -> [LSig GhcRn]
                     -> NameEnv a
mkHsSigEnv :: forall a.
(LSig (GhcPass 'Renamed)
 -> Maybe ([GenLocated SrcSpanAnnN Name], a))
-> [LSig (GhcPass 'Renamed)] -> NameEnv a
mkHsSigEnv LSig (GhcPass 'Renamed) -> Maybe ([GenLocated SrcSpanAnnN Name], a)
get_info [LSig (GhcPass 'Renamed)]
sigs
  = [(Name, a)] -> NameEnv a
forall a. [(Name, a)] -> NameEnv a
mkNameEnv          ([LSig (GhcPass 'Renamed)] -> [(Name, a)]
mk_pairs [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
ordinary_sigs)
   NameEnv a -> [(Name, a)] -> NameEnv a
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
`extendNameEnvList` ([LSig (GhcPass 'Renamed)] -> [(Name, a)]
mk_pairs [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
gen_dm_sigs)
   -- The subtlety is this: in a class decl with a
   -- default-method signature as well as a method signature
   -- we want the latter to win (#12533)
   --    class C x where
   --       op :: forall a . x a -> x a
   --       default op :: forall b . x b -> x b
   --       op x = ...(e :: b -> b)...
   -- The scoped type variables of the 'default op', namely 'b',
   -- scope over the code for op.   The 'forall a' does not!
   -- This applies both in the renamer and typechecker, both
   -- of which use this function
  where
    ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
gen_dm_sigs, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
ordinary_sigs) = (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> Bool)
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
-> ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))],
    [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> Bool
forall {l} {pass}. GenLocated l (Sig pass) -> Bool
is_gen_dm_sig [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
sigs
    is_gen_dm_sig :: GenLocated l (Sig pass) -> Bool
is_gen_dm_sig (L l
_ (ClassOpSig XClassOpSig pass
_ Bool
True [LIdP pass]
_ LHsSigType pass
_)) = Bool
True
    is_gen_dm_sig GenLocated l (Sig pass)
_                             = Bool
False

    mk_pairs :: [LSig GhcRn] -> [(Name, a)]
    mk_pairs :: [LSig (GhcPass 'Renamed)] -> [(Name, a)]
mk_pairs [LSig (GhcPass 'Renamed)]
sigs = [ (Name
n,a
a) | Just ([GenLocated SrcSpanAnnN Name]
ns,a
a) <- (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
 -> Maybe ([GenLocated SrcSpanAnnN Name], a))
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
-> [Maybe ([GenLocated SrcSpanAnnN Name], a)]
forall a b. (a -> b) -> [a] -> [b]
map LSig (GhcPass 'Renamed) -> Maybe ([GenLocated SrcSpanAnnN Name], a)
GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
-> Maybe ([GenLocated SrcSpanAnnN Name], a)
get_info [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
sigs
                            , L SrcSpanAnnN
_ Name
n <- [GenLocated SrcSpanAnnN Name]
ns ]

mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]
-- ^ Convert 'TypeSig' to 'ClassOpSig'.
-- The former is what is parsed, but the latter is
-- what we need in class/instance declarations
mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]
mkClassOpSigs [LSig GhcPs]
sigs
  = (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> GenLocated SrcSpanAnnA (Sig GhcPs))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (Sig GhcPs)
forall {pass} {l}.
(XTypeSig pass ~ XClassOpSig pass) =>
GenLocated l (Sig pass) -> GenLocated l (Sig pass)
fiddle [LSig GhcPs]
[GenLocated SrcSpanAnnA (Sig GhcPs)]
sigs
  where
    fiddle :: GenLocated l (Sig pass) -> GenLocated l (Sig pass)
fiddle (L l
loc (TypeSig XTypeSig pass
anns [LIdP pass]
nms LHsSigWcType pass
ty))
      = l -> Sig pass -> GenLocated l (Sig pass)
forall l e. l -> e -> GenLocated l e
L l
loc (XClassOpSig pass
-> Bool -> [LIdP pass] -> LHsSigType pass -> Sig pass
forall pass.
XClassOpSig pass
-> Bool -> [LIdP pass] -> LHsSigType pass -> Sig pass
ClassOpSig XClassOpSig pass
XTypeSig pass
anns Bool
False [LIdP pass]
nms (LHsSigWcType pass -> LHsSigType pass
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType pass
ty))
    fiddle GenLocated l (Sig pass)
sig = GenLocated l (Sig pass)
sig

{- *********************************************************************
*                                                                      *
    --------- HsWrappers: type args, dict args, casts ---------
*                                                                      *
********************************************************************* -}

mkLHsWrap :: HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrap :: HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrap HsWrapper
co_fn (L SrcSpanAnnA
loc HsExpr GhcTc
e) = SrcSpanAnnA
-> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap HsWrapper
co_fn HsExpr GhcTc
e)

mkHsWrap :: HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap :: HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap HsWrapper
co_fn HsExpr GhcTc
e | HsWrapper -> Bool
isIdHsWrapper HsWrapper
co_fn = HsExpr GhcTc
e
mkHsWrap HsWrapper
co_fn HsExpr GhcTc
e                       = XXExpr GhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (HsWrap HsExpr -> XXExprGhcTc
WrapExpr (HsWrap HsExpr -> XXExprGhcTc) -> HsWrap HsExpr -> XXExprGhcTc
forall a b. (a -> b) -> a -> b
$ HsWrapper -> HsExpr GhcTc -> HsWrap HsExpr
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
co_fn HsExpr GhcTc
e)

mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b
           -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrapCo :: TcCoercionN -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrapCo TcCoercionN
co HsExpr GhcTc
e = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap (TcCoercionN -> HsWrapper
mkWpCastN TcCoercionN
co) HsExpr GhcTc
e

mkHsWrapCoR :: TcCoercionR   -- A Representational coercion  a ~R b
            -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrapCoR :: TcCoercionN -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrapCoR TcCoercionN
co HsExpr GhcTc
e = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrap (TcCoercionN -> HsWrapper
mkWpCastR TcCoercionN
co) HsExpr GhcTc
e

mkLHsWrapCo :: TcCoercionN -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrapCo :: TcCoercionN -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrapCo TcCoercionN
co (L SrcSpanAnnA
loc HsExpr GhcTc
e) = SrcSpanAnnA
-> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (TcCoercionN -> HsExpr GhcTc -> HsExpr GhcTc
mkHsWrapCo TcCoercionN
co HsExpr GhcTc
e)

mkHsCmdWrap :: HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
mkHsCmdWrap :: HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
mkHsCmdWrap HsWrapper
w HsCmd GhcTc
cmd | HsWrapper -> Bool
isIdHsWrapper HsWrapper
w = HsCmd GhcTc
cmd
                  | Bool
otherwise       = XXCmd GhcTc -> HsCmd GhcTc
forall id. XXCmd id -> HsCmd id
XCmd (HsWrapper -> HsCmd GhcTc -> HsWrap HsCmd
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
w HsCmd GhcTc
cmd)

mkLHsCmdWrap :: HsWrapper -> LHsCmd GhcTc -> LHsCmd GhcTc
mkLHsCmdWrap :: HsWrapper -> LHsCmd GhcTc -> LHsCmd GhcTc
mkLHsCmdWrap HsWrapper
w (L SrcSpanAnnA
loc HsCmd GhcTc
c) = SrcSpanAnnA -> HsCmd GhcTc -> LocatedA (HsCmd GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
mkHsCmdWrap HsWrapper
w HsCmd GhcTc
c)

mkHsWrapPat :: HsWrapper -> Pat GhcTc -> Type -> Pat GhcTc
mkHsWrapPat :: HsWrapper -> Pat GhcTc -> Type -> Pat GhcTc
mkHsWrapPat HsWrapper
co_fn Pat GhcTc
p Type
ty | HsWrapper -> Bool
isIdHsWrapper HsWrapper
co_fn = Pat GhcTc
p
                       | Bool
otherwise           = XXPat GhcTc -> Pat GhcTc
forall p. XXPat p -> Pat p
XPat (XXPat GhcTc -> Pat GhcTc) -> XXPat GhcTc -> Pat GhcTc
forall a b. (a -> b) -> a -> b
$ HsWrapper -> Pat GhcTc -> Type -> XXPatGhcTc
CoPat HsWrapper
co_fn Pat GhcTc
p Type
ty

mkHsWrapPatCo :: TcCoercionN -> Pat GhcTc -> Type -> Pat GhcTc
mkHsWrapPatCo :: TcCoercionN -> Pat GhcTc -> Type -> Pat GhcTc
mkHsWrapPatCo TcCoercionN
co Pat GhcTc
pat Type
ty | TcCoercionN -> Bool
isReflCo TcCoercionN
co = Pat GhcTc
pat
                        | Bool
otherwise     = XXPat GhcTc -> Pat GhcTc
forall p. XXPat p -> Pat p
XPat (XXPat GhcTc -> Pat GhcTc) -> XXPat GhcTc -> Pat GhcTc
forall a b. (a -> b) -> a -> b
$ HsWrapper -> Pat GhcTc -> Type -> XXPatGhcTc
CoPat (TcCoercionN -> HsWrapper
mkWpCastN TcCoercionN
co) Pat GhcTc
pat Type
ty

mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsDictLet TcEvBinds
ev_binds LHsExpr GhcTc
expr = HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
mkLHsWrap (TcEvBinds -> HsWrapper
mkWpLet TcEvBinds
ev_binds) LHsExpr GhcTc
expr

{-
l
************************************************************************
*                                                                      *
                Bindings; with a location at the top
*                                                                      *
************************************************************************
-}

mkFunBind :: Origin -> LocatedN RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
          -> HsBind GhcPs
-- ^ Not infix, with place holders for coercion and free vars
mkFunBind :: Origin
-> LocatedN RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
mkFunBind Origin
origin LocatedN RdrName
fn [LMatch GhcPs (LHsExpr GhcPs)]
ms
  = FunBind { fun_id :: LIdP GhcPs
fun_id = LIdP GhcPs
LocatedN RdrName
fn
            , fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches = Origin
-> LocatedL [LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (LocatedA (HsExpr GhcPs))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
origin ([LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
-> LocatedL [LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA [LMatch GhcPs (LHsExpr GhcPs)]
[LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))]
ms)
            , fun_ext :: XFunBind GhcPs GhcPs
fun_ext = XFunBind GhcPs GhcPs
NoExtField
noExtField
            }

mkTopFunBind :: Origin -> LocatedN Name -> [LMatch GhcRn (LHsExpr GhcRn)]
             -> HsBind GhcRn
-- ^ In Name-land, with empty bind_fvs
mkTopFunBind :: Origin
-> GenLocated SrcSpanAnnN Name
-> [LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
-> HsBind (GhcPass 'Renamed)
mkTopFunBind Origin
origin GenLocated SrcSpanAnnN Name
fn [LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
ms = FunBind { fun_id :: LIdP (GhcPass 'Renamed)
fun_id = LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
fn
                                    , fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_matches = Origin
-> LocatedL
     [LocatedA
        (Match
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> MatchGroup
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
origin ([LocatedA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> LocatedL
     [LocatedA
        (Match
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a an. a -> LocatedAn an a
noLocA [LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
[LocatedA
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ms)
                                    , fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_ext  = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
NameSet
emptyNameSet -- NB: closed
                                                              --     binding
                                    }

mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
mkHsVarBind SrcSpan
loc RdrName
var LHsExpr GhcPs
rhs = SrcSpan
-> RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
var [] LHsExpr GhcPs
rhs

mkVarBind :: IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc
mkVarBind :: IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc
mkVarBind IdP GhcTc
var LHsExpr GhcTc
rhs = SrcSpanAnnA
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall l e. l -> e -> GenLocated l e
L (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
rhs) (HsBindLR GhcTc GhcTc
 -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$
                    VarBind { var_ext :: XVarBind GhcTc GhcTc
var_ext = XVarBind GhcTc GhcTc
NoExtField
noExtField,
                              var_id :: IdP GhcTc
var_id = IdP GhcTc
var, var_rhs :: LHsExpr GhcTc
var_rhs = LHsExpr GhcTc
rhs }

mkPatSynBind :: LocatedN RdrName -> HsPatSynDetails GhcPs
             -> LPat GhcPs -> HsPatSynDir GhcPs -> EpAnn [AddEpAnn] -> HsBind GhcPs
mkPatSynBind :: LocatedN RdrName
-> HsPatSynDetails GhcPs
-> LPat GhcPs
-> HsPatSynDir GhcPs
-> EpAnn [AddEpAnn]
-> HsBind GhcPs
mkPatSynBind LocatedN RdrName
name HsPatSynDetails GhcPs
details LPat GhcPs
lpat HsPatSynDir GhcPs
dir EpAnn [AddEpAnn]
anns = XPatSynBind GhcPs GhcPs -> PatSynBind GhcPs GhcPs -> HsBind GhcPs
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind GhcPs GhcPs
NoExtField
noExtField PatSynBind GhcPs GhcPs
psb
  where
    psb :: PatSynBind GhcPs GhcPs
psb = PSB{ psb_ext :: XPSB GhcPs GhcPs
psb_ext = XPSB GhcPs GhcPs
EpAnn [AddEpAnn]
anns
             , psb_id :: LIdP GhcPs
psb_id = LIdP GhcPs
LocatedN RdrName
name
             , psb_args :: HsPatSynDetails GhcPs
psb_args = HsPatSynDetails GhcPs
details
             , psb_def :: LPat GhcPs
psb_def = LPat GhcPs
lpat
             , psb_dir :: HsPatSynDir GhcPs
psb_dir = HsPatSynDir GhcPs
dir }

-- |If any of the matches in the 'FunBind' are infix, the 'FunBind' is
-- considered infix.
isInfixFunBind :: forall id1 id2. UnXRec id2 => HsBindLR id1 id2 -> Bool
isInfixFunBind :: forall id1 id2. UnXRec id2 => HsBindLR id1 id2 -> Bool
isInfixFunBind (FunBind { fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MG XMG id2 (LHsExpr id2)
_ XRec id2 [LMatch id2 (LHsExpr id2)]
matches })
  = (LMatch id2 (LHsExpr id2) -> Bool)
-> [LMatch id2 (LHsExpr id2)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Match id2 (LHsExpr id2) -> Bool
forall id body. Match id body -> Bool
isInfixMatch (Match id2 (LHsExpr id2) -> Bool)
-> (LMatch id2 (LHsExpr id2) -> Match id2 (LHsExpr id2))
-> LMatch id2 (LHsExpr id2)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @id2) (forall p a. UnXRec p => XRec p a -> a
unXRec @id2 XRec id2 [LMatch id2 (LHsExpr id2)]
matches)
isInfixFunBind HsBindLR id1 id2
_ = Bool
False

-- |Return the 'SrcSpan' encompassing the contents of any enclosed binds
spanHsLocaLBinds :: HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds :: forall (p :: Pass). HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds (EmptyLocalBinds XEmptyLocalBinds (GhcPass p) (GhcPass p)
_) = SrcSpan
noSrcSpan
spanHsLocaLBinds (HsValBinds XHsValBinds (GhcPass p) (GhcPass p)
_ (ValBinds XValBinds (GhcPass p) (GhcPass p)
_ LHsBindsLR (GhcPass p) (GhcPass p)
bs [LSig (GhcPass p)]
sigs))
  = (SrcSpan -> SrcSpan -> SrcSpan) -> SrcSpan -> [SrcSpan] -> SrcSpan
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
noSrcSpan ([SrcSpan]
bsSpans [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
sigsSpans)
  where
    bsSpans :: [SrcSpan]
    bsSpans :: [SrcSpan]
bsSpans = (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))
 -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
-> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA ([GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
 -> [SrcSpan])
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
-> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
forall a. Bag a -> [a]
bagToList LHsBindsLR (GhcPass p) (GhcPass p)
Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
bs
    sigsSpans :: [SrcSpan]
    sigsSpans :: [SrcSpan]
sigsSpans = (GenLocated SrcSpanAnnA (Sig (GhcPass p)) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (Sig (GhcPass p))] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Sig (GhcPass p)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LSig (GhcPass p)]
[GenLocated SrcSpanAnnA (Sig (GhcPass p))]
sigs
spanHsLocaLBinds (HsValBinds XHsValBinds (GhcPass p) (GhcPass p)
_ (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR (GhcPass p) (GhcPass p))]
bs [LSig (GhcPass 'Renamed)]
sigs)))
  = (SrcSpan -> SrcSpan -> SrcSpan) -> SrcSpan -> [SrcSpan] -> SrcSpan
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
noSrcSpan ([SrcSpan]
bsSpans [SrcSpan] -> [SrcSpan] -> [SrcSpan]
forall a. [a] -> [a] -> [a]
++ [SrcSpan]
sigsSpans)
  where
    bsSpans :: [SrcSpan]
    bsSpans :: [SrcSpan]
bsSpans = (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))
 -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
-> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA ([GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
 -> [SrcSpan])
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
-> [SrcSpan]
forall a b. (a -> b) -> a -> b
$ ((RecFlag,
  Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
 -> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))])
-> [(RecFlag,
     Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))]
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
forall a. Bag a -> [a]
bagToList (Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
 -> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))])
-> ((RecFlag,
     Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
-> (RecFlag,
    Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
-> [GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecFlag,
 Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
forall a b. (a, b) -> b
snd) [(RecFlag, LHsBindsLR (GhcPass p) (GhcPass p))]
[(RecFlag,
  Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))]
bs
    sigsSpans :: [SrcSpan]
    sigsSpans :: [SrcSpan]
sigsSpans = (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
sigs
spanHsLocaLBinds (HsIPBinds XHsIPBinds (GhcPass p) (GhcPass p)
_ (IPBinds XIPBinds (GhcPass p)
_ [LIPBind (GhcPass p)]
bs))
  = (SrcSpan -> SrcSpan -> SrcSpan) -> SrcSpan -> [SrcSpan] -> SrcSpan
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
noSrcSpan ((GenLocated SrcSpanAnnA (IPBind (GhcPass p)) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (IPBind (GhcPass p))] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (IPBind (GhcPass p)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [LIPBind (GhcPass p)]
[GenLocated SrcSpanAnnA (IPBind (GhcPass p))]
bs)

------------
-- | Convenience function using 'mkFunBind'.
-- This is for generated bindings only, do not use for user-written code.
mkSimpleGeneratedFunBind :: SrcSpan -> RdrName -> [LPat GhcPs]
                         -> LHsExpr GhcPs -> LHsBind GhcPs
mkSimpleGeneratedFunBind :: SrcSpan
-> RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> LHsBind GhcPs
mkSimpleGeneratedFunBind SrcSpan
loc RdrName
fun [LPat GhcPs]
pats LHsExpr GhcPs
expr
  = SrcSpanAnnA
-> HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs))
-> HsBind GhcPs -> GenLocated SrcSpanAnnA (HsBind GhcPs)
forall a b. (a -> b) -> a -> b
$ Origin
-> LocatedN RdrName
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
mkFunBind (DoPmc -> Origin
Generated DoPmc
SkipPmc) (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
fun)
              [HsMatchContext GhcPs
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> HsLocalBinds GhcPs
-> LMatch GhcPs (LHsExpr GhcPs)
forall (p :: Pass).
IsPass p =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch (LIdP (NoGhcTc GhcPs) -> HsMatchContext GhcPs
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) RdrName
fun)) [LPat GhcPs]
pats LHsExpr GhcPs
expr
                       HsLocalBinds GhcPs
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds]

-- | Make a prefix, non-strict function 'HsMatchContext'
mkPrefixFunRhs :: LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs :: forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc p)
n = FunRhs { mc_fun :: LIdP (NoGhcTc p)
mc_fun = LIdP (NoGhcTc p)
n
                          , mc_fixity :: LexicalFixity
mc_fixity = LexicalFixity
Prefix
                          , mc_strictness :: SrcStrictness
mc_strictness = SrcStrictness
NoSrcStrict }

------------
mkMatch :: forall p. IsPass p
        => HsMatchContext (GhcPass p)
        -> [LPat (GhcPass p)]
        -> LHsExpr (GhcPass p)
        -> HsLocalBinds (GhcPass p)
        -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch :: forall (p :: Pass).
IsPass p =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext (GhcPass p)
ctxt [LPat (GhcPass p)]
pats LHsExpr (GhcPass p)
expr HsLocalBinds (GhcPass p)
binds
  = Match (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
-> LocatedAn
     AnnListItem (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))
forall a an. a -> LocatedAn an a
noLocA (Match { m_ext :: XCMatch (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
m_ext   = XCMatch (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                  , m_ctxt :: HsMatchContext (GhcPass p)
m_ctxt  = HsMatchContext (GhcPass p)
ctxt
                  , m_pats :: [LPat (GhcPass p)]
m_pats  = (GenLocated SrcSpanAnnA (Pat (GhcPass p))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map LPat (GhcPass p) -> LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> GenLocated SrcSpanAnnA (Pat (GhcPass p))
forall (p :: Pass).
IsPass p =>
LPat (GhcPass p) -> LPat (GhcPass p)
mkParPat [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats
                  , m_grhss :: GRHSs (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
m_grhss = XCGRHSs (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
-> [LGRHS (GhcPass p) (LocatedA (HsExpr (GhcPass p)))]
-> HsLocalBinds (GhcPass p)
-> GRHSs (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass p) (LocatedA (HsExpr (GhcPass p)))
EpAnnComments
emptyComments (EpAnn GrhsAnn
-> SrcSpan
-> LocatedA (HsExpr (GhcPass p))
-> [LGRHS (GhcPass p) (LocatedA (HsExpr (GhcPass p)))]
forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
EpAnn GrhsAnn
-> SrcSpan
-> LocatedA (body (GhcPass p))
-> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
unguardedRHS EpAnn GrhsAnn
forall a. EpAnn a
noAnn SrcSpan
noSrcSpan LHsExpr (GhcPass p)
LocatedA (HsExpr (GhcPass p))
expr) HsLocalBinds (GhcPass p)
binds })

{-
************************************************************************
*                                                                      *
        Collecting binders
*                                                                      *
************************************************************************

Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.

...
where
  (x, y) = ...
  f i j  = ...
  [a, b] = ...

it should return [x, y, f, a, b] (remember, order important).

Note [Collect binders only after renaming]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
These functions should only be used on HsSyn *after* the renamer,
to return a [Name] or [Id].  Before renaming the record punning
and wild-card mechanism makes it hard to know what is bound.
So these functions should not be applied to (HsSyn RdrName)

Note [isUnliftedHsBind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The function isUnliftedHsBind tells if the binding binds a variable of
unlifted type.  e.g.

  - I# x = blah
  - Just (I# x) = blah

isUnliftedHsBind is used in two ways:

* To complain if we make a top-level binding for a variable of unlifted
  type. E.g. any of the above bindings are illegal at top level

* To generate a case expression for a non-recursive local let.  E.g.
     let Just (I# x) = blah in body
  ==>
     case blah of Just (I# x) -> body
  See GHC.HsToCore.Expr.dsUnliftedBind.

Wrinkles:

(W1) For AbsBinds we must check if the local letrec generated by desugaring
     AbsBinds would be unlifted; so we just recurse into the abs_binds. E.g.
       f :: Num a => (# a, a #)
       g :: Num a => a -> a
       f = ...g...
       g = ...g...

    The top-level bindings for f,g are not unlifted (because of the Num a =>),
    but the local, recursive, monomorphic bindings are:
      t = /\a \(d:Num a).
         letrec fm :: (# a, a #) = ...g...
                gm :: a -> a = ...f...
         in (fm, gm)

   Here the binding for 'fm' is illegal.  So we recurse into the abs_binds

(W2) BUT we have a special case when abs_sig is true;
     see Note [The abs_sig field of AbsBinds] in GHC.Hs.Binds

(W3) isUnliftedHsBind returns False even if the binding itself is
     unlifted, provided it binds only lifted variables. E.g.
      -  (# a,b #) = (# reverse xs, xs #)

      -  x = sqrt# y#  :: Float#

      -  type Unl :: UnliftedType
         data Unl = MkUnl Int
         MkUnl z = blah

     In each case the RHS of the "=" has unlifted type, but isUnliftedHsBind
     returns False.  Reason: see GHC Proposal #35
        https://github.com/ghc-proposals/ghc-proposals/blob/master/
        proposals/0035-unbanged-strict-patterns.rst

(W4) In particular, (W3) applies to a pattern that binds no variables at all.
     So   { _ = sqrt# y :: Float# } returns False from isUnliftedHsBind, but
          { x = sqrt# y :: Float# } returns True.
     This is arguably a bit confusing (see #22719)
-}

----------------- Bindings --------------------------

-- | Should we treat this as an unlifted bind? This will be true for any
-- bind that binds an unlifted variable, but we must be careful around
-- AbsBinds. See Note [isUnliftedHsBind]. For usage
-- information, see Note [Strict binds checks] is GHC.HsToCore.Binds.
isUnliftedHsBind :: HsBind GhcTc -> Bool  -- works only over typechecked binds
isUnliftedHsBind :: HsBindLR GhcTc GhcTc -> Bool
isUnliftedHsBind (XHsBindsLR (AbsBinds { abs_exports :: AbsBinds -> [ABExport]
abs_exports = [ABExport]
exports
                                       , abs_sig :: AbsBinds -> Bool
abs_sig     = Bool
has_sig
                                       , abs_binds :: AbsBinds -> LHsBinds GhcTc
abs_binds   = LHsBinds GhcTc
binds }))
  | Bool
has_sig   = (ABExport -> Bool) -> [ABExport] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Id -> Bool
is_unlifted_id (Id -> Bool) -> (ABExport -> Id) -> ABExport -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABExport -> Id
abe_poly) [ABExport]
exports
  | Bool
otherwise = LHsBinds GhcTc -> Bool
isUnliftedHsBinds LHsBinds GhcTc
binds
    -- See wrinkle (W1) and (W2) in Note [isUnliftedHsBind]
    -- If has_sig is True we will never generate a binding for abe_mono,
    -- so we don't need to worry about it being unlifted. The abe_poly
    -- binding might not be: e.g. forall a. Num a => (# a, a #)
    -- If has_sig is False, just recurse

isUnliftedHsBind (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
_ Id
fun })
  = Id -> Bool
is_unlifted_id Id
fun

isUnliftedHsBind (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP GhcTc
var })
  = Id -> Bool
is_unlifted_id IdP GhcTc
Id
var

isUnliftedHsBind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcTc
pat })
  = (Id -> Bool) -> [Id] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Id -> Bool
is_unlifted_id (CollectFlag GhcTc -> LPat GhcTc -> [IdP GhcTc]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders LPat GhcTc
pat)
    -- If we changed our view on (W3) you could add
    --    || isUnliftedType pat_ty
    -- to this check

isUnliftedHsBind (PatSynBind {}) = String -> Bool
forall a. HasCallStack => String -> a
panic String
"isUnliftedBind: PatSynBind"

isUnliftedHsBinds :: LHsBinds GhcTc -> Bool
isUnliftedHsBinds :: LHsBinds GhcTc -> Bool
isUnliftedHsBinds = (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> Bool)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)) -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
anyBag (HsBindLR GhcTc GhcTc -> Bool
isUnliftedHsBind (HsBindLR GhcTc GhcTc -> Bool)
-> (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> HsBindLR GhcTc GhcTc)
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> HsBindLR GhcTc GhcTc
forall l e. GenLocated l e -> e
unLoc)

is_unlifted_id :: Id -> Bool
is_unlifted_id :: Id -> Bool
is_unlifted_id Id
id = HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType (Id -> Type
idType Id
id)
   -- Bindings always have a fixed RuntimeRep, so it's OK
   -- to call isUnliftedType here

-- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?
isBangedHsBind :: HsBind GhcTc -> Bool
isBangedHsBind :: HsBindLR GhcTc GhcTc -> Bool
isBangedHsBind (XHsBindsLR (AbsBinds { abs_binds :: AbsBinds -> LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
binds }))
  = (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> Bool)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)) -> Bool
forall a. (a -> Bool) -> Bag a -> Bool
anyBag (HsBindLR GhcTc GhcTc -> Bool
isBangedHsBind (HsBindLR GhcTc GhcTc -> Bool)
-> (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> HsBindLR GhcTc GhcTc)
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> HsBindLR GhcTc GhcTc
forall l e. GenLocated l e -> e
unLoc) LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds
isBangedHsBind (FunBind {fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
matches})
  | [L Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
_ Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
match] <- GenLocated
  (Anno
     [GenLocated
        (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
        (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))])
  [GenLocated
     (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
     (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
-> [GenLocated
      (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
      (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   (Anno
      [GenLocated
         (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
         (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))])
   [GenLocated
      (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
      (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
 -> [GenLocated
       (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
       (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))])
-> GenLocated
     (Anno
        [GenLocated
           (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
           (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))])
     [GenLocated
        (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
        (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
-> [GenLocated
      (Anno (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
      (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> XRec
     GhcTc [LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
matches
  , FunRhs{mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness = SrcStrictness
SrcStrict} <- Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> HsMatchContext GhcTc
forall p body. Match p body -> HsMatchContext p
m_ctxt Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
match
  = Bool
True
isBangedHsBind (PatBind {pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcTc
pat})
  = LPat GhcTc -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isBangedLPat LPat GhcTc
pat
isBangedHsBind HsBindLR GhcTc GhcTc
_
  = Bool
False

collectLocalBinders :: CollectPass (GhcPass idL)
                    => CollectFlag (GhcPass idL)
                    -> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
                    -> [IdP (GhcPass idL)]
collectLocalBinders :: forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders CollectFlag (GhcPass idL)
flag = \case
    HsValBinds XHsValBinds (GhcPass idL) (GhcPass idR)
_ HsValBindsLR (GhcPass idL) (GhcPass idR)
binds -> CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsIdBinders CollectFlag (GhcPass idL)
flag HsValBindsLR (GhcPass idL) (GhcPass idR)
binds
                          -- No pattern synonyms here
    HsIPBinds {}       -> []
    EmptyLocalBinds XEmptyLocalBinds (GhcPass idL) (GhcPass idR)
_  -> []

collectHsIdBinders :: CollectPass (GhcPass idL)
                   => CollectFlag (GhcPass idL)
                   -> HsValBindsLR (GhcPass idL) (GhcPass idR)
                   -> [IdP (GhcPass idL)]
-- ^ Collect 'Id' binders only, or 'Id's + pattern synonyms, respectively
collectHsIdBinders :: forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsIdBinders CollectFlag (GhcPass idL)
flag = Bool
-> CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
Bool
-> CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR
-> [IdP (GhcPass idL)]
collect_hs_val_binders Bool
True CollectFlag (GhcPass idL)
flag

collectHsValBinders :: CollectPass (GhcPass idL)
                    => CollectFlag (GhcPass idL)
                    -> HsValBindsLR (GhcPass idL) idR
                    -> [IdP (GhcPass idL)]
collectHsValBinders :: forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR -> [IdP (GhcPass idL)]
collectHsValBinders CollectFlag (GhcPass idL)
flag = Bool
-> CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR
-> [IdP (GhcPass idL)]
forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
Bool
-> CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR
-> [IdP (GhcPass idL)]
collect_hs_val_binders Bool
False CollectFlag (GhcPass idL)
flag

collectHsBindBinders :: CollectPass p
                     => CollectFlag p
                     -> HsBindLR p idR
                     -> [IdP p]
-- ^ Collect both 'Id's and pattern-synonym binders
collectHsBindBinders :: forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
collectHsBindBinders CollectFlag p
flag HsBindLR p idR
b = Bool -> CollectFlag p -> HsBindLR p idR -> [IdP p] -> [IdP p]
forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
False CollectFlag p
flag HsBindLR p idR
b []

collectHsBindsBinders :: CollectPass p
                      => CollectFlag p
                      -> LHsBindsLR p idR
                      -> [IdP p]
collectHsBindsBinders :: forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag p
flag LHsBindsLR p idR
binds = Bool -> CollectFlag p -> LHsBindsLR p idR -> [IdP p] -> [IdP p]
forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> LHsBindsLR p idR -> [IdP p] -> [IdP p]
collect_binds Bool
False CollectFlag p
flag LHsBindsLR p idR
binds []

collectHsBindListBinders :: forall p idR. CollectPass p
                         => CollectFlag p
                         -> [LHsBindLR p idR]
                         -> [IdP p]
-- ^ Same as 'collectHsBindsBinders', but works over a list of bindings
collectHsBindListBinders :: forall p idR.
CollectPass p =>
CollectFlag p -> [LHsBindLR p idR] -> [IdP p]
collectHsBindListBinders CollectFlag p
flag = (XRec p (HsBindLR p idR) -> [IdP p] -> [IdP p])
-> [IdP p] -> [XRec p (HsBindLR p idR)] -> [IdP p]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> CollectFlag p -> HsBindLR p idR -> [IdP p] -> [IdP p]
forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
False CollectFlag p
flag (HsBindLR p idR -> [IdP p] -> [IdP p])
-> (XRec p (HsBindLR p idR) -> HsBindLR p idR)
-> XRec p (HsBindLR p idR)
-> [IdP p]
-> [IdP p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) []

collect_hs_val_binders :: CollectPass (GhcPass idL)
                       => Bool
                       -> CollectFlag (GhcPass idL)
                       -> HsValBindsLR (GhcPass idL) idR
                       -> [IdP (GhcPass idL)]
collect_hs_val_binders :: forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
Bool
-> CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR
-> [IdP (GhcPass idL)]
collect_hs_val_binders Bool
ps CollectFlag (GhcPass idL)
flag = \case
    ValBinds XValBinds (GhcPass idL) idR
_ LHsBindsLR (GhcPass idL) idR
binds [LSig idR]
_              -> Bool
-> CollectFlag (GhcPass idL)
-> LHsBindsLR (GhcPass idL) idR
-> [IdP (GhcPass idL)]
-> [IdP (GhcPass idL)]
forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> LHsBindsLR p idR -> [IdP p] -> [IdP p]
collect_binds Bool
ps CollectFlag (GhcPass idL)
flag LHsBindsLR (GhcPass idL) idR
binds []
    XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass idL))]
binds [LSig (GhcPass 'Renamed)]
_) -> Bool
-> CollectFlag (GhcPass idL)
-> [(RecFlag, LHsBinds (GhcPass idL))]
-> [IdP (GhcPass idL)]
forall p.
CollectPass p =>
Bool -> CollectFlag p -> [(RecFlag, LHsBinds p)] -> [IdP p]
collect_out_binds Bool
ps CollectFlag (GhcPass idL)
flag [(RecFlag, LHsBinds (GhcPass idL))]
binds

collect_out_binds :: forall p. CollectPass p
                  => Bool
                  -> CollectFlag p
                  -> [(RecFlag, LHsBinds p)]
                  -> [IdP p]
collect_out_binds :: forall p.
CollectPass p =>
Bool -> CollectFlag p -> [(RecFlag, LHsBinds p)] -> [IdP p]
collect_out_binds Bool
ps CollectFlag p
flag = ((RecFlag, Bag (XRec p (HsBindLR p p))) -> [IdP p] -> [IdP p])
-> [IdP p] -> [(RecFlag, Bag (XRec p (HsBindLR p p)))] -> [IdP p]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool
-> CollectFlag p
-> Bag (XRec p (HsBindLR p p))
-> [IdP p]
-> [IdP p]
forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> LHsBindsLR p idR -> [IdP p] -> [IdP p]
collect_binds Bool
ps CollectFlag p
flag (Bag (XRec p (HsBindLR p p)) -> [IdP p] -> [IdP p])
-> ((RecFlag, Bag (XRec p (HsBindLR p p)))
    -> Bag (XRec p (HsBindLR p p)))
-> (RecFlag, Bag (XRec p (HsBindLR p p)))
-> [IdP p]
-> [IdP p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecFlag, Bag (XRec p (HsBindLR p p)))
-> Bag (XRec p (HsBindLR p p))
forall a b. (a, b) -> b
snd) []

collect_binds :: forall p idR. CollectPass p
              => Bool
              -> CollectFlag p
              -> LHsBindsLR p idR
              -> [IdP p]
              -> [IdP p]
-- ^ Collect 'Id's, or 'Id's + pattern synonyms, depending on boolean flag
collect_binds :: forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> LHsBindsLR p idR -> [IdP p] -> [IdP p]
collect_binds Bool
ps CollectFlag p
flag LHsBindsLR p idR
binds [IdP p]
acc = (XRec p (HsBindLR p idR) -> [IdP p] -> [IdP p])
-> [IdP p] -> LHsBindsLR p idR -> [IdP p]
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> CollectFlag p -> HsBindLR p idR -> [IdP p] -> [IdP p]
forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
ps CollectFlag p
flag (HsBindLR p idR -> [IdP p] -> [IdP p])
-> (XRec p (HsBindLR p idR) -> HsBindLR p idR)
-> XRec p (HsBindLR p idR)
-> [IdP p]
-> [IdP p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) [IdP p]
acc LHsBindsLR p idR
binds

collect_bind :: forall p idR. CollectPass p
             => Bool
             -> CollectFlag p
             -> HsBindLR p idR
             -> [IdP p]
             -> [IdP p]
collect_bind :: forall p idR.
CollectPass p =>
Bool -> CollectFlag p -> HsBindLR p idR -> [IdP p] -> [IdP p]
collect_bind Bool
_ CollectFlag p
_    (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = LIdP p
f })         [IdP p]
acc = forall p a. UnXRec p => XRec p a -> a
unXRec @p LIdP p
f IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
acc
collect_bind Bool
_ CollectFlag p
flag (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat p
p })        [IdP p]
acc = CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
p [IdP p]
acc
collect_bind Bool
_ CollectFlag p
_    (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP p
f })         [IdP p]
acc = IdP p
f IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
acc
collect_bind Bool
omitPatSyn CollectFlag p
_ (PatSynBind XPatSynBind p idR
_ (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = LIdP p
ps })) [IdP p]
acc
  | Bool
omitPatSyn                  = [IdP p]
acc
  | Bool
otherwise                   = forall p a. UnXRec p => XRec p a -> a
unXRec @p LIdP p
ps IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
acc
collect_bind Bool
_ CollectFlag p
_ (PatSynBind XPatSynBind p idR
_ (XPatSynBind XXPatSynBind p idR
_)) [IdP p]
acc = [IdP p]
acc
collect_bind Bool
_ CollectFlag p
_ (XHsBindsLR XXHsBindsLR p idR
b) [IdP p]
acc = forall p pR.
CollectPass p =>
XXHsBindsLR p pR -> [IdP p] -> [IdP p]
collectXXHsBindsLR @p @idR XXHsBindsLR p idR
b [IdP p]
acc


collectMethodBinders :: forall idL idR. UnXRec idL => LHsBindsLR idL idR -> [LIdP idL]
-- ^ Used exclusively for the bindings of an instance decl which are all
-- 'FunBinds'
collectMethodBinders :: forall idL idR. UnXRec idL => LHsBindsLR idL idR -> [LIdP idL]
collectMethodBinders LHsBindsLR idL idR
binds = (XRec idL (HsBindLR idL idR)
 -> [XRec idL (IdP idL)] -> [XRec idL (IdP idL)])
-> [XRec idL (IdP idL)]
-> LHsBindsLR idL idR
-> [XRec idL (IdP idL)]
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (HsBindLR idL idR -> [XRec idL (IdP idL)] -> [XRec idL (IdP idL)]
forall {idL} {idR}.
HsBindLR idL idR -> [XRec idL (IdP idL)] -> [XRec idL (IdP idL)]
get (HsBindLR idL idR -> [XRec idL (IdP idL)] -> [XRec idL (IdP idL)])
-> (XRec idL (HsBindLR idL idR) -> HsBindLR idL idR)
-> XRec idL (HsBindLR idL idR)
-> [XRec idL (IdP idL)]
-> [XRec idL (IdP idL)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @idL) [] LHsBindsLR idL idR
binds
  where
    get :: HsBindLR idL idR -> [XRec idL (IdP idL)] -> [XRec idL (IdP idL)]
get (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = XRec idL (IdP idL)
f }) [XRec idL (IdP idL)]
fs = XRec idL (IdP idL)
f XRec idL (IdP idL) -> [XRec idL (IdP idL)] -> [XRec idL (IdP idL)]
forall a. a -> [a] -> [a]
: [XRec idL (IdP idL)]
fs
    get HsBindLR idL idR
_                        [XRec idL (IdP idL)]
fs = [XRec idL (IdP idL)]
fs
       -- Someone else complains about non-FunBinds

----------------- Statements --------------------------
--
collectLStmtsBinders
  :: CollectPass (GhcPass idL)
  => CollectFlag (GhcPass idL)
  -> [LStmtLR (GhcPass idL) (GhcPass idR) body]
  -> [IdP (GhcPass idL)]
collectLStmtsBinders :: forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag (GhcPass idL)
flag = (GenLocated
   (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
   (StmtLR (GhcPass idL) (GhcPass idR) body)
 -> [IdGhcP idL])
-> [GenLocated
      (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
      (StmtLR (GhcPass idL) (GhcPass idR) body)]
-> [IdGhcP idL]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CollectFlag (GhcPass idL)
-> XRec (GhcPass idL) (StmtLR (GhcPass idL) (GhcPass idR) body)
-> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders CollectFlag (GhcPass idL)
flag)

collectStmtsBinders
  :: CollectPass (GhcPass idL)
  => CollectFlag (GhcPass idL)
  -> [StmtLR (GhcPass idL) (GhcPass idR) body]
  -> [IdP (GhcPass idL)]
collectStmtsBinders :: forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [StmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectStmtsBinders CollectFlag (GhcPass idL)
flag = (StmtLR (GhcPass idL) (GhcPass idR) body -> [IdGhcP idL])
-> [StmtLR (GhcPass idL) (GhcPass idR) body] -> [IdGhcP idL]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders CollectFlag (GhcPass idL)
flag)

collectLStmtBinders
  :: CollectPass (GhcPass idL)
  => CollectFlag (GhcPass idL)
  -> LStmtLR (GhcPass idL) (GhcPass idR) body
  -> [IdP (GhcPass idL)]
collectLStmtBinders :: forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders CollectFlag (GhcPass idL)
flag = CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders CollectFlag (GhcPass idL)
flag (StmtLR (GhcPass idL) (GhcPass idR) body -> [IdGhcP idL])
-> (GenLocated
      (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
      (StmtLR (GhcPass idL) (GhcPass idR) body)
    -> StmtLR (GhcPass idL) (GhcPass idR) body)
-> GenLocated
     (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
     (StmtLR (GhcPass idL) (GhcPass idR) body)
-> [IdGhcP idL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
  (StmtLR (GhcPass idL) (GhcPass idR) body)
-> StmtLR (GhcPass idL) (GhcPass idR) body
forall l e. GenLocated l e -> e
unLoc

collectStmtBinders
  :: CollectPass (GhcPass idL)
  => CollectFlag (GhcPass idL)
  -> StmtLR (GhcPass idL) (GhcPass idR) body
  -> [IdP (GhcPass idL)]
  -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
collectStmtBinders :: forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders CollectFlag (GhcPass idL)
flag = \case
    BindStmt XBindStmt (GhcPass idL) (GhcPass idR) body
_ LPat (GhcPass idL)
pat body
_ -> CollectFlag (GhcPass idL)
-> LPat (GhcPass idL) -> [IdP (GhcPass idL)]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag (GhcPass idL)
flag LPat (GhcPass idL)
pat
    LetStmt XLetStmt (GhcPass idL) (GhcPass idR) body
_  HsLocalBindsLR (GhcPass idL) (GhcPass idR)
binds -> CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders CollectFlag (GhcPass idL)
flag HsLocalBindsLR (GhcPass idL) (GhcPass idR)
binds
    BodyStmt {}      -> []
    LastStmt {}      -> []
    ParStmt XParStmt (GhcPass idL) (GhcPass idR) body
_ [ParStmtBlock (GhcPass idL) (GhcPass idR)]
xs HsExpr (GhcPass idR)
_ SyntaxExpr (GhcPass idR)
_ -> CollectFlag (GhcPass idL)
-> [LStmtLR
      (GhcPass idL)
      (GhcPass idL)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass idL)))]
-> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag (GhcPass idL)
flag [LStmtLR
  (GhcPass idL)
  (GhcPass idL)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass idL)))
GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass idL)
     (GhcPass idL)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass idL))))
s | ParStmtBlock XParStmtBlock (GhcPass idL) (GhcPass idR)
_ [ExprLStmt (GhcPass idL)]
ss [IdP (GhcPass idR)]
_ SyntaxExpr (GhcPass idR)
_ <- [ParStmtBlock (GhcPass idL) (GhcPass idR)]
xs, GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass idL)
     (GhcPass idL)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass idL))))
s <- [ExprLStmt (GhcPass idL)]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass idL)
      (GhcPass idL)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass idL))))]
ss]
    TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [ExprLStmt (GhcPass idL)]
stmts } -> CollectFlag (GhcPass idL)
-> [LStmtLR
      (GhcPass idL)
      (GhcPass idL)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass idL)))]
-> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag (GhcPass idL)
flag [ExprLStmt (GhcPass idL)]
[LStmtLR
   (GhcPass idL)
   (GhcPass idL)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass idL)))]
stmts
    RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L Anno
  [GenLocated
     (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
     (StmtLR (GhcPass idL) (GhcPass idR) body)]
_ [GenLocated
   (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
   (StmtLR (GhcPass idL) (GhcPass idR) body)]
ss } -> CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag (GhcPass idL)
flag [LStmtLR (GhcPass idL) (GhcPass idR) body]
[GenLocated
   (Anno (StmtLR (GhcPass idL) (GhcPass idR) body))
   (StmtLR (GhcPass idL) (GhcPass idR) body)]
ss
    ApplicativeStmt XApplicativeStmt (GhcPass idL) (GhcPass idR) body
_ [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))]
args Maybe (SyntaxExpr (GhcPass idR))
_        -> ((SyntaxExprGhc idR, ApplicativeArg (GhcPass idL)) -> [IdGhcP idL])
-> [(SyntaxExprGhc idR, ApplicativeArg (GhcPass idL))]
-> [IdGhcP idL]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SyntaxExprGhc idR, ApplicativeArg (GhcPass idL))
-> [IdP (GhcPass idL)]
(SyntaxExprGhc idR, ApplicativeArg (GhcPass idL)) -> [IdGhcP idL]
collectArgBinders [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass idL))]
[(SyntaxExprGhc idR, ApplicativeArg (GhcPass idL))]
args
        where
         collectArgBinders :: (SyntaxExprGhc idR, ApplicativeArg (GhcPass idL))
-> [IdP (GhcPass idL)]
collectArgBinders = \case
            (SyntaxExprGhc idR
_, ApplicativeArgOne { app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
app_arg_pattern = LPat (GhcPass idL)
pat }) -> CollectFlag (GhcPass idL)
-> LPat (GhcPass idL) -> [IdP (GhcPass idL)]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag (GhcPass idL)
flag LPat (GhcPass idL)
pat
            (SyntaxExprGhc idR
_, ApplicativeArgMany { bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
bv_pattern = LPat (GhcPass idL)
pat })     -> CollectFlag (GhcPass idL)
-> LPat (GhcPass idL) -> [IdP (GhcPass idL)]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag (GhcPass idL)
flag LPat (GhcPass idL)
pat


----------------- Patterns --------------------------

collectPatBinders
    :: CollectPass p
    => CollectFlag p
    -> LPat p
    -> [IdP p]
collectPatBinders :: forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag p
flag LPat p
pat = CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat []

collectPatsBinders
    :: CollectPass p
    => CollectFlag p
    -> [LPat p]
    -> [IdP p]
collectPatsBinders :: forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag p
flag [LPat p]
pats = (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag) [] [LPat p]
pats


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

-- | Indicate if evidence binders have to be collected.
--
-- This type is used as a boolean (should we collect evidence binders or not?)
-- but also to pass an evidence that the AST has been typechecked when we do
-- want to collect evidence binders, otherwise these binders are not available.
--
-- See Note [Dictionary binders in ConPatOut]
data CollectFlag p where
    -- | Don't collect evidence binders
    CollNoDictBinders   :: CollectFlag p
    -- | Collect evidence binders
    CollWithDictBinders :: CollectFlag GhcTc

collect_lpat :: forall p. CollectPass p
             => CollectFlag p
             -> LPat p
             -> [IdP p]
             -> [IdP p]
collect_lpat :: forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs = CollectFlag p -> Pat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> Pat p -> [IdP p] -> [IdP p]
collect_pat CollectFlag p
flag (forall p a. UnXRec p => XRec p a -> a
unXRec @p LPat p
pat) [IdP p]
bndrs

collect_pat :: forall p. CollectPass p
            => CollectFlag p
            -> Pat p
            -> [IdP p]
            -> [IdP p]
collect_pat :: forall p.
CollectPass p =>
CollectFlag p -> Pat p -> [IdP p] -> [IdP p]
collect_pat CollectFlag p
flag Pat p
pat [IdP p]
bndrs = case Pat p
pat of
  VarPat XVarPat p
_ LIdP p
var          -> forall p a. UnXRec p => XRec p a -> a
unXRec @p LIdP p
var IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
bndrs
  WildPat XWildPat p
_             -> [IdP p]
bndrs
  LazyPat XLazyPat p
_ LPat p
pat         -> CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs
  BangPat XBangPat p
_ LPat p
pat         -> CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs
  AsPat XAsPat p
_ LIdP p
a LHsToken "@" p
_ LPat p
pat       -> forall p a. UnXRec p => XRec p a -> a
unXRec @p LIdP p
a IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs
  ViewPat XViewPat p
_ LHsExpr p
_ LPat p
pat       -> CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs
  ParPat XParPat p
_ LHsToken "(" p
_ LPat p
pat LHsToken ")" p
_      -> CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs
  ListPat XListPat p
_ [LPat p]
pats        -> (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag) [IdP p]
bndrs [LPat p]
pats
  TuplePat XTuplePat p
_ [LPat p]
pats Boxity
_     -> (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag) [IdP p]
bndrs [LPat p]
pats
  SumPat XSumPat p
_ LPat p
pat Int
_ Int
_      -> CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs
  LitPat XLitPat p
_ HsLit p
_            -> [IdP p]
bndrs
  NPat {}               -> [IdP p]
bndrs
  NPlusKPat XNPlusKPat p
_ LIdP p
n XRec p (HsOverLit p)
_ HsOverLit p
_ SyntaxExpr p
_ SyntaxExpr p
_ -> forall p a. UnXRec p => XRec p a -> a
unXRec @p LIdP p
n IdP p -> [IdP p] -> [IdP p]
forall a. a -> [a] -> [a]
: [IdP p]
bndrs
  SigPat XSigPat p
_ LPat p
pat HsPatSigType (NoGhcTc p)
_        -> CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag LPat p
pat [IdP p]
bndrs
  XPat XXPat p
ext              -> forall p.
CollectPass p =>
CollectFlag p -> XXPat p -> [IdP p] -> [IdP p]
collectXXPat @p CollectFlag p
flag XXPat p
ext [IdP p]
bndrs
  SplicePat XSplicePat p
ext HsUntypedSplice p
_       -> forall p.
CollectPass p =>
CollectFlag p -> XSplicePat p -> [IdP p] -> [IdP p]
collectXSplicePat @p CollectFlag p
flag XSplicePat p
ext [IdP p]
bndrs
  -- See Note [Dictionary binders in ConPatOut]
  ConPat {pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args=HsConPatDetails p
ps}  -> case CollectFlag p
flag of
    CollectFlag p
CollNoDictBinders   -> (LPat p -> [IdP p] -> [IdP p]) -> [IdP p] -> [LPat p] -> [IdP p]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag) [IdP p]
bndrs (HsConPatDetails p -> [LPat p]
forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails p
ps)
    CollectFlag p
CollWithDictBinders -> (GenLocated SrcSpanAnnA (Pat GhcTc) -> [Id] -> [Id])
-> [Id] -> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [Id]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
forall p.
CollectPass p =>
CollectFlag p -> LPat p -> [IdP p] -> [IdP p]
collect_lpat CollectFlag p
flag) [IdP p]
[Id]
bndrs (HsConPatDetails p -> [LPat p]
forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails p
ps)
                           [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ TcEvBinds -> [Id]
collectEvBinders (ConPatTc -> TcEvBinds
cpt_binds (Pat p -> XConPat p
forall p. Pat p -> XConPat p
pat_con_ext Pat p
pat))

collectEvBinders :: TcEvBinds -> [Id]
collectEvBinders :: TcEvBinds -> [Id]
collectEvBinders (EvBinds Bag EvBind
bs)   = (EvBind -> [Id] -> [Id]) -> [Id] -> Bag EvBind -> [Id]
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EvBind -> [Id] -> [Id]
add_ev_bndr [] Bag EvBind
bs
collectEvBinders (TcEvBinds {}) = String -> [Id]
forall a. HasCallStack => String -> a
panic String
"ToDo: collectEvBinders"

add_ev_bndr :: EvBind -> [Id] -> [Id]
add_ev_bndr :: EvBind -> [Id] -> [Id]
add_ev_bndr (EvBind { eb_lhs :: EvBind -> Id
eb_lhs = Id
b }) [Id]
bs | Id -> Bool
isId Id
b    = Id
bId -> [Id] -> [Id]
forall a. a -> [a] -> [a]
:[Id]
bs
                                       | Bool
otherwise = [Id]
bs
  -- A worry: what about coercion variable binders??


-- | This class specifies how to collect variable identifiers from extension patterns in the given pass.
-- Consumers of the GHC API that define their own passes should feel free to implement instances in order
-- to make use of functions which depend on it.
--
-- In particular, Haddock already makes use of this, with an instance for its 'DocNameI' pass so that
-- it can reuse the code in GHC for collecting binders.
class UnXRec p => CollectPass p where
  collectXXPat :: CollectFlag p -> XXPat p -> [IdP p] -> [IdP p]
  collectXXHsBindsLR :: forall pR. XXHsBindsLR p pR -> [IdP p] -> [IdP p]
  collectXSplicePat :: CollectFlag p -> XSplicePat p -> [IdP p] -> [IdP p]

instance IsPass p => CollectPass (GhcPass p) where
  collectXXPat :: CollectFlag (GhcPass p)
-> XXPat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
collectXXPat CollectFlag (GhcPass p)
flag XXPat (GhcPass p)
ext =
    case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> DataConCantHappen -> [RdrName] -> [RdrName]
forall a. DataConCantHappen -> a
dataConCantHappen XXPat (GhcPass p)
DataConCantHappen
ext
      GhcPass p
GhcRn
        | HsPatExpanded Pat (GhcPass 'Renamed)
_ Pat (GhcPass p)
pat <- XXPat (GhcPass p)
ext
        -> CollectFlag (GhcPass p)
-> Pat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
CollectPass p =>
CollectFlag p -> Pat p -> [IdP p] -> [IdP p]
collect_pat CollectFlag (GhcPass p)
flag Pat (GhcPass p)
pat
      GhcPass p
GhcTc -> case XXPat (GhcPass p)
ext of
        CoPat HsWrapper
_ Pat GhcTc
pat Type
_      -> CollectFlag (GhcPass p)
-> Pat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
CollectPass p =>
CollectFlag p -> Pat p -> [IdP p] -> [IdP p]
collect_pat CollectFlag (GhcPass p)
flag Pat (GhcPass p)
Pat GhcTc
pat
        ExpansionPat Pat (GhcPass 'Renamed)
_ Pat GhcTc
pat -> CollectFlag (GhcPass p)
-> Pat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
CollectPass p =>
CollectFlag p -> Pat p -> [IdP p] -> [IdP p]
collect_pat CollectFlag (GhcPass p)
flag Pat (GhcPass p)
Pat GhcTc
pat
  collectXXHsBindsLR :: forall pR.
XXHsBindsLR (GhcPass p) pR
-> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
collectXXHsBindsLR XXHsBindsLR (GhcPass p) pR
ext =
    case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> DataConCantHappen -> [RdrName] -> [RdrName]
forall a. DataConCantHappen -> a
dataConCantHappen XXHsBindsLR (GhcPass p) pR
DataConCantHappen
ext
      GhcPass p
GhcRn -> DataConCantHappen -> [Name] -> [Name]
forall a. DataConCantHappen -> a
dataConCantHappen XXHsBindsLR (GhcPass p) pR
DataConCantHappen
ext
      GhcPass p
GhcTc -> case XXHsBindsLR (GhcPass p) pR
ext of
        AbsBinds { abs_exports :: AbsBinds -> [ABExport]
abs_exports = [ABExport]
dbinds } -> ((ABExport -> Id) -> [ABExport] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map ABExport -> Id
abe_poly [ABExport]
dbinds [IdP (GhcPass p)] -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall a. [a] -> [a] -> [a]
++)
        -- I don't think we want the binders from the abe_binds

        -- binding (hence see AbsBinds) is in zonking in GHC.Tc.Zonk.Type

  collectXSplicePat :: CollectFlag (GhcPass p)
-> XSplicePat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
collectXSplicePat CollectFlag (GhcPass p)
flag XSplicePat (GhcPass p)
ext =
      case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
        GhcPass p
GhcPs -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
[RdrName] -> [RdrName]
forall a. a -> a
id
        GhcPass p
GhcRn | (HsUntypedSpliceTop ThModFinalizers
_ Pat (GhcPass p)
pat) <- XSplicePat (GhcPass p)
ext -> CollectFlag (GhcPass p)
-> Pat (GhcPass p) -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
forall p.
CollectPass p =>
CollectFlag p -> Pat p -> [IdP p] -> [IdP p]
collect_pat CollectFlag (GhcPass p)
flag Pat (GhcPass p)
pat
        GhcPass p
GhcRn | (HsUntypedSpliceNested Name
_)  <- XSplicePat (GhcPass p)
ext -> [IdP (GhcPass p)] -> [IdP (GhcPass p)]
[Name] -> [Name]
forall a. a -> a
id
        GhcPass p
GhcTc -> DataConCantHappen -> [Id] -> [Id]
forall a. DataConCantHappen -> a
dataConCantHappen XSplicePat (GhcPass p)
DataConCantHappen
ext


{-
Note [Dictionary binders in ConPatOut]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Should we collect dictionary binders in ConPatOut? It depends! Use CollectFlag
to choose.

1. Pre-typechecker there are no ConPatOuts. Use CollNoDictBinders flag.

2. In the desugarer, most of the time we don't want to collect evidence binders,
   so we also use CollNoDictBinders flag.

   Example of why it matters:

   In a lazy pattern, for example f ~(C x y) = ..., we want to generate bindings
   for x,y but not for dictionaries bound by C.
   (The type checker ensures they would not be used.)

   Here's the problem.  Consider

        data T a where
           C :: Num a => a -> Int -> T a

        f ~(C (n+1) m) = (n,m)

   Here, the pattern (C (n+1)) binds a hidden dictionary (d::Num a),
   and *also* uses that dictionary to match the (n+1) pattern.  Yet, the
   variables bound by the lazy pattern are n,m, *not* the dictionary d.
   So in mkSelectorBinds in GHC.HsToCore.Utils, we want just m,n as the
   variables bound.

   So in this case, we do *not* gather (a) dictionary and (b) dictionary
   bindings as binders of a ConPatOut pattern.


3. On the other hand, desugaring of arrows needs evidence bindings and uses
   CollWithDictBinders flag.

   Consider

        h :: (ArrowChoice a, Arrow a) => Int -> a (Int,Int) Int
        h x = proc (y,z) -> case compare x y of
                        GT -> returnA -< z+x

   The type checker turns the case into

        case compare x y of
          GT { $dNum_123 = $dNum_Int } -> returnA -< (+) $dNum_123 z x

   That is, it attaches the $dNum_123 binding to a ConPatOut in scope.

   During desugaring, evidence binders must be collected because their sets are
   intersected with free variable sets of subsequent commands to create
   (minimal) command environments.  Failing to do it properly leads to bugs
   (e.g., #18950).

   Note: attaching evidence binders to existing ConPatOut may be suboptimal for
   arrows.  In the example above we would prefer to generate:

        case compare x y of
          GT -> returnA -< let $dNum_123 = $dNum_Int in (+) $dNum_123 z x

   So that the evidence isn't passed into the command environment. This issue
   doesn't arise with desugaring of non-arrow code because the simplifier can
   freely float and inline let-expressions created for evidence binders. But
   with arrow desugaring, the simplifier would have to see through the command
   environment tuple which is more complicated.

-}

hsGroupBinders :: HsGroup GhcRn -> [Name]
hsGroupBinders :: HsGroup (GhcPass 'Renamed) -> [Name]
hsGroupBinders (HsGroup { hs_valds :: forall p. HsGroup p -> HsValBinds p
hs_valds = HsValBinds (GhcPass 'Renamed)
val_decls, hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
hs_tyclds = [TyClGroup (GhcPass 'Renamed)]
tycl_decls,
                          hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
hs_fords = [LForeignDecl (GhcPass 'Renamed)]
foreign_decls })
  =  CollectFlag (GhcPass 'Renamed)
-> HsValBinds (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR -> [IdP (GhcPass idL)]
collectHsValBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders HsValBinds (GhcPass 'Renamed)
val_decls
  [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [TyClGroup (GhcPass 'Renamed)]
-> [LForeignDecl (GhcPass 'Renamed)] -> [Name]
hsTyClForeignBinders [TyClGroup (GhcPass 'Renamed)]
tycl_decls [LForeignDecl (GhcPass 'Renamed)]
foreign_decls

hsTyClForeignBinders :: [TyClGroup GhcRn]
                     -> [LForeignDecl GhcRn]
                     -> [Name]
-- We need to look at instance declarations too,
-- because their associated types may bind data constructors
hsTyClForeignBinders :: [TyClGroup (GhcPass 'Renamed)]
-> [LForeignDecl (GhcPass 'Renamed)] -> [Name]
hsTyClForeignBinders [TyClGroup (GhcPass 'Renamed)]
tycl_decls [LForeignDecl (GhcPass 'Renamed)]
foreign_decls
  =    (GenLocated (Anno (IdGhcP 'Renamed)) Name -> Name)
-> [GenLocated (Anno (IdGhcP 'Renamed)) Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated (Anno (IdGhcP 'Renamed)) Name -> Name
forall l e. GenLocated l e -> e
unLoc ([LForeignDecl (GhcPass 'Renamed)] -> [LIdP (GhcPass 'Renamed)]
forall (p :: Pass) a.
(UnXRec (GhcPass p), IsSrcSpanAnn p a) =>
[LForeignDecl (GhcPass p)] -> [LIdP (GhcPass p)]
hsForeignDeclsBinders [LForeignDecl (GhcPass 'Renamed)]
foreign_decls)
    [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([LocatedA Name], [LFieldOcc (GhcPass 'Renamed)]) -> [Name]
getSelectorNames
         ((TyClGroup (GhcPass 'Renamed)
 -> ([LocatedA Name],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]))
-> [TyClGroup (GhcPass 'Renamed)]
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((LocatedA (TyClDecl (GhcPass 'Renamed))
 -> ([LocatedA Name],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]))
-> [LocatedA (TyClDecl (GhcPass 'Renamed))]
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TyDeclBinders 'Renamed
-> ([LocatedA (IdP (GhcPass 'Renamed))],
    [LFieldOcc (GhcPass 'Renamed)])
TyDeclBinders 'Renamed
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall (p :: Pass).
TyDeclBinders p
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
tyDeclBinders (TyDeclBinders 'Renamed
 -> ([LocatedA Name],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]))
-> (LocatedA (TyClDecl (GhcPass 'Renamed))
    -> TyDeclBinders 'Renamed)
-> LocatedA (TyClDecl (GhcPass 'Renamed))
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedA (TyClDecl (GhcPass 'Renamed)) -> TyDeclBinders 'Renamed
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
LocatedA (TyClDecl (GhcPass p)) -> TyDeclBinders p
hsLTyClDeclBinders) ([LocatedA (TyClDecl (GhcPass 'Renamed))]
 -> ([LocatedA Name],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]))
-> (TyClGroup (GhcPass 'Renamed)
    -> [LocatedA (TyClDecl (GhcPass 'Renamed))])
-> TyClGroup (GhcPass 'Renamed)
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClGroup (GhcPass 'Renamed) -> [LTyClDecl (GhcPass 'Renamed)]
TyClGroup (GhcPass 'Renamed)
-> [LocatedA (TyClDecl (GhcPass 'Renamed))]
forall pass. TyClGroup pass -> [LTyClDecl pass]
group_tyclds) [TyClGroup (GhcPass 'Renamed)]
tycl_decls
         ([LocatedA Name],
 [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall a. Monoid a => a -> a -> a
`mappend`
         ((TyClGroup (GhcPass 'Renamed)
 -> ([LocatedA Name],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]))
-> [TyClGroup (GhcPass 'Renamed)]
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))
 -> ([LocatedA Name],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]))
-> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LInstDecl (GhcPass 'Renamed)
-> ([LocatedA (IdP (GhcPass 'Renamed))],
    [LFieldOcc (GhcPass 'Renamed)])
GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
LInstDecl (GhcPass p)
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLInstDeclBinders ([GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]
 -> ([LocatedA Name],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]))
-> (TyClGroup (GhcPass 'Renamed)
    -> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))])
-> TyClGroup (GhcPass 'Renamed)
-> ([LocatedA Name],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyClGroup (GhcPass 'Renamed) -> [LInstDecl (GhcPass 'Renamed)]
TyClGroup (GhcPass 'Renamed)
-> [GenLocated SrcSpanAnnA (InstDecl (GhcPass 'Renamed))]
forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds) [TyClGroup (GhcPass 'Renamed)]
tycl_decls))
  where
    getSelectorNames :: ([LocatedA Name], [LFieldOcc GhcRn]) -> [Name]
    getSelectorNames :: ([LocatedA Name], [LFieldOcc (GhcPass 'Renamed)]) -> [Name]
getSelectorNames ([LocatedA Name]
ns, [LFieldOcc (GhcPass 'Renamed)]
fs) = (LocatedA Name -> Name) -> [LocatedA Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA Name -> Name
forall l e. GenLocated l e -> e
unLoc [LocatedA Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))
 -> Name)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]
-> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc (GhcPass 'Renamed) -> XCFieldOcc (GhcPass 'Renamed)
FieldOcc (GhcPass 'Renamed) -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc (GhcPass 'Renamed) -> Name)
-> (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))
    -> FieldOcc (GhcPass 'Renamed))
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))
-> FieldOcc (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc) [LFieldOcc (GhcPass 'Renamed)]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed))]
fs

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

data TyDeclBinders p
  = TyDeclBinders
  { forall (p :: Pass).
TyDeclBinders p -> (LocatedA (IdP (GhcPass p)), TyConFlavour ())
tyDeclMainBinder     :: !(LocatedA (IdP (GhcPass p)), TyConFlavour ())
  , forall (p :: Pass).
TyDeclBinders p -> [(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
tyDeclATs            :: ![(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
  , forall (p :: Pass). TyDeclBinders p -> [LocatedA (IdP (GhcPass p))]
tyDeclOpSigs         :: ![LocatedA (IdP (GhcPass p))]
  , forall (p :: Pass). TyDeclBinders p -> LConsWithFields p
tyDeclConsWithFields :: !(LConsWithFields p) }

tyDeclBinders :: TyDeclBinders p -> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
tyDeclBinders :: forall (p :: Pass).
TyDeclBinders p
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
tyDeclBinders (TyDeclBinders (LocatedA (IdP (GhcPass p)), TyConFlavour ())
main [(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
ats [LocatedA (IdP (GhcPass p))]
sigs LConsWithFields p
consWithFields)
  = ((LocatedA (IdGhcP p), TyConFlavour ()) -> LocatedA (IdGhcP p)
forall a b. (a, b) -> a
fst (LocatedA (IdP (GhcPass p)), TyConFlavour ())
(LocatedA (IdGhcP p), TyConFlavour ())
main LocatedA (IdGhcP p)
-> [LocatedA (IdGhcP p)] -> [LocatedA (IdGhcP p)]
forall a. a -> [a] -> [a]
: (((LocatedA (IdGhcP p), TyConFlavour ()) -> LocatedA (IdGhcP p))
-> [(LocatedA (IdGhcP p), TyConFlavour ())]
-> [LocatedA (IdGhcP p)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LocatedA (IdGhcP p), TyConFlavour ()) -> LocatedA (IdGhcP p)
forall a b. (a, b) -> a
fst [(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
[(LocatedA (IdGhcP p), TyConFlavour ())]
ats [LocatedA (IdGhcP p)]
-> [LocatedA (IdGhcP p)] -> [LocatedA (IdGhcP p)]
forall a. [a] -> [a] -> [a]
++ [LocatedA (IdP (GhcPass p))]
[LocatedA (IdGhcP p)]
sigs [LocatedA (IdGhcP p)]
-> [LocatedA (IdGhcP p)] -> [LocatedA (IdGhcP p)]
forall a. [a] -> [a] -> [a]
++ [LocatedA (IdP (GhcPass p))]
[LocatedA (IdGhcP p)]
cons), [LFieldOcc (GhcPass p)]
flds)
  where
    ([LocatedA (IdP (GhcPass p))]
cons, [LFieldOcc (GhcPass p)]
flds) = LConsWithFields p
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
forall (p :: Pass).
LConsWithFields p
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
lconsWithFieldsBinders LConsWithFields p
consWithFields

hsLTyClDeclBinders :: (IsPass p, OutputableBndrId p)
                   => LocatedA (TyClDecl (GhcPass p))
                   -> TyDeclBinders p
-- ^ Returns all the /binding/ names of the decl.  The first one is
-- guaranteed to be the name of the decl. The first component
-- represents all binding names except record fields; the second
-- represents field occurrences. For record fields mentioned in
-- multiple constructors, the SrcLoc will be from the first occurrence.
--
-- Each returned (Located name) has a SrcSpan for the /whole/ declaration.
-- See Note [SrcSpan for binders]

hsLTyClDeclBinders :: forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
LocatedA (TyClDecl (GhcPass p)) -> TyDeclBinders p
hsLTyClDeclBinders (L SrcSpanAnnA
loc (FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl
                                            { fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = (L Anno (IdGhcP p)
_ IdGhcP p
name)
                                            , fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo  = FamilyInfo (GhcPass p)
fd_info } }))
  = TyDeclBinders
  { tyDeclMainBinder :: (LocatedA (IdP (GhcPass p)), TyConFlavour ())
tyDeclMainBinder = (SrcSpanAnnA -> IdGhcP p -> GenLocated SrcSpanAnnA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc IdGhcP p
name, Maybe () -> FamilyInfo (GhcPass p) -> TyConFlavour ()
forall tc pass. Maybe tc -> FamilyInfo pass -> TyConFlavour tc
familyInfoTyConFlavour Maybe ()
forall a. Maybe a
Nothing FamilyInfo (GhcPass p)
fd_info)
  , tyDeclATs :: [(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
tyDeclATs = [], tyDeclOpSigs :: [LocatedA (IdP (GhcPass p))]
tyDeclOpSigs = []
  , tyDeclConsWithFields :: LConsWithFields p
tyDeclConsWithFields = LConsWithFields p
forall (p :: Pass). LConsWithFields p
emptyLConsWithFields }
hsLTyClDeclBinders (L SrcSpanAnnA
loc (SynDecl
                               { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = (L Anno (IdGhcP p)
_ IdGhcP p
name) }))
  = TyDeclBinders
  { tyDeclMainBinder :: (LocatedA (IdP (GhcPass p)), TyConFlavour ())
tyDeclMainBinder = (SrcSpanAnnA -> IdGhcP p -> GenLocated SrcSpanAnnA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc IdGhcP p
name, TyConFlavour ()
forall tc. TyConFlavour tc
TypeSynonymFlavour)
  , tyDeclATs :: [(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
tyDeclATs = [], tyDeclOpSigs :: [LocatedA (IdP (GhcPass p))]
tyDeclOpSigs = []
  , tyDeclConsWithFields :: LConsWithFields p
tyDeclConsWithFields = LConsWithFields p
forall (p :: Pass). LConsWithFields p
emptyLConsWithFields }
hsLTyClDeclBinders (L SrcSpanAnnA
loc (ClassDecl
                               { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = (L Anno (IdGhcP p)
_ IdGhcP p
cls_name)
                               , tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs  = [LSig (GhcPass p)]
sigs
                               , tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs   = [LFamilyDecl (GhcPass p)]
ats }))
  = TyDeclBinders
  { tyDeclMainBinder :: (LocatedA (IdP (GhcPass p)), TyConFlavour ())
tyDeclMainBinder = (SrcSpanAnnA -> IdGhcP p -> GenLocated SrcSpanAnnA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc IdGhcP p
cls_name, TyConFlavour ()
forall tc. TyConFlavour tc
ClassFlavour)
  , tyDeclATs :: [(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
tyDeclATs = [ (SrcSpanAnnA -> IdGhcP p -> GenLocated SrcSpanAnnA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
fam_loc IdGhcP p
fam_name, Maybe () -> FamilyInfo (GhcPass p) -> TyConFlavour ()
forall tc pass. Maybe tc -> FamilyInfo pass -> TyConFlavour tc
familyInfoTyConFlavour (() -> Maybe ()
forall a. a -> Maybe a
Just ()) FamilyInfo (GhcPass p)
fd_info)
                | (L SrcSpanAnnA
fam_loc (FamilyDecl { fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = L Anno (IdGhcP p)
_ IdGhcP p
fam_name
                                         , fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo (GhcPass p)
fd_info })) <- [LFamilyDecl (GhcPass p)]
[GenLocated SrcSpanAnnA (FamilyDecl (GhcPass p))]
ats ]
  , tyDeclOpSigs :: [LocatedA (IdP (GhcPass p))]
tyDeclOpSigs = [ SrcSpanAnnA -> IdGhcP p -> GenLocated SrcSpanAnnA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mem_loc IdGhcP p
mem_name
                   | (L SrcSpanAnnA
mem_loc (ClassOpSig XClassOpSig (GhcPass p)
_ Bool
False [LIdP (GhcPass p)]
ns LHsSigType (GhcPass p)
_)) <- [LSig (GhcPass p)]
[GenLocated SrcSpanAnnA (Sig (GhcPass p))]
sigs
                   , (L Anno (IdGhcP p)
_ IdGhcP p
mem_name) <- [LIdP (GhcPass p)]
[GenLocated (Anno (IdGhcP p)) (IdGhcP p)]
ns ]
  , tyDeclConsWithFields :: LConsWithFields p
tyDeclConsWithFields = LConsWithFields p
forall (p :: Pass). LConsWithFields p
emptyLConsWithFields }
hsLTyClDeclBinders (L SrcSpanAnnA
loc (DataDecl    { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = (L Anno (IdGhcP p)
_ IdGhcP p
name)
                                       , tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn (GhcPass p)
defn }))
  = TyDeclBinders
  { tyDeclMainBinder :: (LocatedA (IdP (GhcPass p)), TyConFlavour ())
tyDeclMainBinder = (SrcSpanAnnA -> IdGhcP p -> GenLocated SrcSpanAnnA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc IdGhcP p
name, TyConFlavour ()
flav )
  , tyDeclATs :: [(LocatedA (IdP (GhcPass p)), TyConFlavour ())]
tyDeclATs = []
  , tyDeclOpSigs :: [LocatedA (IdP (GhcPass p))]
tyDeclOpSigs = []
  , tyDeclConsWithFields :: LConsWithFields p
tyDeclConsWithFields = HsDataDefn (GhcPass p) -> LConsWithFields p
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
HsDataDefn (GhcPass p) -> LConsWithFields p
hsDataDefnBinders HsDataDefn (GhcPass p)
defn }
  where
    flav :: TyConFlavour ()
flav = NewOrData -> TyConFlavour ()
forall tc. NewOrData -> TyConFlavour tc
newOrDataToFlavour (NewOrData -> TyConFlavour ()) -> NewOrData -> TyConFlavour ()
forall a b. (a -> b) -> a -> b
$ DataDefnCons (GenLocated SrcSpanAnnA (ConDecl (GhcPass p)))
-> NewOrData
forall a. DataDefnCons a -> NewOrData
dataDefnConsNewOrData (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl (GhcPass p)))
 -> NewOrData)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl (GhcPass p)))
-> NewOrData
forall a b. (a -> b) -> a -> b
$ HsDataDefn (GhcPass p) -> DataDefnCons (LConDecl (GhcPass p))
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons HsDataDefn (GhcPass p)
defn

-------------------
hsForeignDeclsBinders :: forall p a. (UnXRec (GhcPass p), IsSrcSpanAnn p a)
                      => [LForeignDecl (GhcPass p)] -> [LIdP (GhcPass p)]
-- ^ See Note [SrcSpan for binders]
hsForeignDeclsBinders :: forall (p :: Pass) a.
(UnXRec (GhcPass p), IsSrcSpanAnn p a) =>
[LForeignDecl (GhcPass p)] -> [LIdP (GhcPass p)]
hsForeignDeclsBinders [LForeignDecl (GhcPass p)]
foreign_decls
  = [ SrcSpanAnn' (EpAnn a)
-> IdGhcP p -> GenLocated (SrcSpanAnn' (EpAnn a)) (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnn' (EpAnn a)
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
decl_loc)) IdGhcP p
n
    | L SrcSpanAnnA
decl_loc (ForeignImport { fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name = L SrcSpanAnn' (EpAnn a)
_ IdGhcP p
n })
        <- [LForeignDecl (GhcPass p)]
[GenLocated SrcSpanAnnA (ForeignDecl (GhcPass p))]
foreign_decls]


-------------------
hsPatSynSelectors :: IsPass p => HsValBinds (GhcPass p) -> [FieldOcc (GhcPass p)]
-- ^ Collects record pattern-synonym selectors only; the pattern synonym
-- names are collected by 'collectHsValBinders'.
hsPatSynSelectors :: forall (p :: Pass).
IsPass p =>
HsValBinds (GhcPass p) -> [FieldOcc (GhcPass p)]
hsPatSynSelectors (ValBinds XValBinds (GhcPass p) (GhcPass p)
_ LHsBindsLR (GhcPass p) (GhcPass p)
_ [LSig (GhcPass p)]
_) = String -> [FieldOcc (GhcPass p)]
forall a. HasCallStack => String -> a
panic String
"hsPatSynSelectors"
hsPatSynSelectors (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR (GhcPass p) (GhcPass p))]
binds [LSig (GhcPass 'Renamed)]
_))
  = (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))
 -> [FieldOcc (GhcPass p)] -> [FieldOcc (GhcPass p)])
-> [FieldOcc (GhcPass p)]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
-> [FieldOcc (GhcPass p)]
forall a b. (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsBind (GhcPass p)
-> [FieldOcc (GhcPass p)] -> [FieldOcc (GhcPass p)]
GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))
-> [FieldOcc (GhcPass p)] -> [FieldOcc (GhcPass p)]
forall p. UnXRec p => LHsBind p -> [FieldOcc p] -> [FieldOcc p]
addPatSynSelector [] (Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
 -> [FieldOcc (GhcPass p)])
-> ([Bag
       (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))]
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
-> [Bag
      (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))]
-> [FieldOcc (GhcPass p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
forall a. [Bag a] -> Bag a
unionManyBags ([Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))]
 -> [FieldOcc (GhcPass p)])
-> [Bag
      (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))]
-> [FieldOcc (GhcPass p)]
forall a b. (a -> b) -> a -> b
$ ((RecFlag,
  Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
 -> Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
-> [(RecFlag,
     Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))]
-> [Bag
      (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag,
 Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p)))
forall a b. (a, b) -> b
snd [(RecFlag, LHsBindsLR (GhcPass p) (GhcPass p))]
[(RecFlag,
  Bag (GenLocated SrcSpanAnnA (HsBindLR (GhcPass p) (GhcPass p))))]
binds

addPatSynSelector :: forall p. UnXRec p => LHsBind p -> [FieldOcc p] -> [FieldOcc p]
addPatSynSelector :: forall p. UnXRec p => LHsBind p -> [FieldOcc p] -> [FieldOcc p]
addPatSynSelector LHsBind p
bind [FieldOcc p]
sels
  | PatSynBind XPatSynBind p p
_ (PSB { psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args = RecCon [RecordPatSynField p]
as }) <- forall p a. UnXRec p => XRec p a -> a
unXRec @p LHsBind p
bind
  = (RecordPatSynField p -> FieldOcc p)
-> [RecordPatSynField p] -> [FieldOcc p]
forall a b. (a -> b) -> [a] -> [b]
map RecordPatSynField p -> FieldOcc p
forall pass. RecordPatSynField pass -> FieldOcc pass
recordPatSynField [RecordPatSynField p]
as [FieldOcc p] -> [FieldOcc p] -> [FieldOcc p]
forall a. [a] -> [a] -> [a]
++ [FieldOcc p]
sels
  | Bool
otherwise = [FieldOcc p]
sels

getPatSynBinds :: forall id. UnXRec id
               => [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
getPatSynBinds :: forall id.
UnXRec id =>
[(RecFlag, LHsBinds id)] -> [PatSynBind id id]
getPatSynBinds [(RecFlag, LHsBinds id)]
binds
  = [ PatSynBind id id
psb | (RecFlag
_, LHsBinds id
lbinds) <- [(RecFlag, LHsBinds id)]
binds
          , (forall p a. UnXRec p => XRec p a -> a
unXRec @id -> (PatSynBind XPatSynBind id id
_ PatSynBind id id
psb)) <- LHsBinds id -> [XRec id (HsBindLR id id)]
forall a. Bag a -> [a]
bagToList LHsBinds id
lbinds ]

-------------------
hsLInstDeclBinders :: (IsPass p, OutputableBndrId p)
                   => LInstDecl (GhcPass p)
                   -> ([(LocatedA (IdP (GhcPass p)))], [LFieldOcc (GhcPass p)])
hsLInstDeclBinders :: forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
LInstDecl (GhcPass p)
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsLInstDeclBinders (L SrcSpanAnnA
_ (ClsInstD
                             { cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
cid_inst = ClsInstDecl
                                          { cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts = [LDataFamInstDecl (GhcPass p)]
dfis }}))
  = (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))
 -> ([LocatedA (IdGhcP p)],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]))
-> [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))]
-> ([LocatedA (IdGhcP p)],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (LConsWithFields p
-> ([GenLocated SrcSpanAnnA (IdP (GhcPass p))],
    [XRec (GhcPass p) (FieldOcc (GhcPass p))])
LConsWithFields p
-> ([LocatedA (IdGhcP p)],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))])
forall (p :: Pass).
LConsWithFields p
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
lconsWithFieldsBinders (LConsWithFields p
 -> ([LocatedA (IdGhcP p)],
     [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]))
-> (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))
    -> LConsWithFields p)
-> GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))
-> ([LocatedA (IdGhcP p)],
    [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataFamInstDecl (GhcPass p) -> LConsWithFields p
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
DataFamInstDecl (GhcPass p) -> LConsWithFields p
hsDataFamInstBinders (DataFamInstDecl (GhcPass p) -> LConsWithFields p)
-> (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))
    -> DataFamInstDecl (GhcPass p))
-> GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))
-> LConsWithFields p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))
-> DataFamInstDecl (GhcPass p)
forall l e. GenLocated l e -> e
unLoc) [LDataFamInstDecl (GhcPass p)]
[GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass p))]
dfis
hsLInstDeclBinders (L SrcSpanAnnA
_ (DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl (GhcPass p)
fi }))
  = LConsWithFields p
-> ([GenLocated SrcSpanAnnA (IdP (GhcPass p))],
    [XRec (GhcPass p) (FieldOcc (GhcPass p))])
forall (p :: Pass).
LConsWithFields p
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
lconsWithFieldsBinders (LConsWithFields p
 -> ([GenLocated SrcSpanAnnA (IdP (GhcPass p))],
     [XRec (GhcPass p) (FieldOcc (GhcPass p))]))
-> LConsWithFields p
-> ([GenLocated SrcSpanAnnA (IdP (GhcPass p))],
    [XRec (GhcPass p) (FieldOcc (GhcPass p))])
forall a b. (a -> b) -> a -> b
$ DataFamInstDecl (GhcPass p) -> LConsWithFields p
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
DataFamInstDecl (GhcPass p) -> LConsWithFields p
hsDataFamInstBinders DataFamInstDecl (GhcPass p)
fi
hsLInstDeclBinders (L SrcSpanAnnA
_ (TyFamInstD {})) = ([GenLocated SrcSpanAnnA (IdP (GhcPass p))],
 [XRec (GhcPass p) (FieldOcc (GhcPass p))])
([LocatedA (IdGhcP p)],
 [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))])
forall a. Monoid a => a
mempty

-------------------
-- | the 'SrcLoc' returned are for the whole declarations, not just the names
hsDataFamInstBinders :: (IsPass p, OutputableBndrId p)
                     => DataFamInstDecl (GhcPass p)
                     -> LConsWithFields p
hsDataFamInstBinders :: forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
DataFamInstDecl (GhcPass p) -> LConsWithFields p
hsDataFamInstBinders (DataFamInstDecl { dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn = FamEqn { feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = HsDataDefn (GhcPass p)
defn }})
  = HsDataDefn (GhcPass p) -> LConsWithFields p
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
HsDataDefn (GhcPass p) -> LConsWithFields p
hsDataDefnBinders HsDataDefn (GhcPass p)
defn
  -- There can't be repeated symbols because only data instances have binders

-------------------
-- | the 'SrcLoc' returned are for the whole declarations, not just the names
hsDataDefnBinders :: (IsPass p, OutputableBndrId p)
                  => HsDataDefn (GhcPass p)
                  -> LConsWithFields p
hsDataDefnBinders :: forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
HsDataDefn (GhcPass p) -> LConsWithFields p
hsDataDefnBinders (HsDataDefn { dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons = DataDefnCons (LConDecl (GhcPass p))
cons })
  = [LConDecl (GhcPass p)] -> LConsWithFields p
forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
[LConDecl (GhcPass p)] -> LConsWithFields p
hsConDeclsBinders (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl (GhcPass p)))
-> [GenLocated SrcSpanAnnA (ConDecl (GhcPass p))]
forall a. DataDefnCons a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl (GhcPass p))
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl (GhcPass p)))
cons)
  -- See Note [Binders in family instances]

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

{- Note [Collecting record fields in data declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When renaming a data declaration that includes record constructors, we are, in
the end, going to to create a mapping from constructor to its field labels,
to store in 'GREInfo' (see 'IAmConLike'). This allows us to know, in the renamer,
which constructor has what fields.

In order to achieve this, we return the constructor and field information from
hsConDeclsBinders in the following format:

  - [(ConRdrName, [Located Int])], a list of the constructors, each associated
    with its record fields, in the form of a list of Int indices into...
  - IntMap FieldOcc, an IntMap of record fields.

(In actual fact, we use [(ConRdrName, Maybe [Located Int])], with Nothing indicating
that the constructor has unlabelled fields: see Note [Local constructor info in the renamer]
in GHC.Types.GREInfo.)

This allows us to do the following (see GHC.Rename.Names.getLocalNonValBinders.new_tc):

  - create 'Name's for each of the record fields, to get IntMap FieldLabel,
  - create 'Name's for each of the constructors, to get [(ConName, [Int])],
  - look up the FieldLabels of each constructor, to get [(ConName, [FieldLabel])].

NB: This can be a bit tricky to get right in the presence of data types with
duplicate constructors or fields. Storing locations allows us to report an error
for duplicate field declarations, see test cases T9156 T9156_DF.
Other relevant test cases: rnfail015.

-}

-- | A mapping from constructors to all of their fields.
--
-- See Note [Collecting record fields in data declarations].
data LConsWithFields p =
  LConsWithFields
    { forall (p :: Pass).
LConsWithFields p
-> [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
consWithFieldIndices :: [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
    , forall (p :: Pass).
LConsWithFields p -> IntMap (LFieldOcc (GhcPass p))
consFields :: IntMap (LFieldOcc (GhcPass p))
    }

lconsWithFieldsBinders :: LConsWithFields p
                       -> ([(LocatedA (IdP (GhcPass p)))], [LFieldOcc (GhcPass p)])
lconsWithFieldsBinders :: forall (p :: Pass).
LConsWithFields p
-> ([LocatedA (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
lconsWithFieldsBinders (LConsWithFields [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
cons IntMap (LFieldOcc (GhcPass p))
fields)
  = (((LocatedA (IdGhcP p), Maybe [Located Int]) -> LocatedA (IdGhcP p))
-> [(LocatedA (IdGhcP p), Maybe [Located Int])]
-> [LocatedA (IdGhcP p)]
forall a b. (a -> b) -> [a] -> [b]
map (LocatedA (IdGhcP p), Maybe [Located Int]) -> LocatedA (IdGhcP p)
forall a b. (a, b) -> a
fst [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
[(LocatedA (IdGhcP p), Maybe [Located Int])]
cons, IntMap (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
forall a. IntMap a -> [a]
IntMap.elems IntMap (LFieldOcc (GhcPass p))
IntMap (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
fields)

emptyLConsWithFields :: LConsWithFields p
emptyLConsWithFields :: forall (p :: Pass). LConsWithFields p
emptyLConsWithFields = [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
forall (p :: Pass).
[(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
LConsWithFields [] IntMap (LFieldOcc (GhcPass p))
IntMap (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
forall a. IntMap a
IntMap.empty

hsConDeclsBinders :: forall p. (IsPass p, OutputableBndrId p)
                  => [LConDecl (GhcPass p)]
                  -> LConsWithFields p
  -- The function is boringly complicated because of the records
  -- And since we only have equality, we have to be a little careful
hsConDeclsBinders :: forall (p :: Pass).
(IsPass p, OutputableBndrId p) =>
[LConDecl (GhcPass p)] -> LConsWithFields p
hsConDeclsBinders [LConDecl (GhcPass p)]
cons = FieldIndices p -> [LConDecl (GhcPass p)] -> LConsWithFields p
go FieldIndices p
forall (p :: Pass). FieldIndices p
emptyFieldIndices [LConDecl (GhcPass p)]
cons
  where
    go :: FieldIndices p -> [LConDecl (GhcPass p)] -> LConsWithFields p
    go :: FieldIndices p -> [LConDecl (GhcPass p)] -> LConsWithFields p
go FieldIndices p
seen [] = [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
forall (p :: Pass).
[(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
LConsWithFields [] (FieldIndices p -> IntMap (LFieldOcc (GhcPass p))
forall (p :: Pass).
FieldIndices p -> IntMap (LFieldOcc (GhcPass p))
fields FieldIndices p
seen)
    go FieldIndices p
seen (LConDecl (GhcPass p)
r:[LConDecl (GhcPass p)]
rs)
      -- Don't re-mangle the location of field names, because we don't
      -- have a record of the full location of the field declaration anyway
      = let loc :: SrcSpanAnnA
loc = GenLocated SrcSpanAnnA (ConDecl (GhcPass p)) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc LConDecl (GhcPass p)
GenLocated SrcSpanAnnA (ConDecl (GhcPass p))
r
        in case GenLocated SrcSpanAnnA (ConDecl (GhcPass p)) -> ConDecl (GhcPass p)
forall l e. GenLocated l e -> e
unLoc LConDecl (GhcPass p)
GenLocated SrcSpanAnnA (ConDecl (GhcPass p))
r of
           ConDeclGADT { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (LIdP (GhcPass p))
names, con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails (GhcPass p)
args }
             -> [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
forall (p :: Pass).
[(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
LConsWithFields ([(LocatedA (IdGhcP p), Maybe [Located Int])]
cons [(LocatedA (IdGhcP p), Maybe [Located Int])]
-> [(LocatedA (IdGhcP p), Maybe [Located Int])]
-> [(LocatedA (IdGhcP p), Maybe [Located Int])]
forall a. [a] -> [a] -> [a]
++ [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
[(LocatedA (IdGhcP p), Maybe [Located Int])]
ns) IntMap (LFieldOcc (GhcPass p))
fs
             where
                cons :: [(LocatedA (IdGhcP p), Maybe [Located Int])]
cons = (LocatedA (IdGhcP p) -> (LocatedA (IdGhcP p), Maybe [Located Int]))
-> [LocatedA (IdGhcP p)]
-> [(LocatedA (IdGhcP p), Maybe [Located Int])]
forall a b. (a -> b) -> [a] -> [b]
map ( , Maybe [Located Int]
con_flds ) ([LocatedA (IdGhcP p)]
 -> [(LocatedA (IdGhcP p), Maybe [Located Int])])
-> [LocatedA (IdGhcP p)]
-> [(LocatedA (IdGhcP p), Maybe [Located Int])]
forall a b. (a -> b) -> a -> b
$ NonEmpty (LocatedA (IdGhcP p)) -> [LocatedA (IdGhcP p)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SrcSpanAnnA -> IdGhcP p -> LocatedA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (IdGhcP p -> LocatedA (IdGhcP p))
-> (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p)
-> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
-> LocatedA (IdGhcP p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> LocatedA (IdGhcP p))
-> NonEmpty (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
-> NonEmpty (LocatedA (IdGhcP p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LIdP (GhcPass p))
NonEmpty (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
names)
                (Maybe [Located Int]
con_flds, FieldIndices p
seen') = FieldIndices p
-> HsConDeclGADTDetails (GhcPass p)
-> (Maybe [Located Int], FieldIndices p)
get_flds_gadt FieldIndices p
seen HsConDeclGADTDetails (GhcPass p)
args
                LConsWithFields [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
ns IntMap (LFieldOcc (GhcPass p))
fs = FieldIndices p -> [LConDecl (GhcPass p)] -> LConsWithFields p
go FieldIndices p
seen' [LConDecl (GhcPass p)]
rs

           ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP (GhcPass p)
name, con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details (GhcPass p)
args }
             -> [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
forall (p :: Pass).
[(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
-> IntMap (LFieldOcc (GhcPass p)) -> LConsWithFields p
LConsWithFields ([(SrcSpanAnnA -> IdGhcP p -> LocatedA (IdGhcP p)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> IdGhcP p
forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
name), Maybe [Located Int]
con_flds)] [(LocatedA (IdGhcP p), Maybe [Located Int])]
-> [(LocatedA (IdGhcP p), Maybe [Located Int])]
-> [(LocatedA (IdGhcP p), Maybe [Located Int])]
forall a. [a] -> [a] -> [a]
++ [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
[(LocatedA (IdGhcP p), Maybe [Located Int])]
ns) IntMap (LFieldOcc (GhcPass p))
fs
             where
                (Maybe [Located Int]
con_flds, FieldIndices p
seen') = FieldIndices p
-> HsConDeclH98Details (GhcPass p)
-> (Maybe [Located Int], FieldIndices p)
get_flds_h98 FieldIndices p
seen HsConDeclH98Details (GhcPass p)
args
                LConsWithFields [(LocatedA (IdP (GhcPass p)), Maybe [Located Int])]
ns IntMap (LFieldOcc (GhcPass p))
fs = FieldIndices p -> [LConDecl (GhcPass p)] -> LConsWithFields p
go FieldIndices p
seen' [LConDecl (GhcPass p)]
rs

    get_flds_h98 :: FieldIndices p -> HsConDeclH98Details (GhcPass p)
                 -> (Maybe [Located Int], FieldIndices p)
    get_flds_h98 :: FieldIndices p
-> HsConDeclH98Details (GhcPass p)
-> (Maybe [Located Int], FieldIndices p)
get_flds_h98 FieldIndices p
seen (RecCon XRec (GhcPass p) [LConDeclField (GhcPass p)]
flds) = ([Located Int] -> Maybe [Located Int])
-> ([Located Int], FieldIndices p)
-> (Maybe [Located Int], FieldIndices p)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Located Int] -> Maybe [Located Int]
forall a. a -> Maybe a
Just (([Located Int], FieldIndices p)
 -> (Maybe [Located Int], FieldIndices p))
-> ([Located Int], FieldIndices p)
-> (Maybe [Located Int], FieldIndices p)
forall a b. (a -> b) -> a -> b
$ FieldIndices p
-> LocatedL [LConDeclField (GhcPass p)]
-> ([Located Int], FieldIndices p)
get_flds FieldIndices p
seen XRec (GhcPass p) [LConDeclField (GhcPass p)]
LocatedL [LConDeclField (GhcPass p)]
flds
    get_flds_h98 FieldIndices p
seen (PrefixCon [Void]
_ []) = ([Located Int] -> Maybe [Located Int]
forall a. a -> Maybe a
Just [], FieldIndices p
seen)
    get_flds_h98 FieldIndices p
seen HsConDeclH98Details (GhcPass p)
_ = (Maybe [Located Int]
forall a. Maybe a
Nothing, FieldIndices p
seen)

    get_flds_gadt :: FieldIndices p -> HsConDeclGADTDetails (GhcPass p)
                  -> (Maybe [Located Int], FieldIndices p)
    get_flds_gadt :: FieldIndices p
-> HsConDeclGADTDetails (GhcPass p)
-> (Maybe [Located Int], FieldIndices p)
get_flds_gadt FieldIndices p
seen (RecConGADT XRec (GhcPass p) [LConDeclField (GhcPass p)]
flds LHsUniToken "->" "\8594" (GhcPass p)
_) = ([Located Int] -> Maybe [Located Int])
-> ([Located Int], FieldIndices p)
-> (Maybe [Located Int], FieldIndices p)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Located Int] -> Maybe [Located Int]
forall a. a -> Maybe a
Just (([Located Int], FieldIndices p)
 -> (Maybe [Located Int], FieldIndices p))
-> ([Located Int], FieldIndices p)
-> (Maybe [Located Int], FieldIndices p)
forall a b. (a -> b) -> a -> b
$ FieldIndices p
-> LocatedL [LConDeclField (GhcPass p)]
-> ([Located Int], FieldIndices p)
get_flds FieldIndices p
seen XRec (GhcPass p) [LConDeclField (GhcPass p)]
LocatedL [LConDeclField (GhcPass p)]
flds
    get_flds_gadt FieldIndices p
seen (PrefixConGADT []) = ([Located Int] -> Maybe [Located Int]
forall a. a -> Maybe a
Just [], FieldIndices p
seen)
    get_flds_gadt FieldIndices p
seen HsConDeclGADTDetails (GhcPass p)
_ = (Maybe [Located Int]
forall a. Maybe a
Nothing, FieldIndices p
seen)

    get_flds :: FieldIndices p -> LocatedL [LConDeclField (GhcPass p)]
             -> ([Located Int], FieldIndices p)
    get_flds :: FieldIndices p
-> LocatedL [LConDeclField (GhcPass p)]
-> ([Located Int], FieldIndices p)
get_flds FieldIndices p
seen LocatedL [LConDeclField (GhcPass p)]
flds =
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
 -> ([Located Int], FieldIndices p)
 -> ([Located Int], FieldIndices p))
-> ([Located Int], FieldIndices p)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
-> ([Located Int], FieldIndices p)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
-> ([Located Int], FieldIndices p)
-> ([Located Int], FieldIndices p)
forall {p :: Pass}.
GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
-> ([Located Int], FieldIndices p)
-> ([Located Int], FieldIndices p)
add_fld ([], FieldIndices p
seen) [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
fld_names
      where
        add_fld :: GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
-> ([Located Int], FieldIndices p)
-> ([Located Int], FieldIndices p)
add_fld GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
fld ([Located Int]
is, FieldIndices p
ixs) =
          let (Located Int
i, FieldIndices p
ixs') = LFieldOcc (GhcPass p)
-> FieldIndices p -> (Located Int, FieldIndices p)
forall (p :: Pass).
LFieldOcc (GhcPass p)
-> FieldIndices p -> (Located Int, FieldIndices p)
insertField LFieldOcc (GhcPass p)
GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
fld FieldIndices p
ixs
          in  (Located Int
iLocated Int -> [Located Int] -> [Located Int]
forall a. a -> [a] -> [a]
:[Located Int]
is, FieldIndices p
ixs')
        fld_names :: [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
fld_names = (GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))
 -> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))])
-> [GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))]
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConDeclField (GhcPass p) -> [LFieldOcc (GhcPass p)]
ConDeclField (GhcPass p)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names (ConDeclField (GhcPass p)
 -> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))])
-> (GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))
    -> ConDeclField (GhcPass p))
-> GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))
-> ConDeclField (GhcPass p)
forall l e. GenLocated l e -> e
unLoc) (GenLocated
  (SrcSpanAnn' (EpAnn AnnList))
  [GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))]
-> [GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))]
forall l e. GenLocated l e -> e
unLoc LocatedL [LConDeclField (GhcPass p)]
GenLocated
  (SrcSpanAnn' (EpAnn AnnList))
  [GenLocated SrcSpanAnnA (ConDeclField (GhcPass p))]
flds)

-- | A bijection between record fields of a datatype and integers,
-- used to implement Note [Collecting record fields in data declarations].
data FieldIndices p =
  FieldIndices
    { forall (p :: Pass).
FieldIndices p -> IntMap (LFieldOcc (GhcPass p))
fields       :: IntMap (LFieldOcc (GhcPass p))
        -- ^ Look up a field from its index.
    , forall (p :: Pass). FieldIndices p -> Map RdrName Int
fieldIndices :: Map RdrName Int
        -- ^ Look up the index of a field label in the previous 'IntMap'.
    , forall (p :: Pass). FieldIndices p -> Int
newInt       :: !Int
        -- ^ An integer @i@ such that no integer @i' >= i@ appears in the 'IntMap'.
    }

emptyFieldIndices :: FieldIndices p
emptyFieldIndices :: forall (p :: Pass). FieldIndices p
emptyFieldIndices =
  FieldIndices { fields :: IntMap (LFieldOcc (GhcPass p))
fields       = IntMap (LFieldOcc (GhcPass p))
IntMap (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
forall a. IntMap a
IntMap.empty
               , fieldIndices :: Map RdrName Int
fieldIndices = Map RdrName Int
forall k a. Map k a
Map.empty
               , newInt :: Int
newInt       = Int
0 }

insertField :: LFieldOcc (GhcPass p) -> FieldIndices p -> (Located Int, FieldIndices p)
insertField :: forall (p :: Pass).
LFieldOcc (GhcPass p)
-> FieldIndices p -> (Located Int, FieldIndices p)
insertField LFieldOcc (GhcPass p)
new_fld fi :: FieldIndices p
fi@(FieldIndices IntMap (LFieldOcc (GhcPass p))
flds Map RdrName Int
idxs Int
new_idx)
  | Just Int
i <- RdrName -> Map RdrName Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RdrName
rdr Map RdrName Int
idxs
  = (SrcSpan -> Int -> Located Int
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc Int
i, FieldIndices p
fi)
  | Bool
otherwise
  = (SrcSpan -> Int -> Located Int
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc Int
new_idx,
      IntMap (LFieldOcc (GhcPass p))
-> Map RdrName Int -> Int -> FieldIndices p
forall (p :: Pass).
IntMap (LFieldOcc (GhcPass p))
-> Map RdrName Int -> Int -> FieldIndices p
FieldIndices (Int
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
-> IntMap (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
-> IntMap (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
new_idx LFieldOcc (GhcPass p)
GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
new_fld IntMap (LFieldOcc (GhcPass p))
IntMap (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
flds)
                   (RdrName -> Int -> Map RdrName Int -> Map RdrName Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RdrName
rdr Int
new_idx Map RdrName Int
idxs)
                   (Int
new_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  where
    loc :: SrcSpan
loc = GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LFieldOcc (GhcPass p)
GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
new_fld
    rdr :: RdrName
rdr = LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (LocatedN RdrName -> RdrName)
-> (LFieldOcc (GhcPass p) -> LocatedN RdrName)
-> LFieldOcc (GhcPass p)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc (GhcPass p) -> XRec (GhcPass p) RdrName
FieldOcc (GhcPass p) -> LocatedN RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel (FieldOcc (GhcPass p) -> LocatedN RdrName)
-> (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
    -> FieldOcc (GhcPass p))
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
-> FieldOcc (GhcPass p)
forall l e. GenLocated l e -> e
unLoc (LFieldOcc (GhcPass p) -> RdrName)
-> LFieldOcc (GhcPass p) -> RdrName
forall a b. (a -> b) -> a -> b
$ LFieldOcc (GhcPass p)
new_fld

{-

Note [SrcSpan for binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~
When extracting the (Located RdrName) for a binder, at least for the
main name (the TyCon of a type declaration etc), we want to give it
the @SrcSpan@ of the whole /declaration/, not just the name itself
(which is how it appears in the syntax tree).  This SrcSpan (for the
entire declaration) is used as the SrcSpan for the Name that is
finally produced, and hence for error messages.  (See #8607.)

Note [Binders in family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In a type or data family instance declaration, the type
constructor is an *occurrence* not a binding site
    type instance T Int = Int -> Int   -- No binders
    data instance S Bool = S1 | S2     -- Binders are S1,S2


************************************************************************
*                                                                      *
        Collecting binders the user did not write
*                                                                      *
************************************************************************

The job of this family of functions is to run through binding sites and find the set of all Names
that were defined "implicitly", without being explicitly written by the user.

The main purpose is to find names introduced by record wildcards so that we can avoid
warning the user when they don't use those names (#4404)

Since the addition of -Wunused-record-wildcards, this function returns a pair
of [(SrcSpan, [Name])]. Each element of the list is one set of implicit
binders, the first component of the tuple is the document describes the possible
fix to the problem (by removing the ..).

This means there is some unfortunate coupling between this function and where it
is used but it's only used for one specific purpose in one place so it seemed
easier.
-}

lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))]
                -> [(SrcSpan, [Name])]
lStmtsImplicits :: forall (idR :: Pass) (body :: * -> *).
[LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
lStmtsImplicits = [LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts
  where
    hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))]
              -> [(SrcSpan, [Name])]
    hs_lstmts :: forall (idR :: Pass) (body :: * -> *).
[LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts = (GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))
 -> [(SrcSpan, [Name])])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))]
-> [(SrcSpan, [Name])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (StmtLR
  (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
StmtLR
  (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
-> [(SrcSpan, [Name])]
hs_stmt (StmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
 -> [(SrcSpan, [Name])])
-> (GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))
    -> StmtLR
         (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))
-> GenLocated
     SrcSpanAnnA
     (StmtLR
        (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))
-> [(SrcSpan, [Name])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))
-> StmtLR
     (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
forall l e. GenLocated l e -> e
unLoc)

    hs_stmt :: StmtLR GhcRn (GhcPass idR) (LocatedA (body (GhcPass idR)))
            -> [(SrcSpan, [Name])]
    hs_stmt :: forall (idR :: Pass) (body :: * -> *).
StmtLR
  (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
-> [(SrcSpan, [Name])]
hs_stmt (BindStmt XBindStmt
  (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
_ LPat (GhcPass 'Renamed)
pat LocatedA (body (GhcPass idR))
_) = LPat (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
lPatImplicits LPat (GhcPass 'Renamed)
pat
    hs_stmt (ApplicativeStmt XApplicativeStmt
  (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
_ [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass 'Renamed))]
args Maybe (SyntaxExpr (GhcPass idR))
_) = ((SyntaxExprGhc idR, ApplicativeArg (GhcPass 'Renamed))
 -> [(SrcSpan, [Name])])
-> [(SyntaxExprGhc idR, ApplicativeArg (GhcPass 'Renamed))]
-> [(SrcSpan, [Name])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SyntaxExprGhc idR, ApplicativeArg (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
forall {a}.
(a, ApplicativeArg (GhcPass 'Renamed)) -> [(SrcSpan, [Name])]
do_arg [(SyntaxExpr (GhcPass idR), ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExprGhc idR, ApplicativeArg (GhcPass 'Renamed))]
args
      where do_arg :: (a, ApplicativeArg (GhcPass 'Renamed)) -> [(SrcSpan, [Name])]
do_arg (a
_, ApplicativeArgOne { app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
app_arg_pattern = LPat (GhcPass 'Renamed)
pat }) = LPat (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
lPatImplicits LPat (GhcPass 'Renamed)
pat
            do_arg (a
_, ApplicativeArgMany { app_stmts :: forall idL. ApplicativeArg idL -> [ExprLStmt idL]
app_stmts = [ExprLStmt (GhcPass 'Renamed)]
stmts }) = [LStmtLR
   (GhcPass 'Renamed)
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [ExprLStmt (GhcPass 'Renamed)]
[LStmtLR
   (GhcPass 'Renamed)
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
stmts
    hs_stmt (LetStmt XLetStmt
  (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
_ HsLocalBindsLR (GhcPass 'Renamed) (GhcPass idR)
binds)     = HsLocalBindsLR (GhcPass 'Renamed) (GhcPass idR)
-> [(SrcSpan, [Name])]
forall {idR :: Pass}.
HsLocalBindsLR (GhcPass 'Renamed) (GhcPass idR)
-> [(SrcSpan, [Name])]
hs_local_binds HsLocalBindsLR (GhcPass 'Renamed) (GhcPass idR)
binds
    hs_stmt (BodyStmt {})         = []
    hs_stmt (LastStmt {})         = []
    hs_stmt (ParStmt XParStmt
  (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))
_ [ParStmtBlock (GhcPass 'Renamed) (GhcPass idR)]
xs HsExpr (GhcPass idR)
_ SyntaxExpr (GhcPass idR)
_)    = [LStmtLR
   (GhcPass 'Renamed)
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [LStmtLR
  (GhcPass 'Renamed)
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
s | ParStmtBlock XParStmtBlock (GhcPass 'Renamed) (GhcPass idR)
_ [ExprLStmt (GhcPass 'Renamed)]
ss [IdP (GhcPass idR)]
_ SyntaxExpr (GhcPass idR)
_ <- [ParStmtBlock (GhcPass 'Renamed) (GhcPass idR)]
xs
                                                , GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Renamed)
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
s <- [ExprLStmt (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
ss]
    hs_stmt (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [ExprLStmt (GhcPass 'Renamed)]
stmts }) = [LStmtLR
   (GhcPass 'Renamed)
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [ExprLStmt (GhcPass 'Renamed)]
[LStmtLR
   (GhcPass 'Renamed)
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
stmts
    hs_stmt (RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L SrcSpanAnn' (EpAnn AnnList)
_ [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))]
ss }) = [LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
hs_lstmts [LStmtLR
   (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR)))]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Renamed) (GhcPass idR) (LocatedA (body (GhcPass idR))))]
ss

    hs_local_binds :: HsLocalBindsLR (GhcPass 'Renamed) (GhcPass idR)
-> [(SrcSpan, [Name])]
hs_local_binds (HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass idR)
_ HsValBindsLR (GhcPass 'Renamed) (GhcPass idR)
val_binds) = HsValBindsLR (GhcPass 'Renamed) (GhcPass idR)
-> [(SrcSpan, [Name])]
forall (idR :: Pass).
HsValBindsLR (GhcPass 'Renamed) (GhcPass idR)
-> [(SrcSpan, [Name])]
hsValBindsImplicits HsValBindsLR (GhcPass 'Renamed) (GhcPass idR)
val_binds
    hs_local_binds (HsIPBinds {})           = []
    hs_local_binds (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Renamed) (GhcPass idR)
_)      = []

hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> [(SrcSpan, [Name])]
hsValBindsImplicits :: forall (idR :: Pass).
HsValBindsLR (GhcPass 'Renamed) (GhcPass idR)
-> [(SrcSpan, [Name])]
hsValBindsImplicits (XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
binds [LSig (GhcPass 'Renamed)]
_))
  = ((RecFlag,
  Bag
    (GenLocated
       (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed))))
 -> [(SrcSpan, [Name])])
-> [(RecFlag,
     Bag
       (GenLocated
          (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed))))]
-> [(SrcSpan, [Name])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LHsBinds (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
Bag
  (GenLocated
     (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed)))
-> [(SrcSpan, [Name])]
forall idR.
LHsBindsLR (GhcPass 'Renamed) idR -> [(SrcSpan, [Name])]
lhsBindsImplicits (Bag
   (GenLocated
      (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed)))
 -> [(SrcSpan, [Name])])
-> ((RecFlag,
     Bag
       (GenLocated
          (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed))))
    -> Bag
         (GenLocated
            (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed))))
-> (RecFlag,
    Bag
      (GenLocated
         (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed))))
-> [(SrcSpan, [Name])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecFlag,
 Bag
   (GenLocated
      (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed))))
-> Bag
     (GenLocated
        (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed)))
forall a b. (a, b) -> b
snd) [(RecFlag, LHsBinds (GhcPass 'Renamed))]
[(RecFlag,
  Bag
    (GenLocated
       (Anno (HsBind (GhcPass 'Renamed))) (HsBind (GhcPass 'Renamed))))]
binds
hsValBindsImplicits (ValBinds XValBinds (GhcPass 'Renamed) (GhcPass idR)
_ LHsBindsLR (GhcPass 'Renamed) (GhcPass idR)
binds [LSig (GhcPass idR)]
_)
  = LHsBindsLR (GhcPass 'Renamed) (GhcPass idR) -> [(SrcSpan, [Name])]
forall idR.
LHsBindsLR (GhcPass 'Renamed) idR -> [(SrcSpan, [Name])]
lhsBindsImplicits LHsBindsLR (GhcPass 'Renamed) (GhcPass idR)
binds

lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]
lhsBindsImplicits :: forall idR.
LHsBindsLR (GhcPass 'Renamed) idR -> [(SrcSpan, [Name])]
lhsBindsImplicits = ([(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])])
-> (GenLocated
      (Anno (HsBindLR (GhcPass 'Renamed) idR))
      (HsBindLR (GhcPass 'Renamed) idR)
    -> [(SrcSpan, [Name])])
-> [(SrcSpan, [Name])]
-> Bag
     (GenLocated
        (Anno (HsBindLR (GhcPass 'Renamed) idR))
        (HsBindLR (GhcPass 'Renamed) idR))
-> [(SrcSpan, [Name])]
forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
foldBag [(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])]
forall a. [a] -> [a] -> [a]
(++) (HsBindLR (GhcPass 'Renamed) idR -> [(SrcSpan, [Name])]
forall {idR}.
HsBindLR (GhcPass 'Renamed) idR -> [(SrcSpan, [Name])]
lhs_bind (HsBindLR (GhcPass 'Renamed) idR -> [(SrcSpan, [Name])])
-> (GenLocated
      (Anno (HsBindLR (GhcPass 'Renamed) idR))
      (HsBindLR (GhcPass 'Renamed) idR)
    -> HsBindLR (GhcPass 'Renamed) idR)
-> GenLocated
     (Anno (HsBindLR (GhcPass 'Renamed) idR))
     (HsBindLR (GhcPass 'Renamed) idR)
-> [(SrcSpan, [Name])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  (Anno (HsBindLR (GhcPass 'Renamed) idR))
  (HsBindLR (GhcPass 'Renamed) idR)
-> HsBindLR (GhcPass 'Renamed) idR
forall l e. GenLocated l e -> e
unLoc) []
  where
    lhs_bind :: HsBindLR (GhcPass 'Renamed) idR -> [(SrcSpan, [Name])]
lhs_bind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat (GhcPass 'Renamed)
lpat }) = LPat (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
lPatImplicits LPat (GhcPass 'Renamed)
lpat
    lhs_bind HsBindLR (GhcPass 'Renamed) idR
_ = []

lPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]
lPatImplicits :: LPat (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
lPatImplicits = LPat (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat
  where
    hs_lpat :: GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
lpat = Pat (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
hs_pat (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> Pat (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
lpat)

    hs_lpats :: [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> [(SrcSpan, [Name])]
hs_lpats = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
 -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])])
-> [(SrcSpan, [Name])]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> [(SrcSpan, [Name])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat [(SrcSpan, [Name])]
rest -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat [(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])]
forall a. [a] -> [a] -> [a]
++ [(SrcSpan, [Name])]
rest) []

    hs_pat :: Pat (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
hs_pat (LazyPat XLazyPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
pat)      = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat
    hs_pat (BangPat XBangPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
pat)      = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat
    hs_pat (AsPat XAsPat (GhcPass 'Renamed)
_ LIdP (GhcPass 'Renamed)
_ LHsToken "@" (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
pat)    = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat
    hs_pat (ViewPat XViewPat (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
pat)    = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat
    hs_pat (ParPat XParPat (GhcPass 'Renamed)
_ LHsToken "(" (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
pat LHsToken ")" (GhcPass 'Renamed)
_)   = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat
    hs_pat (ListPat XListPat (GhcPass 'Renamed)
_ [LPat (GhcPass 'Renamed)]
pats)     = [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> [(SrcSpan, [Name])]
hs_lpats [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
pats
    hs_pat (TuplePat XTuplePat (GhcPass 'Renamed)
_ [LPat (GhcPass 'Renamed)]
pats Boxity
_)  = [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> [(SrcSpan, [Name])]
hs_lpats [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
pats

    hs_pat (SigPat XSigPat (GhcPass 'Renamed)
_ LPat (GhcPass 'Renamed)
pat HsPatSigType (NoGhcTc (GhcPass 'Renamed))
_)     = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
pat

    hs_pat (ConPat {pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con=XRec (GhcPass 'Renamed) (ConLikeP (GhcPass 'Renamed))
con, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args=HsConPatDetails (GhcPass 'Renamed)
ps}) = GenLocated SrcSpanAnnN Name
-> HsConPatDetails (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
details XRec (GhcPass 'Renamed) (ConLikeP (GhcPass 'Renamed))
GenLocated SrcSpanAnnN Name
con HsConPatDetails (GhcPass 'Renamed)
ps

    hs_pat Pat (GhcPass 'Renamed)
_ = []

    details :: LocatedN Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
    details :: GenLocated SrcSpanAnnN Name
-> HsConPatDetails (GhcPass 'Renamed) -> [(SrcSpan, [Name])]
details GenLocated SrcSpanAnnN Name
_ (PrefixCon [HsConPatTyArg (NoGhcTc (GhcPass 'Renamed))]
_ [LPat (GhcPass 'Renamed)]
ps) = [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> [(SrcSpan, [Name])]
hs_lpats [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
ps
    details GenLocated SrcSpanAnnN Name
n (RecCon HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
fs)      =
      [(SrcSpan
err_loc, CollectFlag (GhcPass 'Renamed)
-> [LPat (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag (GhcPass 'Renamed)
forall p. CollectFlag p
CollNoDictBinders [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
implicit_pats) | Just{} <- [HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> Maybe (XRec (GhcPass 'Renamed) RecFieldsDotDot)
forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
fs] ]
        [(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
-> [(SrcSpan, [Name])]
hs_lpats [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
explicit_pats

      where implicit_pats :: [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
implicit_pats = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
   (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
    -> HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
        (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall l e. GenLocated l e -> e
unLoc) [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
implicit
            explicit_pats :: [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
explicit_pats = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
   (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
    -> HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
        (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall l e. GenLocated l e -> e
unLoc) [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
explicit


            ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
explicit, [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
implicit) = [Either
   (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))))
   (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))))]
-> ([GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
          (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))],
    [GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
          (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [if Bool
pat_explicit then GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> Either
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))))
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))))
forall a b. a -> Either a b
Left GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
fld else GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> Either
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))))
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))))
forall a b. b -> Either a b
Right GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
fld
                                                    | (Int
i, GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
fld) <- [Int
0..] [Int]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))]
-> [(Int,
     GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Renamed)))
          (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> [LHsRecField
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
fs
                                                    ,  let  pat_explicit :: Bool
pat_explicit =
                                                              Bool
-> (GenLocated SrcSpan RecFieldsDotDot -> Bool)
-> Maybe (GenLocated SrcSpan RecFieldsDotDot)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) (Int -> Bool)
-> (GenLocated SrcSpan RecFieldsDotDot -> Int)
-> GenLocated SrcSpan RecFieldsDotDot
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecFieldsDotDot -> Int
unRecFieldsDotDot (RecFieldsDotDot -> Int)
-> (GenLocated SrcSpan RecFieldsDotDot -> RecFieldsDotDot)
-> GenLocated SrcSpan RecFieldsDotDot
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan RecFieldsDotDot -> RecFieldsDotDot
forall l e. GenLocated l e -> e
unLoc)
                                                                         (HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> Maybe (XRec (GhcPass 'Renamed) RecFieldsDotDot)
forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
fs)]
            err_loc :: SrcSpan
err_loc = SrcSpan
-> (GenLocated SrcSpan RecFieldsDotDot -> SrcSpan)
-> Maybe (GenLocated SrcSpan RecFieldsDotDot)
-> SrcSpan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GenLocated SrcSpanAnnN Name -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnN Name
n) GenLocated SrcSpan RecFieldsDotDot -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> Maybe (XRec (GhcPass 'Renamed) RecFieldsDotDot)
forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot HsRecFields (GhcPass 'Renamed) (LPat (GhcPass 'Renamed))
HsRecFields
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
fs)

    details GenLocated SrcSpanAnnN Name
_ (InfixCon LPat (GhcPass 'Renamed)
p1 LPat (GhcPass 'Renamed)
p2) = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
p1 [(SrcSpan, [Name])] -> [(SrcSpan, [Name])] -> [(SrcSpan, [Name])]
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> [(SrcSpan, [Name])]
hs_lpat LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
p2